Re: Patch for fields.pm (Was: Re: On Pseudohashes)

[Peter Scott <Peter@PSDT.com>]

Oops, got the patch the wrong way around :-(  Thanks, Ron.  Here it is again:

--- lib/fields.pm.orig  Tue Jul 20 10:18:01 1999
+++ lib/fields.pm       Fri Jan 14 21:26:05 2000
@@ -24,6 +24,18 @@
          use fields qw(baz _private);  # not shared with Foo
      }

+    # Pseudo-hash initialization only:
+    use fields;
+    $pseu = fields::ph(dog => 'bark', cat => 'meow', bird => 'tweet');
+
+    $pseu = fields::ph(%hash);
+
+    @keys = qw(cat dog bird frog);
+    $pseu = fields::ph(\@keys);
+
+    @vals = qw(meow bark chirp ribbit);
+    $pseu = fields::ph(\@keys, \@vals);
+
  =head1 DESCRIPTION

  The C<fields> pragma enables compile-time verified class fields.  It
@@ -61,6 +73,25 @@
        $self;
    }

+C<fields::ph> creates and initializes a pseudo-hash from arguments.
+This is for when you want to create a pseudo-hash explicitly and don't
+want to count the indices on your fingers, i.e., rather than type
+
+  $sound = [{ cat => 1, dog => 2, bird => 3 }, 'meow', 'bark', 'tweet'];
+
+you can type
+
+  $sound = fields::ph(cat => 'meow', dog => 'bark', bird => 'tweet');
+
+If the first argument is a reference to an array, the pseudo-hash will
+be created with keys from that array, and if there is a second argument,
+it must also be a reference to an array of the same size whose elements
+will be used as the values.  That makes it particularly useful for
+hashifying subroutine arguments:
+
+  sub dogtag {
+     my $tag = fields::ph([qw(name rank ser_num)], [@_]);
+  }

  =head1 SEE ALSO

@@ -151,6 +182,32 @@
           print "\n";
        }
     }
+}
+
+sub ph {
+   my (%h, $i);
+   my $v = [];
+   if (@_ and ref $_[0] eq 'ARRAY') {
+      my $a = shift;
+      @h{@$a} = 1 .. @$a;
+      if (@_) {
+        $v = shift;
+        unless (! @_ and ref $v eq 'ARRAY' and @$v == @$a) {
+           require Carp;
+           Carp::croak ("Expected at most two refs to equal size arrays\n");
+        }
+      }
+   }
+   else {
+      if (@_ % 2) {
+         require Carp;
+         Carp::croak ("Odd number of elements initializing pseudo-hash 
from hash\n");
+      }
+      $i = 0;
+      @h{grep ++$i % 2, @_} = 1 .. @_ / 2;
+   }
+   $i = 0;
+   [ \%h, @_ ? grep $i++ % 2, @_ : @$v ];
  }

  1;
--- t/lib/fields.t.orig Wed Jan 12 15:00:38 2000
+++ t/lib/fields.t      Wed Jan 12 15:33:15 2000
@@ -82,7 +82,7 @@
      'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6',
  );

-print "1..", int(keys %expect)+5, "\n";
+print "1..", int(keys %expect)+9, "\n";
  my $testno = 0;
  while (my($class, $exp) = each %expect) {
     no strict 'refs';
@@ -109,8 +109,24 @@
  print "not " unless $@ && $@ =~ /^No such pseudo-hash field "notthere"/;
  print "ok ", ++$testno, "\n";

-#fields::_dump();
+my $ph = fields::ph(a => 1, b => 2, c => 3);
+print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
+print "ok ", ++$testno, "\n";
+
+$ph = fields::ph([qw/a b c/], [1, 2, 3]);
+print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
+print "ok ", ++$testno, "\n";
+
+eval '$ph = fields::ph([qw/a b c/], [1])';
+print "not " unless $@ && $@ =~ /^Expected at most/;
+print "ok ", ++$testno, "\n";
+
+eval '$ph = fields::ph("odd")';
+print "not " unless $@ && $@ =~ /^Odd number of/;
+print "ok ", ++$testno, "\n";

+
+#fields::_dump();
  # check if
  {
      package Foo;

--
Peter Scott
Pacific Systems Design Technologies

---

[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]

---