1N/A## See POD after __END__ 1N/A## Tested on 5.002 and 5.003 without class membership tests: 1N/A }
elsif ( @_ ==
1 ) {
1N/A # This is admittedly a little bit silly: 1N/A # do we ever export anything else than 'struct'...? 1N/A # Determine parameter list structure, one of: 1N/A # struct( class => [ element-list ]) 1N/A # struct( class => { element-list }) 1N/A # struct( element-list ) 1N/A # Latter form assumes current package name as struct name. 1N/A # Ensure we are not, and will not be, a subclass. 1N/A tie @$
isa,
'Class::Struct::Tie_ISA';
1N/A # Create constructor. 1N/A croak "function 'new' already defined in package $class" 1N/A if do {
no strict 'refs';
defined &{$
class .
"::new"} };
1N/A $
out =
"{\n package $class;\n use Carp;\n sub new {\n";
1N/A $
out .=
" my (\$class, \%init) = \@_;\n";
1N/A $
out .=
" \$class = __PACKAGE__ unless \@_;\n";
1N/A my $
init =
"defined(\$init{'$name'}) ? \$init{'$name'} :";
1N/A $
out .=
" croak 'Initializer for $name must be array reference'\n";
1N/A $
out .=
" if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'ARRAY';\n";
1N/A $
out .=
" \$r->$elem = $init [];$cmt\n";
1N/A $
out .=
" croak 'Initializer for $name must be hash reference'\n";
1N/A $
out .=
" if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'HASH';\n";
1N/A $
out .=
" \$r->$elem = $init {};$cmt\n";
1N/A $
out .=
" \$r->$elem = $init undef;$cmt\n";
1N/A elsif( $
type =~ /^\w+(?:::\w+)*$/ ){
1N/A $
out .=
" if (defined(\$init{'$name'})) {\n";
1N/A $
out .=
" if (ref \$init{'$name'} eq 'HASH')\n";
1N/A $
out .=
" { \$r->$elem = $type->new(\%{\$init{'$name'}}) } $cmt\n";
1N/A $
out .=
" elsif (UNIVERSAL::isa(\$init{'$name'}, '$type'))\n";
1N/A $
out .=
" { \$r->$elem = \$init{'$name'} } $cmt\n";
1N/A $
out .=
" else { croak 'Initializer for $name must be hash or $type reference' }\n";
1N/A croak "'$type' is not a valid struct element type";
1N/A $
out .=
" bless \$r, \$class;\n }\n";
1N/A # Create accessor methods. 1N/A if (
do {
no strict 'refs';
defined &{$
class .
"::$name"} } ) {
1N/A warnings::
warnif(
"function '$name' already defined, overrides struct accessor method");
1N/A $
out .=
" sub $name {$cmt\n my \$r = shift;\n";
1N/A $
out .=
" \@_ ? (\$i = shift) : return \$r->$elem;\n";
1N/A $
out .=
" if (ref(\$i) eq 'ARRAY' && !\@_) { \$r->$elem = \$i; return \$r }\n";
1N/A $
out .=
" \@_ ? (\$i = shift) : return \$r->$elem;\n";
1N/A $
out .=
" if (ref(\$i) eq 'HASH' && !\@_) { \$r->$elem = \$i; return \$r }\n";
1N/A $
out .=
" croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$classes{$name}');\n";
1N/A $
out .=
" croak 'Too many args to $name' if \@_ > 1;\n";
1N/A $
out .=
" \@_ ? ($pre\$r->$elem$sel = shift$pst) : $pre\$r->$elem$sel$pst;\n";
1N/A confess "struct usage error";
1N/A croak 'struct class cannot be a subclass (@ISA not allowed)';
1N/AClass::Struct - declare struct-like datatypes as Perl classes 1N/A # declare struct, based on array: 1N/A struct( CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]); 1N/A # declare struct, based on hash: 1N/A struct( CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... }); 1N/A # declare struct, based on array, implicit class name: 1N/A struct( ELEMENT_NAME => ELEMENT_TYPE, ... ); 1N/A # Declare struct at compile time 1N/A use Class::Struct CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]; 1N/A use Class::Struct CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... }; 1N/A # declare struct at compile time, based on array, implicit class name: 1N/A use Class::Struct ELEMENT_NAME => ELEMENT_TYPE, ... ; 1N/A # declare struct with four types of elements: 1N/A struct( s => '$', a => '@', h => '%', c => 'My_Other_Class' ); 1N/A $obj = new Myobj; # constructor 1N/A # scalar type accessor: 1N/A $element_value = $obj->s; # element value 1N/A $obj->s('new value'); # assign to element 1N/A # array type accessor: 1N/A $ary_ref = $obj->a; # reference to whole array 1N/A $ary_element_value = $obj->a(2); # array element value 1N/A $obj->a(2, 'new value'); # assign to array element 1N/A # hash type accessor: 1N/A $hash_ref = $obj->h; # reference to whole hash 1N/A $hash_element_value = $obj->h('x'); # hash element value 1N/A $obj->h('x', 'new value'); # assign to hash element 1N/A # class type accessor: 1N/A $element_value = $obj->c; # object reference 1N/A $obj->c->method(...); # call method of object 1N/A $obj->c(new My_Other_Class); # assign a new object 1N/AC<Class::Struct> exports a single function, C<struct>. 1N/AGiven a list of element names and types, and optionally 1N/Aa class name, C<struct> creates a Perl 5 class that implements 1N/Aa "struct-like" data structure. 1N/AThe new class is given a constructor method, C<new>, for creating 1N/AEach element in the struct data has an accessor method, which is 1N/Aused to assign to the element and to fetch its value. The 1N/Adefault accessor can be overridden by declaring a C<sub> of the 1N/Asame name in the package. (See Example 2.) 1N/AEach element's type can be scalar, array, hash, or class. 1N/A=head2 The C<struct()> function 1N/AThe C<struct> function has three forms of parameter-list. 1N/A struct( CLASS_NAME => [ ELEMENT_LIST ]); 1N/A struct( CLASS_NAME => { ELEMENT_LIST }); 1N/A struct( ELEMENT_LIST ); 1N/AThe first and second forms explicitly identify the name of the 1N/Aclass being created. The third form assumes the current package 1N/Aname as the class name. 1N/AAn object of a class created by the first and third forms is 1N/Abased on an array, whereas an object of a class created by the 1N/Asecond form is based on a hash. The array-based forms will be 1N/Asomewhat faster and smaller; the hash-based forms are more 1N/AThe class created by C<struct> must not be a subclass of another 1N/Aclass other than C<UNIVERSAL>. 1N/AIt can, however, be used as a superclass for other classes. To facilitate 1N/Athis, the generated constructor method uses a two-argument blessing. 1N/AFurthermore, if the class is hash-based, the key of each element is 1N/Aprefixed with the class name (see I<Perl Cookbook>, Recipe 13.12). 1N/AA function named C<new> must not be explicitly defined in a class 1N/Acreated by C<struct>. 1N/AThe I<ELEMENT_LIST> has the form 1N/AEach name-type pair declares one element of the struct. Each 1N/Aelement name will be defined as an accessor method unless a 1N/Amethod by that name is explicitly defined; in the latter case, a 1N/Awarning is issued if the warning flag (B<-w>) is set. 1N/A=head2 Class Creation at Compile Time 1N/AC<Class::Struct> can create your class at compile time. The main reason 1N/Afor doing this is obvious, so your class acts like every other class in 1N/APerl. Creating your class at compile time will make the order of events 1N/Asimilar to using any other class ( or Perl module ). 1N/AThere is no significant speed gain between compile time and run time 1N/Aclass creation, there is just a new, more standard order of events. 1N/A=head2 Element Types and Accessor Methods 1N/AThe four element types -- scalar, array, hash, and class -- are 1N/Arepresented by strings -- C<'$'>, C<'@'>, C<'%'>, and a class name -- 1N/Aoptionally preceded by a C<'*'>. 1N/AThe accessor method provided by C<struct> for an element depends 1N/Aon the declared type of the element. 1N/A=item Scalar (C<'$'> or C<'*$'>) 1N/AThe element is a scalar, and by default is initialized to C<undef> 1N/A(but see L<Initializing with new>). 1N/AThe accessor's argument, if any, is assigned to the element. 1N/AIf the element type is C<'$'>, the value of the element (after 1N/Aassignment) is returned. If the element type is C<'*$'>, a reference 1N/Ato the element is returned. 1N/A=item Array (C<'@'> or C<'*@'>) 1N/AThe element is an array, initialized by default to C<()>. 1N/AWith no argument, the accessor returns a reference to the 1N/Aelement's whole array (whether or not the element was 1N/Aspecified as C<'@'> or C<'*@'>). 1N/AWith one or two arguments, the first argument is an index 1N/Aspecifying one element of the array; the second argument, if 1N/Apresent, is assigned to the array element. If the element type 1N/Ais C<'@'>, the accessor returns the array element value. If the 1N/Aelement type is C<'*@'>, a reference to the array element is 1N/AAs a special case, when the accessor is called with an array reference 1N/Aas the sole argument, this causes an assignment of the whole array element. 1N/AThe object reference is returned. 1N/A=item Hash (C<'%'> or C<'*%'>) 1N/AThe element is a hash, initialized by default to C<()>. 1N/AWith no argument, the accessor returns a reference to the 1N/Aelement's whole hash (whether or not the element was 1N/Aspecified as C<'%'> or C<'*%'>). 1N/AWith one or two arguments, the first argument is a key specifying 1N/Aone element of the hash; the second argument, if present, is 1N/Aassigned to the hash element. If the element type is C<'%'>, the 1N/Aaccessor returns the hash element value. If the element type is 1N/AC<'*%'>, a reference to the hash element is returned. 1N/AAs a special case, when the accessor is called with a hash reference 1N/Aas the sole argument, this causes an assignment of the whole hash element. 1N/AThe object reference is returned. 1N/A=item Class (C<'Class_Name'> or C<'*Class_Name'>) 1N/AThe element's value must be a reference blessed to the named 1N/Aclass or to one of its subclasses. The element is not initialized 1N/AThe accessor's argument, if any, is assigned to the element. The 1N/Aaccessor will C<croak> if this is not an appropriate object 1N/AIf the element type does not start with a C<'*'>, the accessor 1N/Areturns the element value (after assignment). If the element type 1N/Astarts with a C<'*'>, a reference to the element itself is returned. 1N/A=head2 Initializing with C<new> 1N/AC<struct> always creates a constructor called C<new>. That constructor 1N/Amay take a list of initializers for the various elements of the new 1N/AEach initializer is a pair of values: I<element name>C< =E<gt> >I<value>. 1N/AThe initializer value for a scalar element is just a scalar value. The 1N/Ainitializer for an array element is an array reference. The initializer 1N/Afor a hash is a hash reference. 1N/AThe initializer for a class element is an object of the corresponding class, 1N/Aor of one of it's subclasses, or a reference to a hash containing named 1N/Aarguments to be passed to the element's constructor. 1N/ASee Example 3 below for an example of initialization. 1N/AGiving a struct element a class type that is also a struct is how 1N/Astructs are nested. Here, C<Timeval> represents a time (seconds and 1N/Amicroseconds), and C<Rusage> has two elements, each of which is of 1N/A ru_utime => 'Timeval', # user time used 1N/A ru_stime => 'Timeval', # system time used 1N/A struct( Timeval => [ 1N/A tv_secs => '$', # seconds 1N/A tv_usecs => '$', # microseconds 1N/A my $t = Rusage->new(ru_utime=>Timeval->new(), ru_stime=>Timeval->new()); 1N/A # $t->ru_utime and $t->ru_stime are objects of type Timeval. 1N/A # set $t->ru_utime to 100.0 sec and $t->ru_stime to 5.0 sec. 1N/A $t->ru_utime->tv_secs(100); 1N/A $t->ru_utime->tv_usecs(0); 1N/A $t->ru_stime->tv_secs(5); 1N/A $t->ru_stime->tv_usecs(0); 1N/AAn accessor function can be redefined in order to provide 1N/Aadditional checking of values, etc. Here, we want the C<count> 1N/Aelement always to be nonnegative, so we redefine the C<count> 1N/Aaccessor accordingly. 1N/A # declare the struct 1N/A struct ( 'MyObj', { count => '$', stuff => '%' } ); 1N/A # override the default accessor method for 'count' 1N/A die 'count must be nonnegative' if $_[0] < 0; 1N/A $self->{'MyObj::count'} = shift; 1N/A warn "Too many args to count" if @_; 1N/A return $self->{'MyObj::count'}; 1N/A print "\$x->count(5) = ", $x->count(5), "\n"; 1N/A # prints '$x->count(5) = 5' 1N/A print "\$x->count = ", $x->count, "\n"; 1N/A # prints '$x->count = 5' 1N/A print "\$x->count(-5) = ", $x->count(-5), "\n"; 1N/A # dies due to negative argument! 1N/AThe constructor of a generated class can be passed a list 1N/Aof I<element>=>I<value> pairs, with which to initialize the struct. 1N/AIf no initializer is specified for a particular element, its default 1N/Ainitialization is performed instead. Initializers for non-existent 1N/Aelements are silently ignored. 1N/ANote that the initializer for a nested class may be specified as 1N/Aan object of that class, or as a reference to a hash of initializers 1N/Athat are passed on to the nested struct's constructor. 1N/A my $cat = Cat->new( name => 'Socks', 1N/A kittens => ['Monica', 'Kenneth'], 1N/A markings => { socks=>1, blaze=>"white" }, 1N/A breed => Breed->new(name=>'short-hair', cross=>1), 1N/A or: breed => {name=>'short-hair', cross=>1}, 1N/A print "Once a cat called ", $cat->name, "\n"; 1N/A print "(which was a ", $cat->breed->name, ")\n"; 1N/A print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n"; 1N/A=head1 Author and Modification History 1N/AModified by Damian Conway, 2001-09-10, v0.62. 1N/A Modified implicit construction of nested objects. 1N/A Now will also take an object ref instead of requiring a hash ref. 1N/A Also default initializes nested object attributes to undef, rather 1N/A than calling object constructor without args 1N/A Original over-helpfulness was fraught with problems: 1N/A * the class's constructor might not be called 'new' 1N/A * the class might not have a hash-like-arguments constructor 1N/A * the class might not have a no-argument constructor 1N/A * "recursive" data structures didn't work well: 1N/A struct { mother => 'Person', father => 'Person'}; 1N/AModified by Casey West, 2000-11-08, v0.59. 1N/A Added the ability for compile time class creation. 1N/AModified by Damian Conway, 1999-03-05, v0.58. 1N/A Added handling of hash-like arg list to class ctor. 1N/A Changed to two-argument blessing in ctor to support 1N/A derivation from created classes. 1N/A Added classname prefixes to keys in hash-based classes 1N/A (refer to "Perl Cookbook", Recipe 13.12 for rationale). 1N/A Corrected behaviour of accessors for '*@' and '*%' struct 1N/A elements. Package now implements documented behaviour when 1N/A returning a reference to an entire hash or array element. 1N/A Previously these were returned as a reference to a reference 1N/ARenamed to C<Class::Struct> and modified by Jim Miner, 1997-04-02. 1N/A members() function removed. 1N/A Documentation corrected and extended. 1N/A Use of struct() in a subclass prohibited. 1N/A User definition of accessor allowed. 1N/A Treatment of '*' in element types corrected. 1N/A Treatment of classes as element types corrected. 1N/A Class name to struct() made optional. 1N/A Diagnostic checks added. 1N/AOriginally C<Class::Template> by Dean Roehrich. 1N/A # - Moved to Class::Template. 1N/A # - Updated to be a more proper module. 1N/A # - Added "use strict". 1N/A # - Bug in build_methods, was using @var when @$var needed. 1N/A # - Now using my() rather than local(). 1N/A # Uses perl5 classes to create nested data types. 1N/A # This is offered as one implementation of Tom Christiansen's "structs.pl"