From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Mon, 14 May 2001 13:42:38 +0000 (+0000)
Subject: More DWIMminess for Class::Struct: calling the array or hash
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=726cfeaf1bb81f4cf007dab21416f820c3e9b64e;p=p5sagit%2Fp5-mst-13.2.git

More DWIMminess for Class::Struct: calling the array or hash
accessors only with one argument, an array or a hash reference,
sets the underlying array or hash.  This mirrors nicely also
the usage in the constructor.
From Bernd Sokolowsky <ulmo@garozzo.franken.de>, via Damian Conway.

p4raw-id: //depot/perl@10099
---

diff --git a/lib/Class/Struct.pm b/lib/Class/Struct.pm
index 6e5de81..5c68bf3 100644
--- a/lib/Class/Struct.pm
+++ b/lib/Class/Struct.pm
@@ -14,7 +14,7 @@ require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(struct);
 
-$VERSION = '0.59';
+$VERSION = '0.60';
 
 ## Tested on 5.002 and 5.003 without class membership tests:
 my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95);
@@ -203,11 +203,13 @@ sub struct {
             if( defined $arrays{$name} ){
                 $out .= "    my \$i;\n";
                 $out .= "    \@_ ? (\$i = shift) : return \$r->$elem;\n"; 
+                $out .= "    if (ref(\$i) eq 'ARRAY' && !\@_) { \$r->$elem = \$i; return \$r }\n";
                 $sel = "->[\$i]";
             }
             elsif( defined $hashes{$name} ){
                 $out .= "    my \$i;\n";
-                $out .= "    \@_ ? (\$i = shift) : return \$r->$elem;\n"; 
+                $out .= "    \@_ ? (\$i = shift) : return \$r->$elem;\n";
+                $out .= "    if (ref(\$i) eq 'HASH' && !\@_) { \$r->$elem = \$i; return \$r }\n";
                 $sel = "->{\$i}";
             }
             elsif( defined $classes{$name} ){
@@ -389,6 +391,10 @@ is C<'@'>, the accessor returns the array element value.  If the
 element type is C<'*@'>, a reference to the array element is
 returned.
 
+As a special case, when the accessor is called with an array reference
+as the sole argument, this causes an assignment of the whole array element.
+The object reference is returned.
+
 =item Hash (C<'%'> or C<'*%'>)
 
 The element is a hash, initialized by default to C<()>.
@@ -403,6 +409,10 @@ assigned to the hash element.  If the element type is C<'%'>, the
 accessor returns the hash element value.  If the element type is
 C<'*%'>, a reference to the hash element is returned.
 
+As a special case, when the accessor is called with a hash reference
+as the sole argument, this causes an assignment of the whole hash element.
+The object reference is returned.
+
 =item Class (C<'Class_Name'> or C<'*Class_Name'>)
 
 The element's value must be a reference blessed to the named
diff --git a/t/lib/class-struct.t b/t/lib/class-struct.t
index 26505ba..2dfaf85 100644
--- a/t/lib/class-struct.t
+++ b/t/lib/class-struct.t
@@ -5,7 +5,7 @@ BEGIN {
 	@INC = '../lib';
 }
 
-print "1..8\n";
+print "1..10\n";
 
 package aClass;
 
@@ -64,3 +64,13 @@ $obk->SomeElem(123);
 print "not " unless $obk->SomeElem() == 123;
 print "ok 8\n";
 
+$obj->a([4,5,6]);
+
+print "not " unless $obj->a(1) == 5;
+print "ok 9\n";
+
+$obj->h({h=>7,r=>8,f=>9});
+
+print "not " unless $obj->h('r') == 8;
+print "ok 10\n";
+