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