++$cnt;
}
elsif( $base_type eq 'HASH' ){
$elem = "{'${class}::$name'}";
}
if( defined $arrays{$name} ){
$out .= " my \$i;\n";
$out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n";
$out .= " if (ref(\$i) eq 'ARRAY' && !\@_) { \$r->$elem = \$i; return \$r }\n";
$sel = "->[\$i]";
}
elsif( defined $hashes{$name} ){
$out .= " my \$i;\n";
$out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n";
$out .= " if (ref(\$i) eq 'HASH' && !\@_) { \$r->$elem = \$i; return \$r }\n";
$sel = "->{\$i}";
}
elsif( defined $classes{$name} ){
if ( $CHECK_CLASS_MEMBERSHIP ) {
$out .= " croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0],
'$classes{$name}');\n";
}
}
$out .= " croak 'Too many args to $name' if \@_ > 1;\n";
$out .= " \@_ ? ($pre\$r->$elem$sel = shift$pst) : $pre\$r->$elem$sel$pst;\n";
$out .= " }\n";
}
}
$out .= "}\n1;\n";
print $out if $print;
my $result = eval $out;
carp $@ if $@;
}
sub _usage_error {
confess "struct usage error";
}
sub _subclass_error {
croak 'struct class cannot be a subclass (@ISA not allowed)';
}
1; # for require
__END__
=head1 NAME
Class::Struct - declare struct-like datatypes as Perl classes
=head1 SYNOPSIS
use Class::Struct;
# declare struct, based on array:
struct( CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]);
# declare struct, based on hash:
struct( CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... });
package CLASS_NAME;
use Class::Struct;
# declare struct, based on array, implicit class name:
struct( ELEMENT_NAME => ELEMENT_TYPE, ... );
# Declare struct at compile time
use Class::Struct CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ];
use Class::Struct CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... };
# declare struct at compile time, based on array, implicit class name:
package CLASS_NAME;
use Class::Struct ELEMENT_NAME => ELEMENT_TYPE, ... ;
package Myobj;
use Class::Struct;
# declare struct with four types of elements:
struct( s => '$', a => '@', h => '%', c => 'My_Other_Class' );
$obj = new Myobj; # constructor
# scalar type accessor:
$element_value = $obj->s; # element value
$obj->s('new value'); # assign to element
# array type accessor:
$ary_ref = $obj->a; # reference to whole array
$ary_element_value = $obj->a(2); # array element value
$obj->a(2, 'new value'); # assign to array element
# hash type accessor:
$hash_ref = $obj->h; # reference to whole hash
$hash_element_value = $obj->h('x'); # hash element value
$obj->h('x', 'new value'); # assign to hash element
# class type accessor:
$element_value = $obj->c; # object reference
$obj->c->method(...); # call method of object
$obj->c(new My_Other_Class); # assign a new object
=head1 DESCRIPTION
=3= |