[p5sagit/p5-mst-13.2.git] / lib / Class / Struct.pm

package Class::Struct;

## See POD after __END__

require 5.002;

use strict;
use vars qw(@ISA @EXPORT $VERSION);

use Carp;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(struct);

$VERSION = '0.58';

## Tested on 5.002 and 5.003 without class membership tests:
my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95);

my $print = 0;
sub printem {
    if (@_) { $print = shift }
    else    { $print++ }
}

{
    package Class::Struct::Tie_ISA;

    sub TIEARRAY {
        my $class = shift;
        return bless [], $class;
    }

    sub STORE {
        my ($self, $index, $value) = @_;
        Class::Struct::_subclass_error();
    }

    sub FETCH {
        my ($self, $index) = @_;
        $self->[$index];
    }

    sub FETCHSIZE {
        my $self = shift;
        return scalar(@$self);
    }

    sub DESTROY { }
}

sub struct {

    # Determine parameter list structure, one of:
    #   struct( class => [ element-list ])
    #   struct( class => { element-list })
    #   struct( element-list )
    # Latter form assumes current package name as struct name.

    my ($class, @decls);
    my $base_type = ref $_[1];
    if ( $base_type eq 'HASH' ) {
        $class = shift;
        @decls = %{shift()};
        _usage_error() if @_;
    }
    elsif ( $base_type eq 'ARRAY' ) {
        $class = shift;
        @decls = @{shift()};
        _usage_error() if @_;
    }
    else {
        $base_type = 'ARRAY';
        $class = (caller())[0];
        @decls = @_;
    }
    _usage_error() if @decls % 2 == 1;

    # Ensure we are not, and will not be, a subclass.

    my $isa = do {
        no strict 'refs';
        \@{$class . '::ISA'};
    };
    _subclass_error() if @$isa;
    tie @$isa, 'Class::Struct::Tie_ISA';

    # Create constructor.

    croak "function 'new' already defined in package $class"
        if do { no strict 'refs'; defined &{$class . "::new"} };

    my @methods = ();
    my %refs = ();
    my %arrays = ();
    my %hashes = ();
    my %classes = ();
    my $got_class = 0;
    my $out = '';

    $out = "{\n  package $class;\n  use Carp;\n  sub new {\n";
    $out .= "    my (\$class, \%init) = \@_;\n";

    my $cnt = 0;
    my $idx = 0;
    my( $cmt, $name, $type, $elem );

    if( $base_type eq 'HASH' ){
        $out .= "    my(\$r) = {};\n";
        $cmt = '';
    }
    elsif( $base_type eq 'ARRAY' ){
        $out .= "    my(\$r) = [];\n";
    }
    while( $idx < @decls ){
        $name = $decls[$idx];
        $type = $decls[$idx+1];
        push( @methods, $name );
        if( $base_type eq 'HASH' ){
            $elem = "{'${class}::$name'}";
        }
        elsif( $base_type eq 'ARRAY' ){
            $elem = "[$cnt]";
            ++$cnt;
            $cmt = " # $name";
        }
        if( $type =~ /^\*(.)/ ){
            $refs{$name}++;
            $type = $1;
        }
        my $init = "defined(\$init{'$name'}) ? \$init{'$name'} :";
        if( $type eq '@' ){
            $out .= "    croak 'Initializer for $name must be array reference'\n"; 
            $out .= "        if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'ARRAY';\n";
            $out .= "    \$r->$elem = $init [];$cmt\n"; 
            $arrays{$name}++;
        }
        elsif( $type eq '%' ){
            $out .= "    croak 'Initializer for $name must be hash reference'\n";
            $out .= "        if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'HASH';\n";
            $out .= "    \$r->$elem = $init {};$cmt\n";
            $hashes{$name}++;
        }
        elsif ( $type eq '$') {
            $out .= "    \$r->$elem = $init undef;$cmt\n";
        }
        elsif( $type =~ /^\w+(?:::\w+)*$/ ){
            $init = "defined(\$init{'$name'}) ? \%{\$init{'$name'}} : ()";
            $out .= "    croak 'Initializer for $name must be hash reference'\n";
            $out .= "        if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'HASH';\n";
            $out .= "    \$r->$elem = '${type}'->new($init);$cmt\n";
            $classes{$name} = $type;
            $got_class = 1;
        }
        else{
            croak "'$type' is not a valid struct element type";
        }
        $idx += 2;
    }
    $out .= "    bless \$r, \$class;\n  }\n";

    # Create accessor methods.

    my( $pre, $pst, $sel );
    $cnt = 0;
    foreach $name (@methods){
        if ( do { no strict 'refs'; defined &{$class . "::$name"} } ) {
            carp "function '$name' already defined, overrides struct accessor method"
                if $^W;
        }
        else {
            $pre = $pst = $cmt = $sel = '';
            if( defined $refs{$name} ){
                $pre = "\\(";
                $pst = ")";
                $cmt = " # returns ref";
            }
            $out .= "  sub $name {$cmt\n    my \$r = shift;\n";
            if( $base_type eq 'ARRAY' ){
                $elem = "[$cnt]";
                ++$cnt;
            }
            elsif( $base_type eq 'HASH' ){
                $elem = "{'${class}::$name'}";
            }
            if( defined $arrays{$name} ){
                $out .= "    my \$i;\n";
                $out .= "    \@_ ? (\$i = shift) : return \$r->$elem;\n"; 
                $sel = "->[\$i]";
            }
            elsif( defined $hashes{$name} ){
                $out .= "    my \$i;\n";
                $out .= "    \@_ ? (\$i = shift) : return \$r->$elem;\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, ... );


    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

C<Class::Struct> exports a single function, C<struct>.
Given a list of element names and types, and optionally
a class name, C<struct> creates a Perl 5 class that implements
a "struct-like" data structure.

The new class is given a constructor method, C<new>, for creating
struct objects.

Each element in the struct data has an accessor method, which is
used to assign to the element and to fetch its value.  The
default accessor can be overridden by declaring a C<sub> of the
same name in the package.  (See Example 2.)

Each element's type can be scalar, array, hash, or class.


=head2 The C<struct()> function

The C<struct> function has three forms of parameter-list.

    struct( CLASS_NAME => [ ELEMENT_LIST ]);
    struct( CLASS_NAME => { ELEMENT_LIST });
    struct( ELEMENT_LIST );

The first and second forms explicitly identify the name of the
class being created.  The third form assumes the current package
name as the class name.

An object of a class created by the first and third forms is
based on an array, whereas an object of a class created by the
second form is based on a hash. The array-based forms will be
somewhat faster and smaller; the hash-based forms are more
flexible.

The class created by C<struct> must not be a subclass of another
class other than C<UNIVERSAL>.

It can, however, be used as a superclass for other classes. To facilitate
this, the generated constructor method uses a two-argument blessing.
Furthermore, if the class is hash-based, the key of each element is
prefixed with the class name (see I<Perl Cookbook>, Recipe 13.12).

A function named C<new> must not be explicitly defined in a class
created by C<struct>.

The I<ELEMENT_LIST> has the form

    NAME => TYPE, ...

Each name-type pair declares one element of the struct. Each
element name will be defined as an accessor method unless a
method by that name is explicitly defined; in the latter case, a
warning is issued if the warning flag (B<-w>) is set.


=head2 Element Types and Accessor Methods

The four element types -- scalar, array, hash, and class -- are
represented by strings -- C<'$'>, C<'@'>, C<'%'>, and a class name --
optionally preceded by a C<'*'>.

The accessor method provided by C<struct> for an element depends
on the declared type of the element.

=over

=item Scalar (C<'$'> or C<'*$'>)

The element is a scalar, and by default is initialized to C<undef>
(but see L<Initializing with new>).

The accessor's argument, if any, is assigned to the element.

If the element type is C<'$'>, the value of the element (after
assignment) is returned. If the element type is C<'*$'>, a reference
to the element is returned.

=item Array (C<'@'> or C<'*@'>)

The element is an array, initialized by default to C<()>.

With no argument, the accessor returns a reference to the
element's whole array (whether or not the element was
specified as C<'@'> or C<'*@').

With one or two arguments, the first argument is an index
specifying one element of the array; the second argument, if
present, is assigned to the array element.  If the element type
is C<'@'>, the accessor returns the array element value.  If the
element type is C<'*@'>, a reference to the array element is
returned.

=item Hash (C<'%'> or C<'*%'>)

The element is a hash, initialized by default to C<()>.

With no argument, the accessor returns a reference to the
element's whole hash (whether or not the element was
specified as C<'%'> or C<'*%').

With one or two arguments, the first argument is a key specifying
one element of the hash; the second argument, if present, is
assigned to the hash element.  If the element type is C<'%'>, the
accessor returns the hash element value.  If the element type is
C<'*%'>, a reference to the hash element is returned.

=item Class (C<'Class_Name'> or C<'*Class_Name'>)

The element's value must be a reference blessed to the named
class or to one of its subclasses. The element is initialized to
the result of calling the C<new> constructor of the named class.

The accessor's argument, if any, is assigned to the element. The
accessor will C<croak> if this is not an appropriate object
reference.

If the element type does not start with a C<'*'>, the accessor
returns the element value (after assignment). If the element type
starts with a C<'*'>, a reference to the element itself is returned.

=back

=head2 Initializing with C<new>

C<struct> always creates a constructor called C<new>. That constructor
may take a list of initializers for the various elements of the new
struct. 

Each initializer is a pair of values: I<element name>C< =E<gt> >I<value>.
The initializer value for a scalar element is just a scalar value. The 
initializer for an array element is an array reference. The initializer
for a hash is a hash reference.

The initializer for a class element is also a hash reference, and the
contents of that hash are passed to the element's own constructor.

See Example 3 below for an example of initialization.


=head1 EXAMPLES

=over

=item Example 1

Giving a struct element a class type that is also a struct is how
structs are nested.  Here, C<timeval> represents a time (seconds and
microseconds), and C<rusage> has two elements, each of which is of
type C<timeval>.

    use Class::Struct;

    struct( rusage => {
        ru_utime => timeval,  # seconds
        ru_stime => timeval,  # microseconds
    });

    struct( timeval => [
        tv_secs  => '$',
        tv_usecs => '$',
    ]);

        # create an object:
    my $t = new rusage;

        # $t->ru_utime and $t->ru_stime are objects of type timeval.
        # set $t->ru_utime to 100.0 sec and $t->ru_stime to 5.0 sec.
    $t->ru_utime->tv_secs(100);
    $t->ru_utime->tv_usecs(0);
    $t->ru_stime->tv_secs(5);
    $t->ru_stime->tv_usecs(0);


=item Example 2

An accessor function can be redefined in order to provide
additional checking of values, etc.  Here, we want the C<count>
element always to be nonnegative, so we redefine the C<count>
accessor accordingly.

    package MyObj;
    use Class::Struct;

    # declare the struct
    struct ( 'MyObj', { count => '$', stuff => '%' } );

    # override the default accessor method for 'count'
    sub count {
        my $self = shift;
        if ( @_ ) {
            die 'count must be nonnegative' if $_[0] < 0;
            $self->{'count'} = shift;
            warn "Too many args to count" if @_;
        }
        return $self->{'count'};
    }

    package main;
    $x = new MyObj;
    print "\$x->count(5) = ", $x->count(5), "\n";
                            # prints '$x->count(5) = 5'

    print "\$x->count = ", $x->count, "\n";
                            # prints '$x->count = 5'

    print "\$x->count(-5) = ", $x->count(-5), "\n";
                            # dies due to negative argument!

=item Example 3

The constructor of a generated class can be passed a list
of I<element>=>I<value> pairs, with which to initialize the struct.
If no initializer is specified for a particular element, its default
initialization is performed instead. Initializers for non-existent
elements are silently ignored.

Note that the initializer for a nested struct is specified
as an anonymous hash of initializers, which is passed on to the nested
struct's constructor.


    use Class::Struct;

    struct Breed =>
    {
        name  => '$',
        cross => '$',
    };

    struct Cat =>
    [
        name     => '$',
        kittens  => '@',
        markings => '%',
        breed    => 'Breed',
    ];


    my $cat = Cat->new( name     => 'Socks',
                        kittens  => ['Monica', 'Kenneth'],
                        markings => { socks=>1, blaze=>"white" },
                        breed    => { name=>'short-hair', cross=>1 },
                      );

    print "Once a cat called ", $cat->name, "\n";
    print "(which was a ", $cat->breed->name, ")\n";
    print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n";


=head1 Author and Modification History


Modified by Damian Conway, 1999-03-05, v0.58.

    Added handling of hash-like arg list to class ctor.

    Changed to two-argument blessing in ctor to support
    derivation from created classes.

    Added classname prefixes to keys in hash-based classes
    (refer to "Perl Cookbook", Recipe 13.12 for rationale).

    Corrected behaviour of accessors for '*@' and '*%' struct
    elements.  Package now implements documented behaviour when
    returning a reference to an entire hash or array element.
    Previously these were returned as a reference to a reference
    to the element.


Renamed to C<Class::Struct> and modified by Jim Miner, 1997-04-02.

    members() function removed.
    Documentation corrected and extended.
    Use of struct() in a subclass prohibited.
    User definition of accessor allowed.
    Treatment of '*' in element types corrected.
    Treatment of classes as element types corrected.
    Class name to struct() made optional.
    Diagnostic checks added.


Originally C<Class::Template> by Dean Roehrich.

    # Template.pm   --- struct/member template builder
    #   12mar95
    #   Dean Roehrich
    #
    # changes/bugs fixed since 28nov94 version:
    #  - podified
    # changes/bugs fixed since 21nov94 version:
    #  - Fixed examples.
    # changes/bugs fixed since 02sep94 version:
    #  - Moved to Class::Template.
    # changes/bugs fixed since 20feb94 version:
    #  - Updated to be a more proper module.
    #  - Added "use strict".
    #  - Bug in build_methods, was using @var when @$var needed.
    #  - Now using my() rather than local().
    #
    # Uses perl5 classes to create nested data types.
    # This is offered as one implementation of Tom Christiansen's "structs.pl"
    # idea.

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