Generated: Tue Feb 2 17:54:58 2010 from test5.pl 2006/09/11 9.2 KB.
#!C:/Perl -w # test5.pl - 2006.09.11 (5 years after 9/11) - geoff mclane # AIM: just testing some actions using a HASH # 1. does @hk = keys %hash work? Yes, absolutely # 2. can a has entry contain an array - like $hash{$file} = @arr # No, but it can contain a 'reference' to an array, which can be 'anon' ... # Note below the deep indexing into the reference to a multi-dimensional array # like - $v = ${@{${@{$hash{$k}}}[$i]}}[$i2]; ### note - a reference is NOT really just a pointer to ### since in this case @na only has a scope in this for, and ### its value is changed with each iteration ### so a 'reference' is really a 'copy' of the array. ### To 'prove' this, I clear the arrays, put difference values in each ### but these 'new' values do not appear until I do set_changes ... ### It is clear that 'reference' in Perl has NO SIMILARITY to a 'reference' in C++ !!! ### That begs the question - how do you pass a C++ type 'reference' in Perl? ### That is a 'pointer' to a variable to be changed during the function? ### Of course, the global scope of variable, means the function can 'directly' access, ### and change the global ... so there is not much need to pass a 'pointer to' ... ###################################################################################### ##use strict; use Switch; require "logfile.pl" or die "ERROR: Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $outfile = 'temp'.$0.'.txt'; open_log($outfile); prt( "$0 ... Hello, World ...\n" ); my $cnt = 0; my %hash = ("item1" => 5, "item2" => 7, "item3" => 2); my ($k, $v, $i, $val, $i2); #my @marr1 = ( ['A', 1, 'aa'], ['B', 2, 'bb'], ['C', 3, 'cc'] ); #my @marr2 = ( ['D', 4, 'dd'], ['E', 5, 'ee'], ['F', 6, 'ff'], ['X', 10, 'xx'], ['Y', 11, 'yy'] ); #my @marr3 = ( ['G', 7, 'gg'], ['H', 8, 'hh'], ['I', 9, 'ii'], ['Z', 12, 'zz'] ); my %hash1 = ( 'A' => 1, 'B' => 2, 'C' => 3 ); my %hash2 = ( 'D' => 4, 'E' => 5, 'F' => 6, 'X' => 10,'Y' => 11 ); my %hash3 = ( 'G' => 7, 'H' => 8, 'I' => 9, 'Z' => 12 ); my @marr1 = (); my @marr2 = (); my @marr3 = (); my @array_of_hash = ( {file => 'test1.jpg', price => '1.00', desc => '1st test'}, {file => 'test2.jpg', price => '2.00', desc => '2nd test'}, {file => 'test3.jpg', price => '3.00', desc => '3rd test'}, {file => 'test4.jpg', price => '4.00', desc => '4th test'} ); my $file_no = scalar (@array_of_hash); # $file_no is now: 4 in this instance as there is 4 hashes in the array. # each with 3 keys {file, price, and desc my @arrh4 = (); prt( "Build the multi-dimension arrays ...\n" ); build_arrays(); prt( "Show and change the hash, adding references to the multi-dimension arrays ...\n" ); show_and_change(); # show, and change the values of the hash my @hk = sort keys %hash; # get sorted array of hash keys ##show_with_extraction(); # extract and show values prt("Show 1 of the hash using 'indexing' ...\n"); show_using_indexing(); # use just indexing to show ##show_showcase(); # run some test on showcase ... prt("Set NEW values into the 'referenced' arrays ...\n"); build_arrays2(); prt("Show 2 of the hash using 'indexing' ... but should be the same as above ...\n"); show_using_indexing(); # use just indexing to show prt("Set 'references' again to the 'new' arrays ...\n"); set_changes(); prt("Show 3 of the hash using 'indexing' ... should be different ...\n"); show_using_indexing(); # use just indexing to show prt('from : http://htmlfixit.com/cgi-tutes/tutorial_Perl_Primer_013_Advanced_data_constructs_An_array_of_hashes.php'."\n"); prt("Show of the hashes in the array \@array_of_hash ...\n"); for ($i = 0; $i < $file_no; $i++) { my $fl = $array_of_hash[$i]{'file'}; my $pr = $array_of_hash[$i]{'price'}; my $ds = $array_of_hash[$i]{'desc'}; prt( 'At $array_of_hash['.$i.']{keys} is: '.$fl.' $'.$pr.' desc='.$ds."\n" ); } build_arr4(); my $fcnt = scalar @arrh4; prt("Show of the $fcnt hash 'references' in the array \@arrh4 ...\n"); for ($i = 0; $i < $fcnt; $i++) { my $fl = $arrh4[$i]{'file'}; my $pr = $arrh4[$i]{'price'}; my $ds = $arrh4[$i]{'desc'}; prt( 'At $arrh4['.$i.']{keys} is: '.$fl.' $'.$pr.' desc='.$ds."\n" ); } build_arr4_2(); my $fcnt = scalar @arrh4; prt("Show of the $fcnt hash 'references' in the array \@arrh4 ...\n"); for ($i = 0; $i < $fcnt; $i++) { my $fl = $arrh4[$i]{'file'}; my $pr = $arrh4[$i]{'price'}; my $ds = $arrh4[$i]{'desc'}; prt( 'At $arrh4['.$i.']{keys} is: '.$fl.' $'.$pr.' desc='.$ds."\n" ); } close_log($outfile,1); exit(0); sub build_arr4() { my %h1 = ('file' => 'test1.jpg', 'price' => '1.00', 'desc' => '1st test'); my %h2 = ('file' => 'test2.jpg', 'price' => '2.00', 'desc' => '2nd test'); my %h3 = ('file' => 'test3.jpg', 'price' => '3.00', 'desc' => '3rd test'); my %h4 = ('file' => 'test4.jpg', 'price' => '4.00', 'desc' => '4th test'); push(@arrh4, \%h1); push(@arrh4, \%h2); push(@arrh4, \%h3); push(@arrh4, \%h4); } sub build_arr4_2() { my %h = (); @arrh4 = (); # clear any previous %h = ('file' => 'test1.png', 'price' => '10.00', 'desc' => 'hr 1st test'); push(@arrh4, \%h); %h = ('file' => 'test2.png', 'price' => '20.00', 'desc' => 'hr 2nd test'); push(@arrh4, \%h); %h = ('file' => 'test3.png', 'price' => '30.00', 'desc' => 'hr 3rd test'); push(@arrh4, \%h); %h = ('file' => 'test4.png', 'price' => '40.00', 'desc' => 'hr 4th test'); push(@arrh4, \%h); } sub show_using_indexing() { foreach $k (@hk) { my $ac = scalar @{$hash{$k}}; prt( "Extracted key $k is an array of $ac arrays ...\n" ); for ($i = 0; $i < $ac; $i++) { my $cnt3 = scalar @{${@{$hash{$k}}}[$i]}; prt( " $i has $cnt3 - " ); for ($i2 = 0; $i2 < $cnt3; $i2++) { $v = ${@{${@{$hash{$k}}}[$i]}}[$i2]; prt( "index[$i][$i2] val=($v) " ); } prt("\n"); } } } sub show_with_extraction() { foreach $k (@hk) { $val = $hash{$k}; my $ac = scalar @{$val}; prt( "$k $ac " ); $cnt = 0; foreach $v (@{$val}) { my $cnt2 = scalar @{$v}; prt("mcnt = [$cnt2] "); for ($i = 0; $i < $cnt2; $i++) { my $v3 = ${@{$v}}[$i]; prt( "[$v3] " ); } } prt("\n"); } } sub show_and_change { foreach $k (keys %hash) { $v = $hash{$k}; prt( "$k => $v " ); my @na = (); switch ($cnt) { case (0) { @na = @marr1; prt( "$k - Changed value to \@marr1" ); } case (1) { @na = @marr2; prt( "$k - Changed value to \@marr2" ); } case (2) { @na = @marr3; prt( "$k - Changed value to \@marr3" ); } } $hash{$k} = \@na; # note - a reference is NOT really just a pointer to ### since in this case @na only has a scope in this for, and ### its value is changed with each iteration ### so a 'reference' is really a 'copy' of the array. $cnt++; prt("\n"); } } sub set_changes { $cnt = 0; foreach $k (keys %hash) { $v = $hash{$k}; ###prt( "$k => $v " ); my @na = (); switch ($cnt) { case (0) { @na = @marr1; prt( "$k - Changed value to \@marr1" ); } case (1) { @na = @marr2; prt( "$k - Changed value to \@marr2" ); } case (2) { @na = @marr3; prt( "$k - Changed value to \@marr3" ); } } $hash{$k} = \@na; # note - a reference is NOT really just a pointer to ### since in this case @na only has a scope in this for, and ### its value is changed with each iteration ### so a 'reference' is really a 'copy' of the array. $cnt++; prt("\n"); } } sub shw() { prt( "Run shw\n" ); } sub show_showcase() { showcase(1); showcase('a'); showcase(42); ##showcase( qw(bread butter) ); showcase('butter'); showcase('123but'); showcase(' A'); showcase( qr/^\s+/ ); } sub showcase($) { my ($sw) = shift; use Switch; ##my @array = qw(bread butter); prt( "switch per case $sw - " ); switch ($sw) { case (1) { prt( "number 1\n" ); } case ('a') { prt( "string a\n" ); } case [1..10,42] { prt( "number in list\n" ); } ##case (%hash) { prt( "entry in hash\n" ); } ##case (\%hash) { prt( "entry in hash\n" ); } ##case (@array) { prt( "item in list\n" ); } case /^\d+/ { prt( "pattern starts numeric, \/^\\d+\/\n" ); } case /^\w+/ { prt( "pattern starts alphanumeric, including _, \/^\\w+\/\n" ); } case qr/^\s+/ { prt( "pattern qr\/\\s+\/\n" ); } #case (\&sub shw) { prt( "arg to subroutine\n" ); } else { prt( "previous cases not true\n" ); } } } sub build_arrays() { push(@marr1, ['A', 1, 'aa']); push(@marr1, ['B', 2, 'bb']); push(@marr1, ['C', 3, 'cc']); push(@marr2, ['D', 4, 'dd']); push(@marr2, ['E', 5, 'ee']); push(@marr2, ['F', 6, 'ff']); push(@marr2, ['X', 10, 'xx']); push(@marr2, ['Y', 11, 'yy']); push(@marr3, ['G', 7, 'gg']); push(@marr3, ['H', 8, 'hh']); push(@marr3, ['I', 9, 'ii']); push(@marr3, ['Z', 12, 'zz']); } sub build_arrays2() { @marr1 = (); @marr2 = (); @marr3 = (); push(@marr3, ['A', 1, 'aa']); push(@marr3, ['B', 2, 'bb']); push(@marr3, ['C', 3, 'cc']); push(@marr1, ['D', 4, 'dd']); push(@marr1, ['E', 5, 'ee']); push(@marr1, ['F', 6, 'ff']); push(@marr1, ['X', 10, 'xx']); push(@marr1, ['Y', 11, 'yy']); push(@marr2, ['G', 7, 'gg']); push(@marr2, ['H', 8, 'hh']); push(@marr2, ['I', 9, 'ii']); push(@marr2, ['Z', 12, 'zz']); } # eof - test5.pl