summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Class
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Class')
-rw-r--r--Master/tlpkg/tlperl/lib/Class/ISA.pm214
-rw-r--r--Master/tlpkg/tlperl/lib/Class/Struct.pm636
2 files changed, 0 insertions, 850 deletions
diff --git a/Master/tlpkg/tlperl/lib/Class/ISA.pm b/Master/tlpkg/tlperl/lib/Class/ISA.pm
deleted file mode 100644
index e1371912e2c..00000000000
--- a/Master/tlpkg/tlperl/lib/Class/ISA.pm
+++ /dev/null
@@ -1,214 +0,0 @@
-#!/usr/local/bin/perl
-# Time-stamp: "2004-12-29 20:01:02 AST" -*-Perl-*-
-
-package Class::ISA;
-require 5;
-use strict;
-use vars qw($Debug $VERSION);
-$VERSION = '0.33';
-$Debug = 0 unless defined $Debug;
-
-=head1 NAME
-
-Class::ISA -- report the search path for a class's ISA tree
-
-=head1 SYNOPSIS
-
- # Suppose you go: use Food::Fishstick, and that uses and
- # inherits from other things, which in turn use and inherit
- # from other things. And suppose, for sake of brevity of
- # example, that their ISA tree is the same as:
-
- @Food::Fishstick::ISA = qw(Food::Fish Life::Fungus Chemicals);
- @Food::Fish::ISA = qw(Food);
- @Food::ISA = qw(Matter);
- @Life::Fungus::ISA = qw(Life);
- @Chemicals::ISA = qw(Matter);
- @Life::ISA = qw(Matter);
- @Matter::ISA = qw();
-
- use Class::ISA;
- print "Food::Fishstick path is:\n ",
- join(", ", Class::ISA::super_path('Food::Fishstick')),
- "\n";
-
-That prints:
-
- Food::Fishstick path is:
- Food::Fish, Food, Matter, Life::Fungus, Life, Chemicals
-
-=head1 DESCRIPTION
-
-Suppose you have a class (like Food::Fish::Fishstick) that is derived,
-via its @ISA, from one or more superclasses (as Food::Fish::Fishstick
-is from Food::Fish, Life::Fungus, and Chemicals), and some of those
-superclasses may themselves each be derived, via its @ISA, from one or
-more superclasses (as above).
-
-When, then, you call a method in that class ($fishstick->calories),
-Perl first searches there for that method, but if it's not there, it
-goes searching in its superclasses, and so on, in a depth-first (or
-maybe "height-first" is the word) search. In the above example, it'd
-first look in Food::Fish, then Food, then Matter, then Life::Fungus,
-then Life, then Chemicals.
-
-This library, Class::ISA, provides functions that return that list --
-the list (in order) of names of classes Perl would search to find a
-method, with no duplicates.
-
-=head1 FUNCTIONS
-
-=over
-
-=item the function Class::ISA::super_path($CLASS)
-
-This returns the ordered list of names of classes that Perl would
-search thru in order to find a method, with no duplicates in the list.
-$CLASS is not included in the list. UNIVERSAL is not included -- if
-you need to consider it, add it to the end.
-
-
-=item the function Class::ISA::self_and_super_path($CLASS)
-
-Just like C<super_path>, except that $CLASS is included as the first
-element.
-
-=item the function Class::ISA::self_and_super_versions($CLASS)
-
-This returns a hash whose keys are $CLASS and its
-(super-)superclasses, and whose values are the contents of each
-class's $VERSION (or undef, for classes with no $VERSION).
-
-The code for self_and_super_versions is meant to serve as an example
-for precisely the kind of tasks I anticipate that self_and_super_path
-and super_path will be used for. You are strongly advised to read the
-source for self_and_super_versions, and the comments there.
-
-=back
-
-=head1 CAUTIONARY NOTES
-
-* Class::ISA doesn't export anything. You have to address the
-functions with a "Class::ISA::" on the front.
-
-* Contrary to its name, Class::ISA isn't a class; it's just a package.
-Strange, isn't it?
-
-* Say you have a loop in the ISA tree of the class you're calling one
-of the Class::ISA functions on: say that Food inherits from Matter,
-but Matter inherits from Food (for sake of argument). If Perl, while
-searching for a method, actually discovers this cyclicity, it will
-throw a fatal error. The functions in Class::ISA effectively ignore
-this cyclicity; the Class::ISA algorithm is "never go down the same
-path twice", and cyclicities are just a special case of that.
-
-* The Class::ISA functions just look at @ISAs. But theoretically, I
-suppose, AUTOLOADs could bypass Perl's ISA-based search mechanism and
-do whatever they please. That would be bad behavior, tho; and I try
-not to think about that.
-
-* If Perl can't find a method anywhere in the ISA tree, it then looks
-in the magical class UNIVERSAL. This is rarely relevant to the tasks
-that I expect Class::ISA functions to be put to, but if it matters to
-you, then instead of this:
-
- @supers = Class::Tree::super_path($class);
-
-do this:
-
- @supers = (Class::Tree::super_path($class), 'UNIVERSAL');
-
-And don't say no-one ever told ya!
-
-* When you call them, the Class::ISA functions look at @ISAs anew --
-that is, there is no memoization, and so if ISAs change during
-runtime, you get the current ISA tree's path, not anything memoized.
-However, changing ISAs at runtime is probably a sign that you're out
-of your mind!
-
-=head1 COPYRIGHT
-
-Copyright (c) 1999, 2000 Sean M. Burke. All rights reserved.
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
-###########################################################################
-
-sub self_and_super_versions {
- no strict 'refs';
- map {
- $_ => (defined(${"$_\::VERSION"}) ? ${"$_\::VERSION"} : undef)
- } self_and_super_path($_[0])
-}
-
-# Also consider magic like:
-# no strict 'refs';
-# my %class2SomeHashr =
-# map { defined(%{"$_\::SomeHash"}) ? ($_ => \%{"$_\::SomeHash"}) : () }
-# Class::ISA::self_and_super_path($class);
-# to get a hash of refs to all the defined (and non-empty) hashes in
-# $class and its superclasses.
-#
-# Or even consider this incantation for doing something like hash-data
-# inheritance:
-# no strict 'refs';
-# %union_hash =
-# map { defined(%{"$_\::SomeHash"}) ? %{"$_\::SomeHash"}) : () }
-# reverse(Class::ISA::self_and_super_path($class));
-# Consider that reverse() is necessary because with
-# %foo = ('a', 'wun', 'b', 'tiw', 'a', 'foist');
-# $foo{'a'} is 'foist', not 'wun'.
-
-###########################################################################
-sub super_path {
- my @ret = &self_and_super_path(@_);
- shift @ret if @ret;
- return @ret;
-}
-
-#--------------------------------------------------------------------------
-sub self_and_super_path {
- # Assumption: searching is depth-first.
- # Assumption: '' (empty string) can't be a class package name.
- # Note: 'UNIVERSAL' is not given any special treatment.
- return () unless @_;
-
- my @out = ();
-
- my @in_stack = ($_[0]);
- my %seen = ($_[0] => 1);
-
- my $current;
- while(@in_stack) {
- next unless defined($current = shift @in_stack) && length($current);
- print "At $current\n" if $Debug;
- push @out, $current;
- no strict 'refs';
- unshift @in_stack,
- map
- { my $c = $_; # copy, to avoid being destructive
- substr($c,0,2) = "main::" if substr($c,0,2) eq '::';
- # Canonize the :: -> main::, ::foo -> main::foo thing.
- # Should I ever canonize the Foo'Bar = Foo::Bar thing?
- $seen{$c}++ ? () : $c;
- }
- @{"$current\::ISA"}
- ;
- # I.e., if this class has any parents (at least, ones I've never seen
- # before), push them, in order, onto the stack of classes I need to
- # explore.
- }
-
- return @out;
-}
-#--------------------------------------------------------------------------
-1;
-
-__END__
diff --git a/Master/tlpkg/tlperl/lib/Class/Struct.pm b/Master/tlpkg/tlperl/lib/Class/Struct.pm
deleted file mode 100644
index 7a9af54faf8..00000000000
--- a/Master/tlpkg/tlperl/lib/Class/Struct.pm
+++ /dev/null
@@ -1,636 +0,0 @@
-package Class::Struct;
-
-## See POD after __END__
-
-use 5.006_001;
-
-use strict;
-use warnings::register;
-our(@ISA, @EXPORT, $VERSION);
-
-use Carp;
-
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(struct);
-
-$VERSION = '0.63';
-
-## 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 import {
- my $self = shift;
-
- if ( @_ == 0 ) {
- $self->export_to_level( 1, $self, @EXPORT );
- } elsif ( @_ == 1 ) {
- # This is admittedly a little bit silly:
- # do we ever export anything else than 'struct'...?
- $self->export_to_level( 1, $self, @_ );
- } else {
- goto &struct;
- }
-}
-
-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";
- $out .= " \$class = __PACKAGE__ unless \@_;\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+)*$/ ){
- $out .= " if (defined(\$init{'$name'})) {\n";
- $out .= " if (ref \$init{'$name'} eq 'HASH')\n";
- $out .= " { \$r->$elem = $type->new(\%{\$init{'$name'}}) } $cmt\n";
- $out .= " elsif (UNIVERSAL::isa(\$init{'$name'}, '$type'))\n";
- $out .= " { \$r->$elem = \$init{'$name'} } $cmt\n";
- $out .= " else { croak 'Initializer for $name must be hash or $type reference' }\n";
- $out .= " }\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"} } ) {
- warnings::warnif("function '$name' already defined, overrides struct accessor method");
- }
- 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";
- $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
-
-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 Class Creation at Compile Time
-
-C<Class::Struct> can create your class at compile time. The main reason
-for doing this is obvious, so your class acts like every other class in
-Perl. Creating your class at compile time will make the order of events
-similar to using any other class ( or Perl module ).
-
-There is no significant speed gain between compile time and run time
-class creation, there is just a new, more standard order of events.
-
-=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 4
-
-=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.
-
-As a special case, when the accessor is called with an array reference
-as the sole argument, this causes an assignment of the whole array element.
-The object reference 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.
-
-As a special case, when the accessor is called with a hash reference
-as the sole argument, this causes an assignment of the whole hash element.
-The object reference 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 not initialized
-by default.
-
-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 an object of the corresponding class,
-or of one of it's subclasses, or a reference to a hash containing named
-arguments to be passed to the element's constructor.
-
-See Example 3 below for an example of initialization.
-
-=head1 EXAMPLES
-
-=over 4
-
-=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', # user time used
- ru_stime => 'Timeval', # system time used
- });
-
- struct( Timeval => [
- tv_secs => '$', # seconds
- tv_usecs => '$', # microseconds
- ]);
-
- # create an object:
- my $t = Rusage->new(ru_utime=>Timeval->new(), ru_stime=>Timeval->new());
-
- # $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->{'MyObj::count'} = shift;
- warn "Too many args to count" if @_;
- }
- return $self->{'MyObj::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 class may be specified as
-an object of that class, or as a reference to a hash of initializers
-that are 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 => Breed->new(name=>'short-hair', cross=>1),
- or: 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";
-
-=back
-
-=head1 Author and Modification History
-
-Modified by Damian Conway, 2001-09-10, v0.62.
-
- Modified implicit construction of nested objects.
- Now will also take an object ref instead of requiring a hash ref.
- Also default initializes nested object attributes to undef, rather
- than calling object constructor without args
- Original over-helpfulness was fraught with problems:
- * the class's constructor might not be called 'new'
- * the class might not have a hash-like-arguments constructor
- * the class might not have a no-argument constructor
- * "recursive" data structures didn't work well:
- package Person;
- struct { mother => 'Person', father => 'Person'};
-
-
-Modified by Casey West, 2000-11-08, v0.59.
-
- Added the ability for compile time class creation.
-
-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