Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Re: ArrayHashMonster

by turnstep (Parson)
on Dec 14, 2000 at 18:40 UTC ( #46617=note: print w/replies, xml ) Need Help??


in reply to ArrayHashMonster

Um...it's great that it is on CPAN and everything but why not just post it here (in addition to a link to a gzipped and tar'ed version on another site)? The whole thing is less than 70 lines, after all, and we've seen far worse here, if size is the issue.

Replies are listed 'Best First'.
Re: ArrayHashMonster
by Dominus (Parson) on Dec 14, 2000 at 22:42 UTC
    Says turnstep:

    > why not just post it here? The whole thing is less
    > than 70 lines...

    One reason was that I thought it was longer than it was.

    But the other reason is that I didn't think it would be useful to post it without also posting the demo program, because I was afraid nobody would be able to figure out how to use it. And the demo program is another 77 lines.

    But I guess it couldn't hurt to give it a try. This is ArrayHashMonster.pm:

    #!/usr/bin/perl # # Copyright 2000 M-J. Dominus and the Mad Hungarian Software Works # Unauthorized distribution strictly prohibited # package ArrayHashMonster; require 5.00502; use strict; our $VERSION = '0.03'; BEGIN { @ArrayHashMonster::Siphuncle::ISA = __PACKAGE__ } sub new { my ($pack, $acode, $hcode) = @_; my $siphuncle = $pack->new_siphuncle; my @a; tie @a => $pack, $siphuncle, $acode, $hcode; \@a; } sub new_siphuncle { my ($pack) = @_; my %h; tie %h => $pack; return \%h; } sub set_flag { my ($self, $flagref) = @_; $self->{FLAG} = $flagref; } sub TIEHASH { my ($pack) = @_; my $self = {FLAG => undef}; bless $self => $pack . '::Siphuncle'; } sub TIEARRAY { my ($pack, $siphuncle, $acode, $hcode) = @_; my $flag = undef; my $self = {FLAG => \$flag, SIPHUNCLE => $siphuncle, ACODE => $acode +, HCODE => $hcode}; (tied %$siphuncle)->set_flag(\$flag); bless $self => $pack; } sub FETCH { my ($self, $key) = @_; if (ref($self) =~ /Siphuncle/) { ${$self->{FLAG}} = $key; return 1; } elsif ($key == 0) { return $self->{SIPHUNCLE}; } elsif (defined $ {$self->{FLAG}}) { my $rv = $self->{HCODE}->($ {$self->{FLAG}}); undef $ {$self->{FLAG}}; return $rv; } else { return $self->{ACODE}->($key); } } 1;
    This is the demo program that uses it:

    #!/usr/bin/perl use ArrayHashMonster; # Hi. What am I for? # I provide a reference that looks like a reference to an array and # like a reference to a hash at the same time. # If $z is an ArrayHashMonster object, then you can ask for either of # $z->{foo} or $z->[7]. # # Some sample demonstration uses follow. # Tests start here. print "\n\nTest set 1:\n"; my $x = new ArrayHashMonster sub {"Array $_[0]"}, sub {"Hash $_[0]"}; print $x->[2], "\n"; print $x->{jan}, "\n"; print $x->{February}, "\n"; print $x->{2}, "\n"; # This shows that $x->[2] and $x->{2} are differe +nt print $x->[4], "\n"; ################################################################ print "\n\nTest set 2:\n"; my @fmo = qw(xx janvier février mars avril mai juin juillet août septembre octobre novembre décembre); my @emo = qw(xx January February March April May June July August September October November December); my %e2f; for ($i = 1; $i <= 12; $i++) { my $abbr = substr($emo[$i], 0, 3); $e2f{lc $emo[$i]} = $e2f{lc $abbr} = $fmo[$i]; } my $y = new ArrayHashMonster sub {$fmo[$_[0]]}, sub {$e2f{lc $_[0]}}; print "Feb: ", $y->[2], "\n"; print "Jan: ", $y->{jan}, "\n"; print "Feb: ", $y->{February}, "\n"; print "Apr: ", $y->[4], "\n"; ################################################################ print "\n\nTest set 3:\n"; opendir T, '.' or exit 0; my $start = telldir T; sub fileinfo { my $file = shift; my @stat = stat $file; $stat[2] = sprintf "%o", $stat[2]; $stat[2] =~ s/^4/ d/; $stat[2] =~ s/^10/ f/; $stat[2] =~ s/(\w)0/$1 /; sprintf "File %-32s Size %8d Owner %6d Mode %6s\n", $file, @stat[7,4,2]; } sub filenumber { my $index = shift; seekdir T, $start; my $i = 1; while ($i++ < $index) { readdir T; } return readdir T; } my $z = new ArrayHashMonster \&filenumber, \&fileinfo or die; my $n = 1; for (;;) { my $filename = $z->[$n]; last unless defined $filename; print $z->{$filename}; $n++; }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://46617]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (3)
As of 2019-02-16 13:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I use postfix dereferencing ...









    Results (95 votes). Check out past polls.

    Notices?