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
36 struct(name => { key1 => type1, key2 => type2 });
40 members Myobj { key1 => type1, key2 => type2 };
44 This module uses perl5 classes to create nested data types.
79 package OBJ2; @ISA = (OBJ);
82 my $r = InitMembers( &OBJ::InitMembers() );
88 Use '%' if the member should point to an anonymous hash. Use '@' if the
89 member should point to an anonymous array.
91 When using % and @ the method requires one argument for the key or index
92 into the hash or array.
94 Prefix the %, @, or $ with '*' to indicate you want to retrieve pointers to
95 the values rather than the values themselves.
100 $Class::Template::print = 0;
101 sub printem { $Class::Template::print++ }
106 my( $struct, $ref ) = @_;
113 $out = "{\n package $struct;\n sub new {\n";
114 parse_fields( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes, 0 );
115 $out .= " bless \$r;\n }\n";
116 build_methods( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes );
119 ( $Class::Template::print ) ? print( $out ) : eval $out;
123 my( $pkg, $ref ) = @_;
130 $out = "{\n package $pkg;\n sub InitMembers {\n";
131 parse_fields( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes, 1 );
132 $out .= " bless \$r;\n }\n";
133 build_methods( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes );
136 ( $Class::Template::print ) ? print( $out ) : eval $out;
141 my( $ref, $out, $methods, $refs, $arrays, $hashes, $member ) = @_;
149 if( $type eq 'HASH' ){
151 $$out .= " my(\$r) = \@_ ? shift : {};\n";
154 $$out .= " my(\$r) = {};\n";
159 if( $val =~ /^\*(.)/ ){
164 $$out .= " \$r->{'$_'} = [];\n";
167 elsif( $val eq '%' ){
168 $$out .= " \$r->{'$_'} = {};\n";
171 elsif( $val ne '$' ){
172 $$out .= " \$r->{'$_'} = \&${val}::new();\n";
175 $$out .= " \$r->{'$_'} = undef;\n";
177 push( @$methods, $_ );
180 elsif( $type eq 'ARRAY' ){
182 $$out .= " my(\$r) = \@_ ? shift : [];\n";
185 $$out .= " my(\$r) = [];\n";
187 while( $idx < @$ref ){
189 push( @$methods, $n );
190 $val = $ref->[$idx+1];
192 if( $val =~ /^\*(.)/ ){
197 $$out .= " \$r->[$cnt] = []; $cmt\n";
200 elsif( $val eq '%' ){
201 $$out .= " \$r->[$cnt] = {}; $cmt\n";
204 elsif( $val ne '$' ){
205 $$out .= " \$r->[$cnt] = \&${val}::new();\n";
208 $$out .= " \$r->[$cnt] = undef; $cmt\n";
218 my( $ref, $out, $methods, $refs, $arrays, $hashes ) = @_;
222 my( $pre, $pst, $cmt, $idx );
225 $pre = $pst = $cmt = $idx = '';
226 if( defined $refs->{$_} ){
229 $cmt = " # returns ref";
231 $$out .= " sub $_ {$cmt\n my \$r = shift;\n";
232 if( $type eq 'ARRAY' ){
236 elsif( $type eq 'HASH' ){
239 if( defined $arrays->{$_} ){
240 $$out .= " my \$i;\n";
241 $$out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n";
244 elsif( defined $hashes->{$_} ){
245 $$out .= " my \$i;\n";
246 $$out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n";
249 $$out .= " \@_ ? (\$r->$elem$idx = shift) : $pre\$r->$elem$idx$pst;\n";