hashref.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:42 2010 from hashref.pl 2008/10/29 2.8 KB.

#!C:/Perl
# NAME: hashref.pl
# AIM: test returning a HASH reference
# 23/01/2008 - geoff mclane
# see hashref02.pl, for a BETTER example
# see: Yahoo! search 'perl indirect reference'
use strict;
use warnings;
######################
my $num = 3;
my $cnum = sprintf("%03d", $num);
prt( "Num $num = [$cnum]\n" );
my %hash = get_hash();
foreach my $key (keys %hash) {
   my $r = $hash{$key};
   my ($v);
   my $rf = ref($r);
   if (ref($r) eq "HASH") {
        prt( "$key: r is a reference to a hash.\n" );
      foreach my $k (keys %{$r}) {
         $v = ${%{$r}}{$k};
         prt( " $k=$v" );
      }
      prt("\n");
   } elsif (ref($r) eq "ARRAY") {
        prt( "$key: r is a reference to an array.\n" );
      foreach my $a (@{$r}) {
         prt( " $a" );
      }
      prt("\n");
   } elsif (ref($r) eq "SCALAR") {
      prt( "$key: ".$r." (SCALAR)\n" );
   } elsif (ref($r) eq "CODE") {
      prt( "$key: r is (CODE)\n" );
      $r->();   # RUN the CODE reference extracted
    } else {
      if (!ref($r)) {
         prt( "$key: $r (r is not a reference at all)\n" );
      } else {
         prt( "$key: $r [$rf] (is NOT a HASH, CODE or ARRAY reference)\n" );
      }
   }
}
exit(0);
sub foo {
   my $msg = "foo run\n";
   prt($msg);
   #return $msg;
}
sub add_indirect1 {
   my ($num, $val) = @_;
   $$val = $num / 12;   # note '$$' to address the reference
}
sub add_indirect2 {
   my ($num, $knots, $mps) = @_;
   $$knots = $num;
   $$mps = ($num * 0.5144);
}
sub add_indirect3 {
   my ($ref, $num, $href) = @_;
   $href->{$ref}{'knots'} = $num;
   $href->{$ref}{'mps'} = ($num * 0.5144);
}
sub get_next_hr_OK {
   my ($ref, $href) = @_;
   my $tmphr = $ref;
   my $num = 0;
   while ( defined $href->{$tmphr} ) {
      $num++;
      $tmphr = $ref.$num;
   }
   return $tmphr;
}
sub is_in_array {
   my ($val, @marr) = @_;
   foreach my $tst (@marr) {
      if ($tst eq $val) {
         return 1;
      }
   }
   return 0;
}
sub get_next_hr {
   my ($ref, $href) = @_;
   my $tmphr = $ref;
   my $num = 0;
   my @arr = keys( %{$href} );
   prt( "Got ".scalar @arr." keys ...\n" );
   ###while ( defined $href->{$tmphr} ) {
   while ( is_in_array( $tmphr, @arr ) ) {
      $num++;
      $tmphr = $ref.$num;
   }
   return $tmphr;
}
sub get_hash {
   my %new_hash = ();
   my @arr = ('item1', 'item2', 'item3');
   $new_hash{'array'} = \@arr;
   $new_hash{'this'} = 'test';
   $new_hash{'that'}{'one'} = 'test2';
   my %h2 = ();
   $h2{'aaa'} = 'testa';
   $h2{'bbb'} = 'testb';
   $new_hash{'hash'} = \%h2;
   $new_hash{'function'} = \&foo;
   add_indirect1( 123, \$new_hash{'indirect1'} );
   add_indirect2( 100, \$new_hash{'wind'}{'knots'}, \$new_hash{'wind'}{'mps'} );
   add_indirect3( 'wind3', 123, \%new_hash );
   my $tr = 'wind';
   $tr = get_next_hr($tr, \%new_hash);
   add_indirect3( $tr, 456, \%new_hash );
   return %new_hash;
}
sub prt {
   my ($txt) = shift;
   print $txt;
}
# eof - hashref.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional