From 430530eaa0b8fbcca89ff5a168c2b5f9ba65a8ce Mon Sep 17 00:00:00 2001 From: Damian Conway Date: Tue, 25 May 1999 20:58:35 -0400 Subject: [19990526.002] Misc. improvements to Class:Struct Message-Id: <199905260458.AAA06411@defender.perl.org> p4raw-id: //depot/perl@3561 --- lib/Class/Struct.pm | 129 ++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 111 insertions(+), 18 deletions(-) (limited to 'lib/Class') diff --git a/lib/Class/Struct.pm b/lib/Class/Struct.pm index 8fddfbf68e..d8327bc7ab 100644 --- a/lib/Class/Struct.pm +++ b/lib/Class/Struct.pm @@ -5,7 +5,7 @@ package Class::Struct; require 5.002; use strict; -use vars qw(@ISA @EXPORT); +use vars qw(@ISA @EXPORT $VERSION); use Carp; @@ -13,6 +13,8 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(struct); +$VERSION = '0.58'; + ## Tested on 5.002 and 5.003 without class membership tests: my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95); @@ -98,6 +100,7 @@ sub struct { my $out = ''; $out = "{\n package $class;\n use Carp;\n sub new {\n"; + $out .= " my (\$class, \%init) = \@_;\n"; my $cnt = 0; my $idx = 0; @@ -115,7 +118,7 @@ sub struct { $type = $decls[$idx+1]; push( @methods, $name ); if( $base_type eq 'HASH' ){ - $elem = "{'$name'}"; + $elem = "{'${class}::$name'}"; } elsif( $base_type eq 'ARRAY' ){ $elem = "[$cnt]"; @@ -126,19 +129,27 @@ sub struct { $refs{$name}++; $type = $1; } + my $init = "defined(\$init{'$name'}) ? \$init{'$name'} :"; if( $type eq '@' ){ - $out .= " \$r->$elem = [];$cmt\n"; + $out .= " croak 'Initializer for $name must be array reference'\n"; + $out .= " if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'ARRAY';\n"; + $out .= " \$r->$elem = $init [];$cmt\n"; $arrays{$name}++; } elsif( $type eq '%' ){ - $out .= " \$r->$elem = {};$cmt\n"; + $out .= " croak 'Initializer for $name must be hash reference'\n"; + $out .= " if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'HASH';\n"; + $out .= " \$r->$elem = $init {};$cmt\n"; $hashes{$name}++; } elsif ( $type eq '$') { - $out .= " \$r->$elem = undef;$cmt\n"; + $out .= " \$r->$elem = $init undef;$cmt\n"; } elsif( $type =~ /^\w+(?:::\w+)*$/ ){ - $out .= " \$r->$elem = '${type}'->new();$cmt\n"; + $init = "defined(\$init{'$name'}) ? \%{\$init{'$name'}} : ()"; + $out .= " croak 'Initializer for $name must be hash reference'\n"; + $out .= " if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'HASH';\n"; + $out .= " \$r->$elem = '${type}'->new($init);$cmt\n"; $classes{$name} = $type; $got_class = 1; } @@ -147,7 +158,7 @@ sub struct { } $idx += 2; } - $out .= " bless \$r;\n }\n"; + $out .= " bless \$r, \$class;\n }\n"; # Create accessor methods. @@ -171,16 +182,16 @@ sub struct { ++$cnt; } elsif( $base_type eq 'HASH' ){ - $elem = "{'$name'}"; + $elem = "{'${class}::$name'}"; } if( defined $arrays{$name} ){ $out .= " my \$i;\n"; - $out .= " \@_ ? (\$i = shift) : return $pre\$r->$elem$pst;\n"; + $out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n"; $sel = "->[\$i]"; } elsif( defined $hashes{$name} ){ $out .= " my \$i;\n"; - $out .= " \@_ ? (\$i = shift) : return $pre\$r->$elem$pst;\n"; + $out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n"; $sel = "->{\$i}"; } elsif( defined $classes{$name} ){ @@ -297,6 +308,11 @@ flexible. The class created by C must not be a subclass of another class other than C. +It can, however, be used as a superclass for other classes. To facilitate +this, the generated constructor method uses a two-argument blessing. +Furthermore, if the class is hash-based, the key of each element is +prefixed with the class name (see I, Recipe 13.12). + A function named C must not be explicitly defined in a class created by C. @@ -323,7 +339,8 @@ on the declared type of the element. =item Scalar (C<'$'> or C<'*$'>) -The element is a scalar, and is initialized to C. +The element is a scalar, and by default is initialized to C +(but see L). The accessor's argument, if any, is assigned to the element. @@ -333,10 +350,11 @@ to the element is returned. =item Array (C<'@'> or C<'*@'>) -The element is an array, initialized to C<()>. +The element is an array, initialized by default to C<()>. With no argument, the accessor returns a reference to the -element's whole array. +element's whole array (whether or not the element was +specified as C<'@'> or C<'*@'). With one or two arguments, the first argument is an index specifying one element of the array; the second argument, if @@ -347,10 +365,11 @@ returned. =item Hash (C<'%'> or C<'*%'>) -The element is a hash, initialized to C<()>. +The element is a hash, initialized by default to C<()>. With no argument, the accessor returns a reference to the -element's whole hash. +element's whole hash (whether or not the element was +specified as C<'%'> or C<'*%'). With one or two arguments, the first argument is a key specifying one element of the hash; the second argument, if present, is @@ -374,6 +393,23 @@ starts with a C<'*'>, a reference to the element itself is returned. =back +=head2 Initializing with C + +C always creates a constructor called C. That constructor +may take a list of initializers for the various elements of the new +struct. + +Each initializer is a pair of values: IC< =E >I. +The initializer value for a scalar element is just a scalar value. The +initializer for an array element is an array reference. The initializer +for a hash is a hash reference. + +The initializer for a class element is also a hash reference, and the +contents of that hash are passed to the element's own constructor. + +See Example 3 below for an example of initialization. + + =head1 EXAMPLES =over @@ -399,8 +435,8 @@ type C. # create an object: my $t = new rusage; - # $t->ru_utime and $t->ru_stime are objects of type timeval. + # $t->ru_utime and $t->ru_stime are objects of type timeval. # set $t->ru_utime to 100.0 sec and $t->ru_stime to 5.0 sec. $t->ru_utime->tv_secs(100); $t->ru_utime->tv_usecs(0); @@ -418,10 +454,10 @@ accessor accordingly. package MyObj; use Class::Struct; - # declare the struct + # declare the struct struct ( 'MyObj', { count => '$', stuff => '%' } ); - # override the default accessor method for 'count' + # override the default accessor method for 'count' sub count { my $self = shift; if ( @_ ) { @@ -443,10 +479,67 @@ accessor accordingly. print "\$x->count(-5) = ", $x->count(-5), "\n"; # dies due to negative argument! +=item Example 3 + +The constructor of a generated class can be passed a list +of I=>I pairs, with which to initialize the struct. +If no initializer is specified for a particular element, its default +initialization is performed instead. Initializers for non-existent +elements are silently ignored. + +Note that the initializer for a nested struct is specified +as an anonymous hash of initializers, which is passed on to the nested +struct's constructor. + + + use Class::Struct; + + struct Breed => + { + name => '$', + cross => '$', + }; + + struct Cat => + [ + name => '$', + kittens => '@', + markings => '%', + breed => 'Breed', + ]; + + + my $cat = Cat->new( name => 'Socks', + kittens => ['Monica', 'Kenneth'], + markings => { socks=>1, blaze=>"white" }, + breed => { name=>'short-hair', cross=>1 }, + ); + + print "Once a cat called ", $cat->name, "\n"; + print "(which was a ", $cat->breed->name, ")\n"; + print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n"; + =head1 Author and Modification History +Modified by Damian Conway, 1999-03-05, v0.58. + + Added handling of hash-like arg list to class ctor. + + Changed to two-argument blessing in ctor to support + derivation from created classes. + + Added classname prefixes to keys in hash-based classes + (refer to "Perl Cookbook", Recipe 13.12 for rationale). + + Corrected behaviour of accessors for '*@' and '*%' struct + elements. Package now implements documented behaviour when + returning a reference to an entire hash or array element. + Previously these were returned as a reference to a reference + to the element. + + Renamed to C and modified by Jim Miner, 1997-04-02. members() function removed. -- cgit v1.2.1