view release on metacpan or  search on metacpan

lib/Audio/Nama/Assign.pm  view on Meta::CPAN

	$mixdown_encodings 				$config->{mixdown_encodings}
	$volume_control_operator 		$config->{volume_control_operator}
	$serialize_formats  	        $config->{serialize_formats}
	$use_git						$config->{use_git}
	$beep_command 					$config->{beep_command}
	$hotkey_beep					$config->{hotkey_beep}
	$eager							$mode->{eager}
	$waveform_height 				$config->{waveform_height}
	$alias							$config->{alias}
	$hotkeys						$config->{hotkeys}
	$new_track_rw					$config->{new_track_rw}
	$hotkeys_always					$config->{hotkeys_always}
	$hotkey_playback_jumpsize_seconds   $config->{hotkey_playback_jumpsize_seconds}
	$seek_end_margin			   $config->{seek_end_margin}
	$use_pager     					$config->{use_pager}
	$use_placeholders  				$config->{use_placeholders}
    $edit_playback_end_margin  		$config->{edit_playback_end_margin}
    $edit_crossfade_time  			$config->{edit_crossfade_time}
	$default_fade_length 			$config->{engine_fade_default_length}
	$fade_time 						$config->{engine_fade_length_on_start_stop}
	%mute_level						$config->{mute_level}
	%fade_out_level 				$config->{fade_out_level}
	$fade_resolution 				$config->{fade_resolution}
	%unity_level					$config->{unity_level}
	$enforce_channel_bounds    		$config->{enforce_channel_bounds}
	$midi_input_dev    				$midi->{input_dev}
	$midi_output_dev   				$midi->{output_dev}
	$controller_ports				$midi->{controller_ports}
    $midi_inputs					$midi->{inputs}
	$engines						$config->{engines}
	$default_waveform_height 			$config->{default_waveform_height}
	$loop_chain_channel_width 	$config->{loop_chain_channel_width}
	$waveform_pixels_per_second		$config->{waveform_pixels_per_second}
	$display_waveform					$config->{display_waveform}
	$ticks_per_quarter_note 		$config->{ticks_per_quarter_note}
	$use_metronome					$config->{use_metronome}

) };
sub var_map {  $var_map } # to allow outside access while keeping
                          # working lexical
sub config_vars { keys %$var_map }

sub assign {
  # Usage: 
  # assign ( 
  # data 	=> $ref,
  # vars 	=> \@vars,
  # var_map => 1,
  #	class => $class
  #	);

	logsub((caller(0))[3]);
	
	my %h = @_; # parameters appear in %h
	my $class;
	logpkg(__FILE__,__LINE__,'logcarp',"didn't expect scalar here") if ref $h{data} eq 'SCALAR';
	logpkg(__FILE__,__LINE__,'logcarp',"didn't expect code here") if ref $h{data} eq 'CODE';
	# print "data: $h{data}, ", ref $h{data}, $/;

	if ( ref $h{data} !~ /^(HASH|ARRAY|CODE|GLOB|HANDLE|FORMAT)$/){
		# we guess object
		$class = ref $h{data}; 
		logpkg(__FILE__,__LINE__,'debug',"I found an object of class $class");
	} 
	$class = $h{class};
 	$class .= "::" unless $class =~ /::$/;  # SKIP_PREPROC
	my @vars = @{ $h{vars} };
	my $ref = $h{data};
	my $type = ref $ref;
	logpkg(__FILE__,__LINE__,'debug',<<ASSIGN);
	data type: $type
	data: $ref
	class: $class
	vars: @vars
ASSIGN
	#logpkg(__FILE__,__LINE__,'debug',sub{json_out($ref)});

	# index what sigil an identifier should get

	# we need to create search-and-replace strings
	# sigil-less old_identifier
	my %sigil;
	my %ident;
	map { 
		my $oldvar = my $var = $_;
		my ($dummy, $old_identifier) = /^([\$\%\@])([\-\>\w:\[\]{}]+)$/;
		$var = $var_map->{$var} if $h{var_map} and $var_map->{$var};

		logpkg(__FILE__,__LINE__,'debug',"oldvar: $oldvar, newvar: $var") unless $oldvar eq $var;
		my ($sigil, $identifier) = $var =~ /([\$\%\@])(\S+)/;
			$sigil{$old_identifier} = $sigil;
			$ident{$old_identifier} = $identifier;
	} @vars;

	logpkg(__FILE__,__LINE__,'debug',sub{"SIGIL\n". json_out(\%sigil)});
	#%ident = map{ @$_ } grep{ $_->[0] ne $_->[1] } map{ [$_, $ident{$_}]  }  keys %ident; 
	my %ident2 = %ident;
	while ( my ($k,$v) = each %ident2)
	{
		delete $ident2{$k} if $k eq $v
	}
	logpkg(__FILE__,__LINE__,'debug',sub{"IDENT\n". json_out(\%ident2)});
	
	#print join " ", "Variables:\n", @vars, $/ ;
	croak "expected hash" if ref $ref !~ /HASH/;
	my @keys =  keys %{ $ref }; # identifiers, *no* sigils
	logpkg(__FILE__,__LINE__,'debug',sub{ join " ","found keys: ", keys %{ $ref },"\n---\n"});
	map{  
		my $eval;
		my $key = $_;
		chomp $key;
		my $sigil = $sigil{$key};
		my $full_class_path = 
 			$sigil . ($key =~/:\:/ ? '': $class) .  $ident{$key};

			# use the supplied class unless the variable name
			# contains \:\:
			
		logpkg(__FILE__,__LINE__,'debug',<<DEBUG);
key:             $key
sigil:      $sigil