ArrayHashMonster

[Dominus]

This isn't a JAPH. It's an obfuscation that's actually useful. (And yes, it's really an obfuscation. I don't know of any other way to accomplish this.)

What does it do? It manufactures an object that can be used as either an array reference or a hash reference.

Why would you ever want such a thing? Well, it's the natural way to present an ordered hash. You could then use $orderedhash->[7] to get item number seven, or $orderedhash->{key} to get the item with the specified key.

Or for example you could have an object that represents a directory. $dir->[3] gets the name of file number 3 from the directory, so it is easy to iterate over the files in the directory, and $dir->{name} gets the stat information for the file named name. (The test.pl file supplied with the module has a demonstration of how to do this.)

Since it was actually useful, I put it on CPAN. Visit search.cpan.org and search for ArrayHashMonster, or just download it now.

Of course, figuring out how it works is left as an exercise. Don't post spoilers here.

[turnstep]

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.

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