| File | /usr/lib/perl5/5.10.1/Class/Struct.pm |
| Statements Executed | 369 |
| Statement Execution Time | 11.1ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 4.55ms | 4.87ms | Class::Struct::struct |
| 1 | 1 | 1 | 158µs | 158µs | Class::Struct::BEGIN@5 |
| 1 | 1 | 1 | 48µs | 420µs | Class::Struct::BEGIN@8 |
| 1 | 1 | 1 | 43µs | 728µs | Class::Struct::import |
| 1 | 1 | 1 | 36µs | 264µs | Class::Struct::BEGIN@11 |
| 1 | 1 | 1 | 33µs | 87µs | Class::Struct::BEGIN@99 |
| 1 | 1 | 1 | 32µs | 43µs | Class::Struct::BEGIN@7 |
| 1 | 1 | 1 | 31µs | 81µs | Class::Struct::BEGIN@188 |
| 1 | 1 | 1 | 30µs | 222µs | Class::Struct::BEGIN@108 |
| 13 | 1 | 2 | 23µs | 23µs | Class::Struct::CORE:match (opcode) |
| 1 | 1 | 1 | 21µs | 21µs | Class::Struct::Tie_ISA::TIEARRAY |
| 0 | 0 | 0 | 0s | 0s | Class::Struct::Tie_ISA::DESTROY |
| 0 | 0 | 0 | 0s | 0s | Class::Struct::Tie_ISA::FETCH |
| 0 | 0 | 0 | 0s | 0s | Class::Struct::Tie_ISA::FETCHSIZE |
| 0 | 0 | 0 | 0s | 0s | Class::Struct::Tie_ISA::STORE |
| 0 | 0 | 0 | 0s | 0s | Class::Struct::_subclass_error |
| 0 | 0 | 0 | 0s | 0s | Class::Struct::_usage_error |
| 0 | 0 | 0 | 0s | 0s | Class::Struct::printem |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Class::Struct; | ||||
| 2 | |||||
| 3 | ## See POD after __END__ | ||||
| 4 | |||||
| 5 | 3 | 260µs | 1 | 158µs | # spent 158µs within Class::Struct::BEGIN@5 which was called
# once (158µs+0s) by File::stat::BEGIN@27 at line 5 # spent 158µs making 1 call to Class::Struct::BEGIN@5 |
| 6 | |||||
| 7 | 3 | 289µs | 2 | 55µs | # spent 43µs (32+11) within Class::Struct::BEGIN@7 which was called
# once (32µs+11µs) by File::stat::BEGIN@27 at line 7 # spent 43µs making 1 call to Class::Struct::BEGIN@7
# spent 12µs making 1 call to strict::import |
| 8 | 3 | 218µs | 2 | 793µs | # spent 420µs (48+373) within Class::Struct::BEGIN@8 which was called
# once (48µs+373µs) by File::stat::BEGIN@27 at line 8 # spent 420µs making 1 call to Class::Struct::BEGIN@8
# spent 373µs making 1 call to warnings::register::import |
| 9 | 1 | 3µs | our(@ISA, @EXPORT, $VERSION); | ||
| 10 | |||||
| 11 | 3 | 1.38ms | 2 | 492µs | # spent 264µs (36+228) within Class::Struct::BEGIN@11 which was called
# once (36µs+228µs) by File::stat::BEGIN@27 at line 11 # spent 264µs making 1 call to Class::Struct::BEGIN@11
# spent 228µs making 1 call to Exporter::import |
| 12 | |||||
| 13 | 1 | 2µs | require Exporter; | ||
| 14 | 1 | 26µs | @ISA = qw(Exporter); | ||
| 15 | 1 | 3µs | @EXPORT = qw(struct); | ||
| 16 | |||||
| 17 | 1 | 2µs | $VERSION = '0.63'; | ||
| 18 | |||||
| 19 | ## Tested on 5.002 and 5.003 without class membership tests: | ||||
| 20 | 1 | 5µs | my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95); | ||
| 21 | |||||
| 22 | 1 | 2µs | my $print = 0; | ||
| 23 | sub printem { | ||||
| 24 | if (@_) { $print = shift } | ||||
| 25 | else { $print++ } | ||||
| 26 | } | ||||
| 27 | |||||
| 28 | { | ||||
| 29 | 1 | 4µs | package Class::Struct::Tie_ISA; | ||
| 30 | |||||
| 31 | # spent 21µs within Class::Struct::Tie_ISA::TIEARRAY which was called
# once (21µs+0s) by Class::Struct::struct at line 103 | ||||
| 32 | 1 | 3µs | my $class = shift; | ||
| 33 | 1 | 27µs | return bless [], $class; | ||
| 34 | } | ||||
| 35 | |||||
| 36 | sub STORE { | ||||
| 37 | my ($self, $index, $value) = @_; | ||||
| 38 | Class::Struct::_subclass_error(); | ||||
| 39 | } | ||||
| 40 | |||||
| 41 | sub FETCH { | ||||
| 42 | my ($self, $index) = @_; | ||||
| 43 | $self->[$index]; | ||||
| 44 | } | ||||
| 45 | |||||
| 46 | sub FETCHSIZE { | ||||
| 47 | my $self = shift; | ||||
| 48 | return scalar(@$self); | ||||
| 49 | } | ||||
| 50 | |||||
| 51 | sub DESTROY { } | ||||
| 52 | } | ||||
| 53 | |||||
| 54 | # spent 728µs (43+685) within Class::Struct::import which was called
# once (43µs+685µs) by File::stat::BEGIN@27 at line 27 of File/stat.pm | ||||
| 55 | 1 | 3µs | my $self = shift; | ||
| 56 | |||||
| 57 | 1 | 26µs | 1 | 274µs | if ( @_ == 0 ) { # spent 274µs making 1 call to Exporter::export_to_level |
| 58 | $self->export_to_level( 1, $self, @EXPORT ); | ||||
| 59 | } elsif ( @_ == 1 ) { | ||||
| 60 | # This is admittedly a little bit silly: | ||||
| 61 | # do we ever export anything else than 'struct'...? | ||||
| 62 | $self->export_to_level( 1, $self, @_ ); | ||||
| 63 | } else { | ||||
| 64 | goto &struct; | ||||
| 65 | } | ||||
| 66 | } | ||||
| 67 | |||||
| 68 | # spent 4.87ms (4.55+316µs) within Class::Struct::struct which was called
# once (4.55ms+316µs) by Path::Class::Entity::BEGIN@7 at line 29 of File/stat.pm | ||||
| 69 | |||||
| 70 | # Determine parameter list structure, one of: | ||||
| 71 | # struct( class => [ element-list ]) | ||||
| 72 | # struct( class => { element-list }) | ||||
| 73 | # struct( element-list ) | ||||
| 74 | # Latter form assumes current package name as struct name. | ||||
| 75 | |||||
| 76 | 1 | 2µs | my ($class, @decls); | ||
| 77 | 1 | 4µs | my $base_type = ref $_[1]; | ||
| 78 | 1 | 4µs | if ( $base_type eq 'HASH' ) { | ||
| 79 | $class = shift; | ||||
| 80 | @decls = %{shift()}; | ||||
| 81 | _usage_error() if @_; | ||||
| 82 | } | ||||
| 83 | elsif ( $base_type eq 'ARRAY' ) { | ||||
| 84 | 1 | 2µs | $class = shift; | ||
| 85 | 1 | 38µs | @decls = @{shift()}; | ||
| 86 | 1 | 2µs | _usage_error() if @_; | ||
| 87 | } | ||||
| 88 | else { | ||||
| 89 | $base_type = 'ARRAY'; | ||||
| 90 | $class = (caller())[0]; | ||||
| 91 | @decls = @_; | ||||
| 92 | } | ||||
| 93 | |||||
| 94 | 1 | 3µs | _usage_error() if @decls % 2 == 1; | ||
| 95 | |||||
| 96 | # Ensure we are not, and will not be, a subclass. | ||||
| 97 | |||||
| 98 | 1 | 4µs | my $isa = do { | ||
| 99 | 3 | 503µs | 2 | 141µs | # spent 87µs (33+54) within Class::Struct::BEGIN@99 which was called
# once (33µs+54µs) by File::stat::BEGIN@27 at line 99 # spent 87µs making 1 call to Class::Struct::BEGIN@99
# spent 54µs making 1 call to strict::unimport |
| 100 | 1 | 10µs | \@{$class . '::ISA'}; | ||
| 101 | }; | ||||
| 102 | 1 | 2µs | _subclass_error() if @$isa; | ||
| 103 | 1 | 14µs | 1 | 21µs | tie @$isa, 'Class::Struct::Tie_ISA'; # spent 21µs making 1 call to Class::Struct::Tie_ISA::TIEARRAY |
| 104 | |||||
| 105 | # Create constructor. | ||||
| 106 | |||||
| 107 | croak "function 'new' already defined in package $class" | ||||
| 108 | 5 | 2.02ms | 2 | 414µs | # spent 222µs (30+192) within Class::Struct::BEGIN@108 which was called
# once (30µs+192µs) by File::stat::BEGIN@27 at line 108 # spent 222µs making 1 call to Class::Struct::BEGIN@108
# spent 192µs making 1 call to strict::unimport |
| 109 | |||||
| 110 | 1 | 2µs | my @methods = (); | ||
| 111 | 1 | 2µs | my %refs = (); | ||
| 112 | 1 | 3µs | my %arrays = (); | ||
| 113 | 1 | 2µs | my %hashes = (); | ||
| 114 | 1 | 2µs | my %classes = (); | ||
| 115 | 1 | 2µs | my $got_class = 0; | ||
| 116 | 1 | 3µs | my $out = ''; | ||
| 117 | |||||
| 118 | 1 | 5µs | $out = "{\n package $class;\n use Carp;\n sub new {\n"; | ||
| 119 | 1 | 2µs | $out .= " my (\$class, \%init) = \@_;\n"; | ||
| 120 | 1 | 2µs | $out .= " \$class = __PACKAGE__ unless \@_;\n"; | ||
| 121 | |||||
| 122 | 1 | 2µs | my $cnt = 0; | ||
| 123 | 1 | 1µs | my $idx = 0; | ||
| 124 | 1 | 2µs | my( $cmt, $name, $type, $elem ); | ||
| 125 | |||||
| 126 | 1 | 3µs | if( $base_type eq 'HASH' ){ | ||
| 127 | $out .= " my(\$r) = {};\n"; | ||||
| 128 | $cmt = ''; | ||||
| 129 | } | ||||
| 130 | elsif( $base_type eq 'ARRAY' ){ | ||||
| 131 | $out .= " my(\$r) = [];\n"; | ||||
| 132 | } | ||||
| 133 | 1 | 5µs | while( $idx < @decls ){ | ||
| 134 | 13 | 25µs | $name = $decls[$idx]; | ||
| 135 | 13 | 24µs | $type = $decls[$idx+1]; | ||
| 136 | 13 | 35µs | push( @methods, $name ); | ||
| 137 | 13 | 44µs | if( $base_type eq 'HASH' ){ | ||
| 138 | $elem = "{'${class}::$name'}"; | ||||
| 139 | } | ||||
| 140 | elsif( $base_type eq 'ARRAY' ){ | ||||
| 141 | 13 | 38µs | $elem = "[$cnt]"; | ||
| 142 | 13 | 20µs | ++$cnt; | ||
| 143 | 13 | 27µs | $cmt = " # $name"; | ||
| 144 | } | ||||
| 145 | 13 | 128µs | 13 | 23µs | if( $type =~ /^\*(.)/ ){ # spent 23µs making 13 calls to Class::Struct::CORE:match, avg 2µs/call |
| 146 | $refs{$name}++; | ||||
| 147 | $type = $1; | ||||
| 148 | } | ||||
| 149 | 13 | 43µs | my $init = "defined(\$init{'$name'}) ? \$init{'$name'} :"; | ||
| 150 | 13 | 112µs | if( $type eq '@' ){ | ||
| 151 | $out .= " croak 'Initializer for $name must be array reference'\n"; | ||||
| 152 | $out .= " if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'ARRAY';\n"; | ||||
| 153 | $out .= " \$r->$elem = $init [];$cmt\n"; | ||||
| 154 | $arrays{$name}++; | ||||
| 155 | } | ||||
| 156 | elsif( $type eq '%' ){ | ||||
| 157 | $out .= " croak 'Initializer for $name must be hash reference'\n"; | ||||
| 158 | $out .= " if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'HASH';\n"; | ||||
| 159 | $out .= " \$r->$elem = $init {};$cmt\n"; | ||||
| 160 | $hashes{$name}++; | ||||
| 161 | } | ||||
| 162 | elsif ( $type eq '$') { | ||||
| 163 | $out .= " \$r->$elem = $init undef;$cmt\n"; | ||||
| 164 | } | ||||
| 165 | elsif( $type =~ /^\w+(?:::\w+)*$/ ){ | ||||
| 166 | $out .= " if (defined(\$init{'$name'})) {\n"; | ||||
| 167 | $out .= " if (ref \$init{'$name'} eq 'HASH')\n"; | ||||
| 168 | $out .= " { \$r->$elem = $type->new(\%{\$init{'$name'}}) } $cmt\n"; | ||||
| 169 | $out .= " elsif (UNIVERSAL::isa(\$init{'$name'}, '$type'))\n"; | ||||
| 170 | $out .= " { \$r->$elem = \$init{'$name'} } $cmt\n"; | ||||
| 171 | $out .= " else { croak 'Initializer for $name must be hash or $type reference' }\n"; | ||||
| 172 | $out .= " }\n"; | ||||
| 173 | $classes{$name} = $type; | ||||
| 174 | $got_class = 1; | ||||
| 175 | } | ||||
| 176 | else{ | ||||
| 177 | croak "'$type' is not a valid struct element type"; | ||||
| 178 | } | ||||
| 179 | 13 | 59µs | $idx += 2; | ||
| 180 | } | ||||
| 181 | 1 | 3µs | $out .= " bless \$r, \$class;\n }\n"; | ||
| 182 | |||||
| 183 | # Create accessor methods. | ||||
| 184 | |||||
| 185 | 1 | 2µs | my( $pre, $pst, $sel ); | ||
| 186 | 1 | 2µs | $cnt = 0; | ||
| 187 | 1 | 6µs | foreach $name (@methods){ | ||
| 188 | 29 | 1.94ms | 2 | 130µs | # spent 81µs (31+49) within Class::Struct::BEGIN@188 which was called
# once (31µs+49µs) by File::stat::BEGIN@27 at line 188 # spent 81µs making 1 call to Class::Struct::BEGIN@188
# spent 49µs making 1 call to strict::unimport |
| 189 | warnings::warnif("function '$name' already defined, overrides struct accessor method"); | ||||
| 190 | } | ||||
| 191 | else { | ||||
| 192 | 13 | 34µs | $pre = $pst = $cmt = $sel = ''; | ||
| 193 | 13 | 21µs | if( defined $refs{$name} ){ | ||
| 194 | $pre = "\\("; | ||||
| 195 | $pst = ")"; | ||||
| 196 | $cmt = " # returns ref"; | ||||
| 197 | } | ||||
| 198 | 13 | 40µs | $out .= " sub $name {$cmt\n my \$r = shift;\n"; | ||
| 199 | 13 | 48µs | if( $base_type eq 'ARRAY' ){ | ||
| 200 | 13 | 33µs | $elem = "[$cnt]"; | ||
| 201 | 13 | 22µs | ++$cnt; | ||
| 202 | } | ||||
| 203 | elsif( $base_type eq 'HASH' ){ | ||||
| 204 | $elem = "{'${class}::$name'}"; | ||||
| 205 | } | ||||
| 206 | 13 | 95µs | if( defined $arrays{$name} ){ | ||
| 207 | $out .= " my \$i;\n"; | ||||
| 208 | $out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n"; | ||||
| 209 | $out .= " if (ref(\$i) eq 'ARRAY' && !\@_) { \$r->$elem = \$i; return \$r }\n"; | ||||
| 210 | $sel = "->[\$i]"; | ||||
| 211 | } | ||||
| 212 | elsif( defined $hashes{$name} ){ | ||||
| 213 | $out .= " my \$i;\n"; | ||||
| 214 | $out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n"; | ||||
| 215 | $out .= " if (ref(\$i) eq 'HASH' && !\@_) { \$r->$elem = \$i; return \$r }\n"; | ||||
| 216 | $sel = "->{\$i}"; | ||||
| 217 | } | ||||
| 218 | elsif( defined $classes{$name} ){ | ||||
| 219 | if ( $CHECK_CLASS_MEMBERSHIP ) { | ||||
| 220 | $out .= " croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$classes{$name}');\n"; | ||||
| 221 | } | ||||
| 222 | } | ||||
| 223 | 13 | 36µs | $out .= " croak 'Too many args to $name' if \@_ > 1;\n"; | ||
| 224 | 13 | 71µs | $out .= " \@_ ? ($pre\$r->$elem$sel = shift$pst) : $pre\$r->$elem$sel$pst;\n"; | ||
| 225 | 13 | 25µs | $out .= " }\n"; | ||
| 226 | } | ||||
| 227 | } | ||||
| 228 | 1 | 2µs | $out .= "}\n1;\n"; | ||
| 229 | |||||
| 230 | 1 | 1µs | print $out if $print; | ||
| 231 | 1 | 3.09ms | 2 | 493µs | my $result = eval $out; # spent 272µs making 1 call to File::stat::BEGIN@3
# spent 221µs making 1 call to Exporter::import |
| 232 | 1 | 143µs | carp $@ if $@; | ||
| 233 | } | ||||
| 234 | |||||
| 235 | sub _usage_error { | ||||
| 236 | confess "struct usage error"; | ||||
| 237 | } | ||||
| 238 | |||||
| 239 | sub _subclass_error { | ||||
| 240 | croak 'struct class cannot be a subclass (@ISA not allowed)'; | ||||
| 241 | } | ||||
| 242 | |||||
| 243 | 1 | 23µs | 1; # for require | ||
| 244 | |||||
| 245 | |||||
| 246 | __END__ | ||||
| 247 | |||||
| 248 | =head1 NAME | ||||
| 249 | |||||
| 250 | Class::Struct - declare struct-like datatypes as Perl classes | ||||
| 251 | |||||
| 252 | =head1 SYNOPSIS | ||||
| 253 | |||||
| 254 | use Class::Struct; | ||||
| 255 | # declare struct, based on array: | ||||
| 256 | struct( CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]); | ||||
| 257 | # declare struct, based on hash: | ||||
| 258 | struct( CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... }); | ||||
| 259 | |||||
| 260 | package CLASS_NAME; | ||||
| 261 | use Class::Struct; | ||||
| 262 | # declare struct, based on array, implicit class name: | ||||
| 263 | struct( ELEMENT_NAME => ELEMENT_TYPE, ... ); | ||||
| 264 | |||||
| 265 | # Declare struct at compile time | ||||
| 266 | use Class::Struct CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]; | ||||
| 267 | use Class::Struct CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... }; | ||||
| 268 | |||||
| 269 | # declare struct at compile time, based on array, implicit class name: | ||||
| 270 | package CLASS_NAME; | ||||
| 271 | use Class::Struct ELEMENT_NAME => ELEMENT_TYPE, ... ; | ||||
| 272 | |||||
| 273 | package Myobj; | ||||
| 274 | use Class::Struct; | ||||
| 275 | # declare struct with four types of elements: | ||||
| 276 | struct( s => '$', a => '@', h => '%', c => 'My_Other_Class' ); | ||||
| 277 | |||||
| 278 | $obj = new Myobj; # constructor | ||||
| 279 | |||||
| 280 | # scalar type accessor: | ||||
| 281 | $element_value = $obj->s; # element value | ||||
| 282 | $obj->s('new value'); # assign to element | ||||
| 283 | |||||
| 284 | # array type accessor: | ||||
| 285 | $ary_ref = $obj->a; # reference to whole array | ||||
| 286 | $ary_element_value = $obj->a(2); # array element value | ||||
| 287 | $obj->a(2, 'new value'); # assign to array element | ||||
| 288 | |||||
| 289 | # hash type accessor: | ||||
| 290 | $hash_ref = $obj->h; # reference to whole hash | ||||
| 291 | $hash_element_value = $obj->h('x'); # hash element value | ||||
| 292 | $obj->h('x', 'new value'); # assign to hash element | ||||
| 293 | |||||
| 294 | # class type accessor: | ||||
| 295 | $element_value = $obj->c; # object reference | ||||
| 296 | $obj->c->method(...); # call method of object | ||||
| 297 | $obj->c(new My_Other_Class); # assign a new object | ||||
| 298 | |||||
| 299 | =head1 DESCRIPTION | ||||
| 300 | |||||
| 301 | C<Class::Struct> exports a single function, C<struct>. | ||||
| 302 | Given a list of element names and types, and optionally | ||||
| 303 | a class name, C<struct> creates a Perl 5 class that implements | ||||
| 304 | a "struct-like" data structure. | ||||
| 305 | |||||
| 306 | The new class is given a constructor method, C<new>, for creating | ||||
| 307 | struct objects. | ||||
| 308 | |||||
| 309 | Each element in the struct data has an accessor method, which is | ||||
| 310 | used to assign to the element and to fetch its value. The | ||||
| 311 | default accessor can be overridden by declaring a C<sub> of the | ||||
| 312 | same name in the package. (See Example 2.) | ||||
| 313 | |||||
| 314 | Each element's type can be scalar, array, hash, or class. | ||||
| 315 | |||||
| 316 | =head2 The C<struct()> function | ||||
| 317 | |||||
| 318 | The C<struct> function has three forms of parameter-list. | ||||
| 319 | |||||
| 320 | struct( CLASS_NAME => [ ELEMENT_LIST ]); | ||||
| 321 | struct( CLASS_NAME => { ELEMENT_LIST }); | ||||
| 322 | struct( ELEMENT_LIST ); | ||||
| 323 | |||||
| 324 | The first and second forms explicitly identify the name of the | ||||
| 325 | class being created. The third form assumes the current package | ||||
| 326 | name as the class name. | ||||
| 327 | |||||
| 328 | An object of a class created by the first and third forms is | ||||
| 329 | based on an array, whereas an object of a class created by the | ||||
| 330 | second form is based on a hash. The array-based forms will be | ||||
| 331 | somewhat faster and smaller; the hash-based forms are more | ||||
| 332 | flexible. | ||||
| 333 | |||||
| 334 | The class created by C<struct> must not be a subclass of another | ||||
| 335 | class other than C<UNIVERSAL>. | ||||
| 336 | |||||
| 337 | It can, however, be used as a superclass for other classes. To facilitate | ||||
| 338 | this, the generated constructor method uses a two-argument blessing. | ||||
| 339 | Furthermore, if the class is hash-based, the key of each element is | ||||
| 340 | prefixed with the class name (see I<Perl Cookbook>, Recipe 13.12). | ||||
| 341 | |||||
| 342 | A function named C<new> must not be explicitly defined in a class | ||||
| 343 | created by C<struct>. | ||||
| 344 | |||||
| 345 | The I<ELEMENT_LIST> has the form | ||||
| 346 | |||||
| 347 | NAME => TYPE, ... | ||||
| 348 | |||||
| 349 | Each name-type pair declares one element of the struct. Each | ||||
| 350 | element name will be defined as an accessor method unless a | ||||
| 351 | method by that name is explicitly defined; in the latter case, a | ||||
| 352 | warning is issued if the warning flag (B<-w>) is set. | ||||
| 353 | |||||
| 354 | =head2 Class Creation at Compile Time | ||||
| 355 | |||||
| 356 | C<Class::Struct> can create your class at compile time. The main reason | ||||
| 357 | for doing this is obvious, so your class acts like every other class in | ||||
| 358 | Perl. Creating your class at compile time will make the order of events | ||||
| 359 | similar to using any other class ( or Perl module ). | ||||
| 360 | |||||
| 361 | There is no significant speed gain between compile time and run time | ||||
| 362 | class creation, there is just a new, more standard order of events. | ||||
| 363 | |||||
| 364 | =head2 Element Types and Accessor Methods | ||||
| 365 | |||||
| 366 | The four element types -- scalar, array, hash, and class -- are | ||||
| 367 | represented by strings -- C<'$'>, C<'@'>, C<'%'>, and a class name -- | ||||
| 368 | optionally preceded by a C<'*'>. | ||||
| 369 | |||||
| 370 | The accessor method provided by C<struct> for an element depends | ||||
| 371 | on the declared type of the element. | ||||
| 372 | |||||
| 373 | =over 4 | ||||
| 374 | |||||
| 375 | =item Scalar (C<'$'> or C<'*$'>) | ||||
| 376 | |||||
| 377 | The element is a scalar, and by default is initialized to C<undef> | ||||
| 378 | (but see L<Initializing with new>). | ||||
| 379 | |||||
| 380 | The accessor's argument, if any, is assigned to the element. | ||||
| 381 | |||||
| 382 | If the element type is C<'$'>, the value of the element (after | ||||
| 383 | assignment) is returned. If the element type is C<'*$'>, a reference | ||||
| 384 | to the element is returned. | ||||
| 385 | |||||
| 386 | =item Array (C<'@'> or C<'*@'>) | ||||
| 387 | |||||
| 388 | The element is an array, initialized by default to C<()>. | ||||
| 389 | |||||
| 390 | With no argument, the accessor returns a reference to the | ||||
| 391 | element's whole array (whether or not the element was | ||||
| 392 | specified as C<'@'> or C<'*@'>). | ||||
| 393 | |||||
| 394 | With one or two arguments, the first argument is an index | ||||
| 395 | specifying one element of the array; the second argument, if | ||||
| 396 | present, is assigned to the array element. If the element type | ||||
| 397 | is C<'@'>, the accessor returns the array element value. If the | ||||
| 398 | element type is C<'*@'>, a reference to the array element is | ||||
| 399 | returned. | ||||
| 400 | |||||
| 401 | As a special case, when the accessor is called with an array reference | ||||
| 402 | as the sole argument, this causes an assignment of the whole array element. | ||||
| 403 | The object reference is returned. | ||||
| 404 | |||||
| 405 | =item Hash (C<'%'> or C<'*%'>) | ||||
| 406 | |||||
| 407 | The element is a hash, initialized by default to C<()>. | ||||
| 408 | |||||
| 409 | With no argument, the accessor returns a reference to the | ||||
| 410 | element's whole hash (whether or not the element was | ||||
| 411 | specified as C<'%'> or C<'*%'>). | ||||
| 412 | |||||
| 413 | With one or two arguments, the first argument is a key specifying | ||||
| 414 | one element of the hash; the second argument, if present, is | ||||
| 415 | assigned to the hash element. If the element type is C<'%'>, the | ||||
| 416 | accessor returns the hash element value. If the element type is | ||||
| 417 | C<'*%'>, a reference to the hash element is returned. | ||||
| 418 | |||||
| 419 | As a special case, when the accessor is called with a hash reference | ||||
| 420 | as the sole argument, this causes an assignment of the whole hash element. | ||||
| 421 | The object reference is returned. | ||||
| 422 | |||||
| 423 | =item Class (C<'Class_Name'> or C<'*Class_Name'>) | ||||
| 424 | |||||
| 425 | The element's value must be a reference blessed to the named | ||||
| 426 | class or to one of its subclasses. The element is not initialized | ||||
| 427 | by default. | ||||
| 428 | |||||
| 429 | The accessor's argument, if any, is assigned to the element. The | ||||
| 430 | accessor will C<croak> if this is not an appropriate object | ||||
| 431 | reference. | ||||
| 432 | |||||
| 433 | If the element type does not start with a C<'*'>, the accessor | ||||
| 434 | returns the element value (after assignment). If the element type | ||||
| 435 | starts with a C<'*'>, a reference to the element itself is returned. | ||||
| 436 | |||||
| 437 | =back | ||||
| 438 | |||||
| 439 | =head2 Initializing with C<new> | ||||
| 440 | |||||
| 441 | C<struct> always creates a constructor called C<new>. That constructor | ||||
| 442 | may take a list of initializers for the various elements of the new | ||||
| 443 | struct. | ||||
| 444 | |||||
| 445 | Each initializer is a pair of values: I<element name>C< =E<gt> >I<value>. | ||||
| 446 | The initializer value for a scalar element is just a scalar value. The | ||||
| 447 | initializer for an array element is an array reference. The initializer | ||||
| 448 | for a hash is a hash reference. | ||||
| 449 | |||||
| 450 | The initializer for a class element is an object of the corresponding class, | ||||
| 451 | or of one of it's subclasses, or a reference to a hash containing named | ||||
| 452 | arguments to be passed to the element's constructor. | ||||
| 453 | |||||
| 454 | See Example 3 below for an example of initialization. | ||||
| 455 | |||||
| 456 | =head1 EXAMPLES | ||||
| 457 | |||||
| 458 | =over 4 | ||||
| 459 | |||||
| 460 | =item Example 1 | ||||
| 461 | |||||
| 462 | Giving a struct element a class type that is also a struct is how | ||||
| 463 | structs are nested. Here, C<Timeval> represents a time (seconds and | ||||
| 464 | microseconds), and C<Rusage> has two elements, each of which is of | ||||
| 465 | type C<Timeval>. | ||||
| 466 | |||||
| 467 | use Class::Struct; | ||||
| 468 | |||||
| 469 | struct( Rusage => { | ||||
| 470 | ru_utime => 'Timeval', # user time used | ||||
| 471 | ru_stime => 'Timeval', # system time used | ||||
| 472 | }); | ||||
| 473 | |||||
| 474 | struct( Timeval => [ | ||||
| 475 | tv_secs => '$', # seconds | ||||
| 476 | tv_usecs => '$', # microseconds | ||||
| 477 | ]); | ||||
| 478 | |||||
| 479 | # create an object: | ||||
| 480 | my $t = Rusage->new(ru_utime=>Timeval->new(), ru_stime=>Timeval->new()); | ||||
| 481 | |||||
| 482 | # $t->ru_utime and $t->ru_stime are objects of type Timeval. | ||||
| 483 | # set $t->ru_utime to 100.0 sec and $t->ru_stime to 5.0 sec. | ||||
| 484 | $t->ru_utime->tv_secs(100); | ||||
| 485 | $t->ru_utime->tv_usecs(0); | ||||
| 486 | $t->ru_stime->tv_secs(5); | ||||
| 487 | $t->ru_stime->tv_usecs(0); | ||||
| 488 | |||||
| 489 | =item Example 2 | ||||
| 490 | |||||
| 491 | An accessor function can be redefined in order to provide | ||||
| 492 | additional checking of values, etc. Here, we want the C<count> | ||||
| 493 | element always to be nonnegative, so we redefine the C<count> | ||||
| 494 | accessor accordingly. | ||||
| 495 | |||||
| 496 | package MyObj; | ||||
| 497 | use Class::Struct; | ||||
| 498 | |||||
| 499 | # declare the struct | ||||
| 500 | struct ( 'MyObj', { count => '$', stuff => '%' } ); | ||||
| 501 | |||||
| 502 | # override the default accessor method for 'count' | ||||
| 503 | sub count { | ||||
| 504 | my $self = shift; | ||||
| 505 | if ( @_ ) { | ||||
| 506 | die 'count must be nonnegative' if $_[0] < 0; | ||||
| 507 | $self->{'MyObj::count'} = shift; | ||||
| 508 | warn "Too many args to count" if @_; | ||||
| 509 | } | ||||
| 510 | return $self->{'MyObj::count'}; | ||||
| 511 | } | ||||
| 512 | |||||
| 513 | package main; | ||||
| 514 | $x = new MyObj; | ||||
| 515 | print "\$x->count(5) = ", $x->count(5), "\n"; | ||||
| 516 | # prints '$x->count(5) = 5' | ||||
| 517 | |||||
| 518 | print "\$x->count = ", $x->count, "\n"; | ||||
| 519 | # prints '$x->count = 5' | ||||
| 520 | |||||
| 521 | print "\$x->count(-5) = ", $x->count(-5), "\n"; | ||||
| 522 | # dies due to negative argument! | ||||
| 523 | |||||
| 524 | =item Example 3 | ||||
| 525 | |||||
| 526 | The constructor of a generated class can be passed a list | ||||
| 527 | of I<element>=>I<value> pairs, with which to initialize the struct. | ||||
| 528 | If no initializer is specified for a particular element, its default | ||||
| 529 | initialization is performed instead. Initializers for non-existent | ||||
| 530 | elements are silently ignored. | ||||
| 531 | |||||
| 532 | Note that the initializer for a nested class may be specified as | ||||
| 533 | an object of that class, or as a reference to a hash of initializers | ||||
| 534 | that are passed on to the nested struct's constructor. | ||||
| 535 | |||||
| 536 | use Class::Struct; | ||||
| 537 | |||||
| 538 | struct Breed => | ||||
| 539 | { | ||||
| 540 | name => '$', | ||||
| 541 | cross => '$', | ||||
| 542 | }; | ||||
| 543 | |||||
| 544 | struct Cat => | ||||
| 545 | [ | ||||
| 546 | name => '$', | ||||
| 547 | kittens => '@', | ||||
| 548 | markings => '%', | ||||
| 549 | breed => 'Breed', | ||||
| 550 | ]; | ||||
| 551 | |||||
| 552 | |||||
| 553 | my $cat = Cat->new( name => 'Socks', | ||||
| 554 | kittens => ['Monica', 'Kenneth'], | ||||
| 555 | markings => { socks=>1, blaze=>"white" }, | ||||
| 556 | breed => Breed->new(name=>'short-hair', cross=>1), | ||||
| 557 | or: breed => {name=>'short-hair', cross=>1}, | ||||
| 558 | ); | ||||
| 559 | |||||
| 560 | print "Once a cat called ", $cat->name, "\n"; | ||||
| 561 | print "(which was a ", $cat->breed->name, ")\n"; | ||||
| 562 | print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n"; | ||||
| 563 | |||||
| 564 | =back | ||||
| 565 | |||||
| 566 | =head1 Author and Modification History | ||||
| 567 | |||||
| 568 | Modified by Damian Conway, 2001-09-10, v0.62. | ||||
| 569 | |||||
| 570 | Modified implicit construction of nested objects. | ||||
| 571 | Now will also take an object ref instead of requiring a hash ref. | ||||
| 572 | Also default initializes nested object attributes to undef, rather | ||||
| 573 | than calling object constructor without args | ||||
| 574 | Original over-helpfulness was fraught with problems: | ||||
| 575 | * the class's constructor might not be called 'new' | ||||
| 576 | * the class might not have a hash-like-arguments constructor | ||||
| 577 | * the class might not have a no-argument constructor | ||||
| 578 | * "recursive" data structures didn't work well: | ||||
| 579 | package Person; | ||||
| 580 | struct { mother => 'Person', father => 'Person'}; | ||||
| 581 | |||||
| 582 | |||||
| 583 | Modified by Casey West, 2000-11-08, v0.59. | ||||
| 584 | |||||
| 585 | Added the ability for compile time class creation. | ||||
| 586 | |||||
| 587 | Modified by Damian Conway, 1999-03-05, v0.58. | ||||
| 588 | |||||
| 589 | Added handling of hash-like arg list to class ctor. | ||||
| 590 | |||||
| 591 | Changed to two-argument blessing in ctor to support | ||||
| 592 | derivation from created classes. | ||||
| 593 | |||||
| 594 | Added classname prefixes to keys in hash-based classes | ||||
| 595 | (refer to "Perl Cookbook", Recipe 13.12 for rationale). | ||||
| 596 | |||||
| 597 | Corrected behaviour of accessors for '*@' and '*%' struct | ||||
| 598 | elements. Package now implements documented behaviour when | ||||
| 599 | returning a reference to an entire hash or array element. | ||||
| 600 | Previously these were returned as a reference to a reference | ||||
| 601 | to the element. | ||||
| 602 | |||||
| 603 | Renamed to C<Class::Struct> and modified by Jim Miner, 1997-04-02. | ||||
| 604 | |||||
| 605 | members() function removed. | ||||
| 606 | Documentation corrected and extended. | ||||
| 607 | Use of struct() in a subclass prohibited. | ||||
| 608 | User definition of accessor allowed. | ||||
| 609 | Treatment of '*' in element types corrected. | ||||
| 610 | Treatment of classes as element types corrected. | ||||
| 611 | Class name to struct() made optional. | ||||
| 612 | Diagnostic checks added. | ||||
| 613 | |||||
| 614 | Originally C<Class::Template> by Dean Roehrich. | ||||
| 615 | |||||
| 616 | # Template.pm --- struct/member template builder | ||||
| 617 | # 12mar95 | ||||
| 618 | # Dean Roehrich | ||||
| 619 | # | ||||
| 620 | # changes/bugs fixed since 28nov94 version: | ||||
| 621 | # - podified | ||||
| 622 | # changes/bugs fixed since 21nov94 version: | ||||
| 623 | # - Fixed examples. | ||||
| 624 | # changes/bugs fixed since 02sep94 version: | ||||
| 625 | # - Moved to Class::Template. | ||||
| 626 | # changes/bugs fixed since 20feb94 version: | ||||
| 627 | # - Updated to be a more proper module. | ||||
| 628 | # - Added "use strict". | ||||
| 629 | # - Bug in build_methods, was using @var when @$var needed. | ||||
| 630 | # - Now using my() rather than local(). | ||||
| 631 | # | ||||
| 632 | # Uses perl5 classes to create nested data types. | ||||
| 633 | # This is offered as one implementation of Tom Christiansen's "structs.pl" | ||||
| 634 | # idea. | ||||
| 635 | |||||
| 636 | =cut | ||||
# spent 23µs within Class::Struct::CORE:match which was called 13 times, avg 2µs/call:
# 13 times (23µs+0s) by Class::Struct::struct at line 145 of Class/Struct.pm, avg 2µs/call |