1 package Class::Template;
6 @EXPORT = qw(members struct);
9 # Template.pm --- struct/member template builder
13 # changes/bugs fixed since 28nov94 version:
15 # changes/bugs fixed since 21nov94 version:
17 # changes/bugs fixed since 02sep94 version:
18 # - Moved to Class::Template.
19 # changes/bugs fixed since 20feb94 version:
20 # - Updated to be a more proper module.
21 # - Added "use strict".
22 # - Bug in build_methods, was using @var when @$var needed.
23 # - Now using my() rather than local().
25 # Uses perl5 classes to create nested data types.
26 # This is offered as one implementation of Tom Christiansen's "structs.pl"
31 Class::Template - struct/member template builder
66 package OBJ2; @ISA = (OBJ);
69 my $r = InitMembers( &OBJ::InitMembers() );
75 Use '%' if the member should point to an anonymous hash. Use '@' if the
76 member should point to an anonymous array.
78 When using % and @ the method requires one argument for the key or index
79 into the hash or array.
81 Prefix the %, @, or $ with '*' to indicate you want to retrieve pointers to
82 the values rather than the values themselves.
87 $Class::Template::print = 0;
88 sub printem { $Class::Template::print++ }
93 my( $struct, $ref ) = @_;
100 $out = "{\n package $struct;\n sub new {\n";
101 parse_fields( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes, 0 );
102 $out .= " bless \$r;\n }\n";
103 build_methods( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes );
106 ( $Class::Template::print ) ? print( $out ) : eval $out;
110 my( $pkg, $ref ) = @_;
117 $out = "{\n package $pkg;\n sub InitMembers {\n";
118 parse_fields( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes, 1 );
119 $out .= " bless \$r;\n }\n";
120 build_methods( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes );
123 ( $Class::Template::print ) ? print( $out ) : eval $out;
128 my( $ref, $out, $methods, $refs, $arrays, $hashes, $member ) = @_;
136 if( $type eq 'HASH' ){
138 $$out .= " my(\$r) = \@_ ? shift : {};\n";
141 $$out .= " my(\$r) = {};\n";
146 if( $val =~ /^\*(.)/ ){
151 $$out .= " \$r->{'$_'} = [];\n";
154 elsif( $val eq '%' ){
155 $$out .= " \$r->{'$_'} = {};\n";
158 elsif( $val ne '$' ){
159 $$out .= " \$r->{'$_'} = \&${val}::new();\n";
162 $$out .= " \$r->{'$_'} = undef;\n";
164 push( @$methods, $_ );
167 elsif( $type eq 'ARRAY' ){
169 $$out .= " my(\$r) = \@_ ? shift : [];\n";
172 $$out .= " my(\$r) = [];\n";
174 while( $idx < @$ref ){
176 push( @$methods, $n );
177 $val = $ref->[$idx+1];
179 if( $val =~ /^\*(.)/ ){
184 $$out .= " \$r->[$cnt] = []; $cmt\n";
187 elsif( $val eq '%' ){
188 $$out .= " \$r->[$cnt] = {}; $cmt\n";
191 elsif( $val ne '$' ){
192 $$out .= " \$r->[$cnt] = \&${val}::new();\n";
195 $$out .= " \$r->[$cnt] = undef; $cmt\n";
205 my( $ref, $out, $methods, $refs, $arrays, $hashes ) = @_;
209 my( $pre, $pst, $cmt, $idx );
212 $pre = $pst = $cmt = $idx = '';
213 if( defined $refs->{$_} ){
216 $cmt = " # returns ref";
218 $$out .= " sub $_ {$cmt\n my \$r = shift;\n";
219 if( $type eq 'ARRAY' ){
223 elsif( $type eq 'HASH' ){
226 if( defined $arrays->{$_} ){
227 $$out .= " my \$i;\n";
228 $$out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n";
231 elsif( defined $hashes->{$_} ){
232 $$out .= " my \$i;\n";
233 $$out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n";
236 $$out .= " \@_ ? (\$r->$elem$idx = shift) : $pre\$r->$elem$idx$pst;\n";