3 ## See POD after __END__
8 use warnings::register;
9 our(@ISA, @EXPORT, $VERSION);
19 ## Tested on 5.002 and 5.003 without class membership tests:
20 my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95);
24 if (@_) { $print = shift }
29 package Class::Struct::Tie_ISA;
33 return bless [], $class;
37 my ($self, $index, $value) = @_;
38 Class::Struct::_subclass_error();
42 my ($self, $index) = @_;
48 return scalar(@$self);
60 $self->export_to_level( 1, $self, @EXPORT );
66 # Determine parameter list structure, one of:
67 # struct( class => [ element-list ])
68 # struct( class => { element-list })
69 # struct( element-list )
70 # Latter form assumes current package name as struct name.
73 my $base_type = ref $_[1];
74 if ( $base_type eq 'HASH' ) {
79 elsif ( $base_type eq 'ARRAY' ) {
86 $class = (caller())[0];
89 _usage_error() if @decls % 2 == 1;
91 # Ensure we are not, and will not be, a subclass.
97 _subclass_error() if @$isa;
98 tie @$isa, 'Class::Struct::Tie_ISA';
100 # Create constructor.
102 croak "function 'new' already defined in package $class"
103 if do { no strict 'refs'; defined &{$class . "::new"} };
113 $out = "{\n package $class;\n use Carp;\n sub new {\n";
114 $out .= " my (\$class, \%init) = \@_;\n";
115 $out .= " \$class = __PACKAGE__ unless \@_;\n";
119 my( $cmt, $name, $type, $elem );
121 if( $base_type eq 'HASH' ){
122 $out .= " my(\$r) = {};\n";
125 elsif( $base_type eq 'ARRAY' ){
126 $out .= " my(\$r) = [];\n";
128 while( $idx < @decls ){
129 $name = $decls[$idx];
130 $type = $decls[$idx+1];
131 push( @methods, $name );
132 if( $base_type eq 'HASH' ){
133 $elem = "{'${class}::$name'}";
135 elsif( $base_type eq 'ARRAY' ){
140 if( $type =~ /^\*(.)/ ){
144 my $init = "defined(\$init{'$name'}) ? \$init{'$name'} :";
146 $out .= " croak 'Initializer for $name must be array reference'\n";
147 $out .= " if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'ARRAY';\n";
148 $out .= " \$r->$elem = $init [];$cmt\n";
151 elsif( $type eq '%' ){
152 $out .= " croak 'Initializer for $name must be hash reference'\n";
153 $out .= " if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'HASH';\n";
154 $out .= " \$r->$elem = $init {};$cmt\n";
157 elsif ( $type eq '$') {
158 $out .= " \$r->$elem = $init undef;$cmt\n";
160 elsif( $type =~ /^\w+(?:::\w+)*$/ ){
161 $init = "defined(\$init{'$name'}) ? \%{\$init{'$name'}} : ()";
162 $out .= " croak 'Initializer for $name must be hash reference'\n";
163 $out .= " if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'HASH';\n";
164 $out .= " \$r->$elem = '${type}'->new($init);$cmt\n";
165 $classes{$name} = $type;
169 croak "'$type' is not a valid struct element type";
173 $out .= " bless \$r, \$class;\n }\n";
175 # Create accessor methods.
177 my( $pre, $pst, $sel );
179 foreach $name (@methods){
180 if ( do { no strict 'refs'; defined &{$class . "::$name"} } ) {
181 warnings::warnif("function '$name' already defined, overrides struct accessor method");
184 $pre = $pst = $cmt = $sel = '';
185 if( defined $refs{$name} ){
188 $cmt = " # returns ref";
190 $out .= " sub $name {$cmt\n my \$r = shift;\n";
191 if( $base_type eq 'ARRAY' ){
195 elsif( $base_type eq 'HASH' ){
196 $elem = "{'${class}::$name'}";
198 if( defined $arrays{$name} ){
199 $out .= " my \$i;\n";
200 $out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n";
203 elsif( defined $hashes{$name} ){
204 $out .= " my \$i;\n";
205 $out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n";
208 elsif( defined $classes{$name} ){
209 if ( $CHECK_CLASS_MEMBERSHIP ) {
210 $out .= " croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$classes{$name}');\n";
213 $out .= " croak 'Too many args to $name' if \@_ > 1;\n";
214 $out .= " \@_ ? ($pre\$r->$elem$sel = shift$pst) : $pre\$r->$elem$sel$pst;\n";
220 print $out if $print;
221 my $result = eval $out;
226 confess "struct usage error";
229 sub _subclass_error {
230 croak 'struct class cannot be a subclass (@ISA not allowed)';
240 Class::Struct - declare struct-like datatypes as Perl classes
245 # declare struct, based on array:
246 struct( CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]);
247 # declare struct, based on hash:
248 struct( CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... });
252 # declare struct, based on array, implicit class name:
253 struct( ELEMENT_NAME => ELEMENT_TYPE, ... );
255 # Declare struct at compile time
256 use Class::Struct CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ];
257 use Class::Struct CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... };
262 # declare struct with four types of elements:
263 struct( s => '$', a => '@', h => '%', c => 'My_Other_Class' );
265 $obj = new Myobj; # constructor
267 # scalar type accessor:
268 $element_value = $obj->s; # element value
269 $obj->s('new value'); # assign to element
271 # array type accessor:
272 $ary_ref = $obj->a; # reference to whole array
273 $ary_element_value = $obj->a(2); # array element value
274 $obj->a(2, 'new value'); # assign to array element
276 # hash type accessor:
277 $hash_ref = $obj->h; # reference to whole hash
278 $hash_element_value = $obj->h('x'); # hash element value
279 $obj->h('x', 'new value'); # assign to hash element
281 # class type accessor:
282 $element_value = $obj->c; # object reference
283 $obj->c->method(...); # call method of object
284 $obj->c(new My_Other_Class); # assign a new object
289 C<Class::Struct> exports a single function, C<struct>.
290 Given a list of element names and types, and optionally
291 a class name, C<struct> creates a Perl 5 class that implements
292 a "struct-like" data structure.
294 The new class is given a constructor method, C<new>, for creating
297 Each element in the struct data has an accessor method, which is
298 used to assign to the element and to fetch its value. The
299 default accessor can be overridden by declaring a C<sub> of the
300 same name in the package. (See Example 2.)
302 Each element's type can be scalar, array, hash, or class.
305 =head2 The C<struct()> function
307 The C<struct> function has three forms of parameter-list.
309 struct( CLASS_NAME => [ ELEMENT_LIST ]);
310 struct( CLASS_NAME => { ELEMENT_LIST });
311 struct( ELEMENT_LIST );
313 The first and second forms explicitly identify the name of the
314 class being created. The third form assumes the current package
315 name as the class name.
317 An object of a class created by the first and third forms is
318 based on an array, whereas an object of a class created by the
319 second form is based on a hash. The array-based forms will be
320 somewhat faster and smaller; the hash-based forms are more
323 The class created by C<struct> must not be a subclass of another
324 class other than C<UNIVERSAL>.
326 It can, however, be used as a superclass for other classes. To facilitate
327 this, the generated constructor method uses a two-argument blessing.
328 Furthermore, if the class is hash-based, the key of each element is
329 prefixed with the class name (see I<Perl Cookbook>, Recipe 13.12).
331 A function named C<new> must not be explicitly defined in a class
332 created by C<struct>.
334 The I<ELEMENT_LIST> has the form
338 Each name-type pair declares one element of the struct. Each
339 element name will be defined as an accessor method unless a
340 method by that name is explicitly defined; in the latter case, a
341 warning is issued if the warning flag (B<-w>) is set.
343 =head2 Class Creation at Compile Time
345 C<Class::Struct> can create your class at compile time. The main reason
346 for doing this is obvious, so your class acts like every other class in
347 Perl. Creating your class at compile time will make the order of events
348 similar to using any other class ( or Perl module ).
350 There is no significant speed gain between compile time and run time
351 class creation, there is just a new, more standard order of events.
353 =head2 Element Types and Accessor Methods
355 The four element types -- scalar, array, hash, and class -- are
356 represented by strings -- C<'$'>, C<'@'>, C<'%'>, and a class name --
357 optionally preceded by a C<'*'>.
359 The accessor method provided by C<struct> for an element depends
360 on the declared type of the element.
364 =item Scalar (C<'$'> or C<'*$'>)
366 The element is a scalar, and by default is initialized to C<undef>
367 (but see L<Initializing with new>).
369 The accessor's argument, if any, is assigned to the element.
371 If the element type is C<'$'>, the value of the element (after
372 assignment) is returned. If the element type is C<'*$'>, a reference
373 to the element is returned.
375 =item Array (C<'@'> or C<'*@'>)
377 The element is an array, initialized by default to C<()>.
379 With no argument, the accessor returns a reference to the
380 element's whole array (whether or not the element was
381 specified as C<'@'> or C<'*@'>).
383 With one or two arguments, the first argument is an index
384 specifying one element of the array; the second argument, if
385 present, is assigned to the array element. If the element type
386 is C<'@'>, the accessor returns the array element value. If the
387 element type is C<'*@'>, a reference to the array element is
390 =item Hash (C<'%'> or C<'*%'>)
392 The element is a hash, initialized by default to C<()>.
394 With no argument, the accessor returns a reference to the
395 element's whole hash (whether or not the element was
396 specified as C<'%'> or C<'*%'>).
398 With one or two arguments, the first argument is a key specifying
399 one element of the hash; the second argument, if present, is
400 assigned to the hash element. If the element type is C<'%'>, the
401 accessor returns the hash element value. If the element type is
402 C<'*%'>, a reference to the hash element is returned.
404 =item Class (C<'Class_Name'> or C<'*Class_Name'>)
406 The element's value must be a reference blessed to the named
407 class or to one of its subclasses. The element is initialized to
408 the result of calling the C<new> constructor of the named class.
410 The accessor's argument, if any, is assigned to the element. The
411 accessor will C<croak> if this is not an appropriate object
414 If the element type does not start with a C<'*'>, the accessor
415 returns the element value (after assignment). If the element type
416 starts with a C<'*'>, a reference to the element itself is returned.
420 =head2 Initializing with C<new>
422 C<struct> always creates a constructor called C<new>. That constructor
423 may take a list of initializers for the various elements of the new
426 Each initializer is a pair of values: I<element name>C< =E<gt> >I<value>.
427 The initializer value for a scalar element is just a scalar value. The
428 initializer for an array element is an array reference. The initializer
429 for a hash is a hash reference.
431 The initializer for a class element is also a hash reference, and the
432 contents of that hash are passed to the element's own constructor.
434 See Example 3 below for an example of initialization.
443 Giving a struct element a class type that is also a struct is how
444 structs are nested. Here, C<timeval> represents a time (seconds and
445 microseconds), and C<rusage> has two elements, each of which is of
451 ru_utime => timeval, # seconds
452 ru_stime => timeval, # microseconds
463 # $t->ru_utime and $t->ru_stime are objects of type timeval.
464 # set $t->ru_utime to 100.0 sec and $t->ru_stime to 5.0 sec.
465 $t->ru_utime->tv_secs(100);
466 $t->ru_utime->tv_usecs(0);
467 $t->ru_stime->tv_secs(5);
468 $t->ru_stime->tv_usecs(0);
473 An accessor function can be redefined in order to provide
474 additional checking of values, etc. Here, we want the C<count>
475 element always to be nonnegative, so we redefine the C<count>
476 accessor accordingly.
482 struct ( 'MyObj', { count => '$', stuff => '%' } );
484 # override the default accessor method for 'count'
488 die 'count must be nonnegative' if $_[0] < 0;
489 $self->{'count'} = shift;
490 warn "Too many args to count" if @_;
492 return $self->{'count'};
497 print "\$x->count(5) = ", $x->count(5), "\n";
498 # prints '$x->count(5) = 5'
500 print "\$x->count = ", $x->count, "\n";
501 # prints '$x->count = 5'
503 print "\$x->count(-5) = ", $x->count(-5), "\n";
504 # dies due to negative argument!
508 The constructor of a generated class can be passed a list
509 of I<element>=>I<value> pairs, with which to initialize the struct.
510 If no initializer is specified for a particular element, its default
511 initialization is performed instead. Initializers for non-existent
512 elements are silently ignored.
514 Note that the initializer for a nested struct is specified
515 as an anonymous hash of initializers, which is passed on to the nested
516 struct's constructor.
536 my $cat = Cat->new( name => 'Socks',
537 kittens => ['Monica', 'Kenneth'],
538 markings => { socks=>1, blaze=>"white" },
539 breed => { name=>'short-hair', cross=>1 },
542 print "Once a cat called ", $cat->name, "\n";
543 print "(which was a ", $cat->breed->name, ")\n";
544 print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n";
548 =head1 Author and Modification History
551 Modified by Casey Tweten, 2000-11-08, v0.59.
553 Added the ability for compile time class creation.
555 Modified by Damian Conway, 1999-03-05, v0.58.
557 Added handling of hash-like arg list to class ctor.
559 Changed to two-argument blessing in ctor to support
560 derivation from created classes.
562 Added classname prefixes to keys in hash-based classes
563 (refer to "Perl Cookbook", Recipe 13.12 for rationale).
565 Corrected behaviour of accessors for '*@' and '*%' struct
566 elements. Package now implements documented behaviour when
567 returning a reference to an entire hash or array element.
568 Previously these were returned as a reference to a reference
572 Renamed to C<Class::Struct> and modified by Jim Miner, 1997-04-02.
574 members() function removed.
575 Documentation corrected and extended.
576 Use of struct() in a subclass prohibited.
577 User definition of accessor allowed.
578 Treatment of '*' in element types corrected.
579 Treatment of classes as element types corrected.
580 Class name to struct() made optional.
581 Diagnostic checks added.
584 Originally C<Class::Template> by Dean Roehrich.
586 # Template.pm --- struct/member template builder
590 # changes/bugs fixed since 28nov94 version:
592 # changes/bugs fixed since 21nov94 version:
594 # changes/bugs fixed since 02sep94 version:
595 # - Moved to Class::Template.
596 # changes/bugs fixed since 20feb94 version:
597 # - Updated to be a more proper module.
598 # - Added "use strict".
599 # - Bug in build_methods, was using @var when @$var needed.
600 # - Now using my() rather than local().
602 # Uses perl5 classes to create nested data types.
603 # This is offered as one implementation of Tom Christiansen's "structs.pl"