Re: ArrayHashMonster

[Dominus]

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++;
}