3 ## See POD after __END__
8 use vars qw(@ISA @EXPORT);
16 ## Tested on 5.002 and 5.003 without class membership tests:
17 my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95);
21 if (@_) { $print = shift }
26 package Class::Struct::Tie_ISA;
30 return bless [], $class;
34 my ($self, $index, $value) = @_;
35 Class::Struct::_subclass_error();
39 my ($self, $index) = @_;
45 return scalar(@$self);
53 # Determine parameter list structure, one of:
54 # struct( class => [ element-list ])
55 # struct( class => { element-list })
56 # struct( element-list )
57 # Latter form assumes current package name as struct name.
60 my $base_type = ref $_[1];
61 if ( $base_type eq 'HASH' ) {
66 elsif ( $base_type eq 'ARRAY' ) {
73 $class = (caller())[0];
76 _usage_error() if @decls % 2 == 1;
78 # Ensure we are not, and will not be, a subclass.
84 _subclass_error() if @$isa;
85 tie @$isa, 'Class::Struct::Tie_ISA';
89 croak "function 'new' already defined in package $class"
90 if do { no strict 'refs'; defined &{$class . "::new"} };
100 $out = "{\n package $class;\n use Carp;\n sub new {\n";
104 my( $cmt, $name, $type, $elem );
106 if( $base_type eq 'HASH' ){
107 $out .= " my(\$r) = {};\n";
110 elsif( $base_type eq 'ARRAY' ){
111 $out .= " my(\$r) = [];\n";
113 while( $idx < @decls ){
114 $name = $decls[$idx];
115 $type = $decls[$idx+1];
116 push( @methods, $name );
117 if( $base_type eq 'HASH' ){
120 elsif( $base_type eq 'ARRAY' ){
125 if( $type =~ /^\*(.)/ ){
130 $out .= " \$r->$elem = [];$cmt\n";
133 elsif( $type eq '%' ){
134 $out .= " \$r->$elem = {};$cmt\n";
137 elsif ( $type eq '$') {
138 $out .= " \$r->$elem = undef;$cmt\n";
140 elsif( $type =~ /^\w+(?:::\w+)*$/ ){
141 $out .= " \$r->$elem = '${type}'->new();$cmt\n";
142 $classes{$name} = $type;
146 croak "'$type' is not a valid struct element type";
150 $out .= " bless \$r;\n }\n";
152 # Create accessor methods.
154 my( $pre, $pst, $sel );
156 foreach $name (@methods){
157 if ( do { no strict 'refs'; defined &{$class . "::$name"} } ) {
158 carp "function '$name' already defined, overrides struct accessor method"
162 $pre = $pst = $cmt = $sel = '';
163 if( defined $refs{$name} ){
166 $cmt = " # returns ref";
168 $out .= " sub $name {$cmt\n my \$r = shift;\n";
169 if( $base_type eq 'ARRAY' ){
173 elsif( $base_type eq 'HASH' ){
176 if( defined $arrays{$name} ){
177 $out .= " my \$i;\n";
178 $out .= " \@_ ? (\$i = shift) : return $pre\$r->$elem$pst;\n";
181 elsif( defined $hashes{$name} ){
182 $out .= " my \$i;\n";
183 $out .= " \@_ ? (\$i = shift) : return $pre\$r->$elem$pst;\n";
186 elsif( defined $classes{$name} ){
187 if ( $CHECK_CLASS_MEMBERSHIP ) {
188 $out .= " croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$classes{$name}');\n";
191 $out .= " croak 'Too many args to $name' if \@_ > 1;\n";
192 $out .= " \@_ ? ($pre\$r->$elem$sel = shift$pst) : $pre\$r->$elem$sel$pst;\n";
198 print $out if $print;
199 my $result = eval $out;
204 confess "struct usage error";
207 sub _subclass_error {
208 croak 'struct class cannot be a subclass (@ISA not allowed)';
218 Class::Struct - declare struct-like datatypes as Perl classes
223 # declare struct, based on array:
224 struct( CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]);
225 # declare struct, based on hash:
226 struct( CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... });
230 # declare struct, based on array, implicit class name:
231 struct( ELEMENT_NAME => ELEMENT_TYPE, ... );
236 # declare struct with four types of elements:
237 struct( s => '$', a => '@', h => '%', c => 'My_Other_Class' );
239 $obj = new Myobj; # constructor
241 # scalar type accessor:
242 $element_value = $obj->s; # element value
243 $obj->s('new value'); # assign to element
245 # array type accessor:
246 $ary_ref = $obj->a; # reference to whole array
247 $ary_element_value = $obj->a(2); # array element value
248 $obj->a(2, 'new value'); # assign to array element
250 # hash type accessor:
251 $hash_ref = $obj->h; # reference to whole hash
252 $hash_element_value = $obj->h('x'); # hash element value
253 $obj->h('x', 'new value'); # assign to hash element
255 # class type accessor:
256 $element_value = $obj->c; # object reference
257 $obj->c->method(...); # call method of object
258 $obj->c(new My_Other_Class); # assign a new object
263 C<Class::Struct> exports a single function, C<struct>.
264 Given a list of element names and types, and optionally
265 a class name, C<struct> creates a Perl 5 class that implements
266 a "struct-like" data structure.
268 The new class is given a constructor method, C<new>, for creating
271 Each element in the struct data has an accessor method, which is
272 used to assign to the element and to fetch its value. The
273 default accessor can be overridden by declaring a C<sub> of the
274 same name in the package. (See Example 2.)
276 Each element's type can be scalar, array, hash, or class.
279 =head2 The C<struct()> function
281 The C<struct> function has three forms of parameter-list.
283 struct( CLASS_NAME => [ ELEMENT_LIST ]);
284 struct( CLASS_NAME => { ELEMENT_LIST });
285 struct( ELEMENT_LIST );
287 The first and second forms explicitly identify the name of the
288 class being created. The third form assumes the current package
289 name as the class name.
291 An object of a class created by the first and third forms is
292 based on an array, whereas an object of a class created by the
293 second form is based on a hash. The array-based forms will be
294 somewhat faster and smaller; the hash-based forms are more
297 The class created by C<struct> must not be a subclass of another
298 class other than C<UNIVERSAL>.
300 A function named C<new> must not be explicitly defined in a class
301 created by C<struct>.
303 The I<ELEMENT_LIST> has the form
307 Each name-type pair declares one element of the struct. Each
308 element name will be defined as an accessor method unless a
309 method by that name is explicitly defined; in the latter case, a
310 warning is issued if the warning flag (B<-w>) is set.
313 =head2 Element Types and Accessor Methods
315 The four element types -- scalar, array, hash, and class -- are
316 represented by strings -- C<'$'>, C<'@'>, C<'%'>, and a class name --
317 optionally preceded by a C<'*'>.
319 The accessor method provided by C<struct> for an element depends
320 on the declared type of the element.
324 =item Scalar (C<'$'> or C<'*$'>)
326 The element is a scalar, and is initialized to C<undef>.
328 The accessor's argument, if any, is assigned to the element.
330 If the element type is C<'$'>, the value of the element (after
331 assignment) is returned. If the element type is C<'*$'>, a reference
332 to the element is returned.
334 =item Array (C<'@'> or C<'*@'>)
336 The element is an array, initialized to C<()>.
338 With no argument, the accessor returns a reference to the
339 element's whole array.
341 With one or two arguments, the first argument is an index
342 specifying one element of the array; the second argument, if
343 present, is assigned to the array element. If the element type
344 is C<'@'>, the accessor returns the array element value. If the
345 element type is C<'*@'>, a reference to the array element is
348 =item Hash (C<'%'> or C<'*%'>)
350 The element is a hash, initialized to C<()>.
352 With no argument, the accessor returns a reference to the
353 element's whole hash.
355 With one or two arguments, the first argument is a key specifying
356 one element of the hash; the second argument, if present, is
357 assigned to the hash element. If the element type is C<'%'>, the
358 accessor returns the hash element value. If the element type is
359 C<'*%'>, a reference to the hash element is returned.
361 =item Class (C<'Class_Name'> or C<'*Class_Name'>)
363 The element's value must be a reference blessed to the named
364 class or to one of its subclasses. The element is initialized to
365 the result of calling the C<new> constructor of the named class.
367 The accessor's argument, if any, is assigned to the element. The
368 accessor will C<croak> if this is not an appropriate object
371 If the element type does not start with a C<'*'>, the accessor
372 returns the element value (after assignment). If the element type
373 starts with a C<'*'>, a reference to the element itself is returned.
383 Giving a struct element a class type that is also a struct is how
384 structs are nested. Here, C<timeval> represents a time (seconds and
385 microseconds), and C<rusage> has two elements, each of which is of
391 ru_utime => timeval, # seconds
392 ru_stime => timeval, # microseconds
402 # $t->ru_utime and $t->ru_stime are objects of type timeval.
404 # set $t->ru_utime to 100.0 sec and $t->ru_stime to 5.0 sec.
405 $t->ru_utime->tv_secs(100);
406 $t->ru_utime->tv_usecs(0);
407 $t->ru_stime->tv_secs(5);
408 $t->ru_stime->tv_usecs(0);
413 An accessor function can be redefined in order to provide
414 additional checking of values, etc. Here, we want the C<count>
415 element always to be nonnegative, so we redefine the C<count>
416 accessor accordingly.
422 struct ( 'MyObj', { count => '$', stuff => '%' } );
424 # override the default accessor method for 'count'
428 die 'count must be nonnegative' if $_[0] < 0;
429 $self->{'count'} = shift;
430 warn "Too many args to count" if @_;
432 return $self->{'count'};
437 print "\$x->count(5) = ", $x->count(5), "\n";
438 # prints '$x->count(5) = 5'
440 print "\$x->count = ", $x->count, "\n";
441 # prints '$x->count = 5'
443 print "\$x->count(-5) = ", $x->count(-5), "\n";
444 # dies due to negative argument!
447 =head1 Author and Modification History
450 Renamed to C<Class::Struct> and modified by Jim Miner, 1997-04-02.
452 members() function removed.
453 Documentation corrected and extended.
454 Use of struct() in a subclass prohibited.
455 User definition of accessor allowed.
456 Treatment of '*' in element types corrected.
457 Treatment of classes as element types corrected.
458 Class name to struct() made optional.
459 Diagnostic checks added.
462 Originally C<Class::Template> by Dean Roehrich.
464 # Template.pm --- struct/member template builder
468 # changes/bugs fixed since 28nov94 version:
470 # changes/bugs fixed since 21nov94 version:
472 # changes/bugs fixed since 02sep94 version:
473 # - Moved to Class::Template.
474 # changes/bugs fixed since 20feb94 version:
475 # - Updated to be a more proper module.
476 # - Added "use strict".
477 # - Bug in build_methods, was using @var when @$var needed.
478 # - Now using my() rather than local().
480 # Uses perl5 classes to create nested data types.
481 # This is offered as one implementation of Tom Christiansen's "structs.pl"