Re: Creating Common Constructor

[DeadPoet]

After looking into broquaint idea of using a Class Factory, which I really like, I have transformed the code into the "readmore" listing below. However, I am still in search of any suggestions on how to improve.

Your thoughts, comments, and suggestions are more than welcomed

DeadPoet

#----------------------------------------------------------
# Filename Zoo.pm
#----------------------------------------------------------
#                             ----------
#                             |   Zoo   |
#                             ----------
#                                  |
#                                  |  HASA Animal
#                                  v
#                             ----------
#                             | Animal  |
#                             ----------
#                                 ^^
#                                /  \
#                     ISA Animal/    \ISA Animal
#                              /      \
#                             /        \
#                   ----------          ----------
#                   | Camel  |          |  Lama   |
#                   ----------          ----------
#----------------------------------------------------------
package Zoo::Zoo;

use UUID;
use base qw( Zoo::Animal::Animal Zoo::Animal::Camel Zoo::Animal::Lama 
+);
use strict;

#----------------------------------------------------------
# Create the Class defaults.
#----------------------------------------------------------
{
    my $_class_defaults =
    {    _oid        => '???',
        _type        => 'zoo',
        _Camel_count    => 0,
        _Lama_count    => 0,
        _test1        => '????'
    };

    sub _class_defaults    { $_class_defaults }
    sub _class_default_keys    { map { s/^_//; $_ } keys %$_class_defa
+ults }
}

sub new {
    my ( $caller, %arg ) = @_;
    my $class = ref($caller);
    my $defaults = $class ? $caller : $caller->_class_defaults();
    $class ||= $caller;
    my $self = bless {}, $class;

    # Generate an Object ID
    my $sref_oid = Zoo::Zoo->_gen_oid();

    # Populate the new object with either passed parameters
    # or the defaults.
    foreach my $attrname ( $class->_class_default_keys ){
        if ( exists $arg{ $attrname } ){
            $self->{"_$attrname"} = $arg{$attrname};
        } else {
            $self->{"_$attrname"} = $defaults->{"_$attrname"};
        }
    }
    $self->{ _oid } = $$sref_oid;
    return $self;
}
sub factory {
    my($self, $class, $args) = @_;
    my $obj = "Zoo::Animal::$class"->new( $args );
    $self->{"_${class}_count"}++;
    return $obj;
}
sub _gen_oid {
    my ( $o_uuid, $o_id );
    UUID::generate($o_uuid);
    UUID::unparse( $o_uuid, $o_id );
    return undef if ( $o_id eq '' );    # catch if the unparse failed.
    return \$o_id;
}
sub _get_camel_count {
    my ( $self ) = @_;
    $self->{ _Camel_count };
}
sub _get_lama_count {
    my ( $self ) = @_;
    $self->{ _Lama_count };
}
sub print_obj {
    my ( $self ) = @_;
    foreach ( keys %{ $self } ) {
        print STDOUT "$_ -----> $self->{ $_ }\n";
    }
    print STDOUT "\n\n";
}
sub DESTROY {
    my ( $self ) = @_;
    printf ( "\n%s : $self cleaning up.\n", scalar ( localtime ) );
}

1;
__END__

#----------------------------------------------------------
# Filename Animal.pm
#----------------------------------------------------------

package Zoo::Animal::Animal;

use strict;

sub print_obj {
    my ( $self ) = @_;
    foreach ( keys %{ $self } ) {
        print STDOUT "$_ -----> $self->{ $_ }\n";
    }
    print STDOUT "\n\n";
}

1;
__END__

#----------------------------------------------------------
# Filename Camel.pm
#----------------------------------------------------------

package Zoo::Animal::Camel;
@Zoo::Animal::Camel::ISA  = qw( Zoo::Animal::Animal );
use strict;

#----------------------------------------------------------
# Create the Class defaults.
#----------------------------------------------------------
{
    my $_class_defaults =
    {    _oid    => '???',
        _type    => 'camel',
        _color    => 'grey',
        _legs    => 4
    };

    sub _class_defaults    { $_class_defaults }
    sub _class_default_keys    { map { s/^_//; $_ } keys %$_class_defa
+ults }
}

sub new {
    my ( $caller, %arg ) = @_;
    my $class = ref($caller);
    my $defaults = $class ? $caller : $caller->_class_defaults();
    $class ||= $caller;
    my $self = bless {}, $class;
    my $sref_oid = Zoo::Zoo->_gen_oid();

    foreach my $attrname ( $class->_class_default_keys ){
        if ( exists $arg{ $attrname } ){
            $self->{"_$attrname"} = $arg{$attrname};
        } else {
            $self->{"_$attrname"} = $defaults->{"_$attrname"};
        }
    }
    $self->{ _oid } = $$sref_oid;
    return $self;
}

sub DESTROY {
    print "Destroying the camel Object\n";
}

1;
__END__

#----------------------------------------------------------
# Filename Lama.pm
#----------------------------------------------------------
package Zoo::Animal::Lama;
@Zoo::Animal::Lama::ISA  = qw( Zoo::Animal::Animal );

use strict;

{
    my $_class_defaults =
    {    _oid    => '???',
        _type    => 'lama',
        _color    => 'white',
        _legs    => 4
    };

    sub _class_defaults    { $_class_defaults }
    sub _class_default_keys    { map { s/^_//; $_ } keys %$_class_defa
+ults }
}

sub new {
    my ( $caller, %arg ) = @_;
    my $class = ref($caller);
    my $defaults = $class ? $caller : $caller->_class_defaults();
    $class ||= $caller;
    my $self = bless {}, $class;
    my $sref_oid = Zoo::Zoo->_gen_oid();

    foreach my $attrname ( $class->_class_default_keys ){
        if ( exists $arg{ $attrname } ){
            $self->{"_$attrname"} = $arg{$attrname};
        } else {
            $self->{"_$attrname"} = $defaults->{"_$attrname"};
        }
    }
    $self->{ _oid } = $$sref_oid;
    return $self;
}

sub DESTROY {
    print "Destroying the lama Object\n";
}

1;
__END__

#----------------------------------------------------------
# Filename Zoo.pl
# Just a simple test script.
#----------------------------------------------------------
use Zoo::Zoo;
use strict;

my $o = Zoo::Zoo->new();

for ( my $i = 1; $i<= 5; $i++ ) {
    my $o_camel = $o->factory( 'Camel' );
    $o_camel->print_obj();
    my $o_lama = $o->factory( 'Lama' );
    $o_lama->print_obj();
}
print STDOUT $o->{ _type } . " has " . $o->{ _Camel_count } . " camels
+\n";
print STDOUT $o->{ _type } . " has " . $o->{ _Lama_count } . " lamas\n
+";