test5.pl to HTML.

index -|- end

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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional