Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Creating Common Constructor

by DeadPoet (Scribe)
on Jul 10, 2003 at 14:56 UTC ( #272998=perlquestion: print w/ replies, xml ) Need Help??
DeadPoet has asked for the wisdom of the Perl Monks concerning the following question:

I turn to the wisdom of the monks to help solve this issue. Ok, here is the problem:

In my example, the ZOO object MUST keep track of all the animals created. I would like ZOO to have a common constructor to create the Animals. In a real world program, the two Animals would have different attributes--not just the four that are defined. How do I setup and create such a structure? Please provide an example if possible.

Thanks In Advance For Your Help,

DeadPoet

#---------------------------------------------------------- # ------------- # | Zoo | # ------------- # | # | HASA Animal # v # ------------- # | Animal | # ------------- # ^^ # / \ # ISA Animal/ \ ISA Animal # / \ # / \ # ------------- ------------- # | Camel | | Lama | # ------------- ------------- #----------------------------------------------------------

The See Readmore for Code:

#--------------------------------------------------------- # Filename: Zoo.pm #--------------------------------------------------------- package Zoo::Zoo; use UUID; use lib '.'; use base qw( Zoo::Animal Zoo::Camel Zoo::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(); $self->{ _oid } = $$sref_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"}; } } return $self; } 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 _increment_camel { my ( $self ) = @_; $self->{ _camel_count } = $self->{ _camel_count } + 1; } sub _increment_lama { my ( $self ) = @_; $self->{ _lama_count } = $self->{ _lama_count } + 1; } sub add_camel { my ( $self ) = @_; my $o_camel = Zoo::Camel->new( ); $self->_increment_camel() if ( ref( $o_camel ) eq 'Zoo::Camel' ); return $o_camel; } sub add_lama { my ( $self ) = @_; my $o_lama = Zoo::Lama->new( ); $self->_increment_lama() if ( ref( $o_lama ) eq 'Zoo::Lama' ); return $o_lama; } 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: Lama.pm #--------------------------------------------------------- package Zoo::Lama; @ISA = qw( Zoo::Animal ); use strict; sub new { my ( $class ) = @_; my $sref_oid = Zoo::Zoo->_gen_oid(); my $self = { _oid => $$sref_oid, _type => 'lama', _color => 'white', _legs => 4 }; bless $self, $class; return $self; } sub DESTROY { print "Destroying the lama Object\n"; } 1; __END__ #--------------------------------------------------------- # Filename: Camel.pm #--------------------------------------------------------- package Zoo::Camel; @ISA = qw( Zoo::Animal ); use strict; sub new { my ( $class ) = @_; my $sref_oid = Zoo::Zoo->_gen_oid(); my $self = { _oid => $$sref_oid, _type => 'camel', _color => 'grey', _legs => 4 }; bless $self, $class; return $self; } sub DESTROY { print "Destroying the camel Object\n"; } 1; __END__ #--------------------------------------------------------- # Filename: Animal.pm (Reserved Space for common Animal # Methods). #--------------------------------------------------------- package Zoo::Animal; use strict; 1; __END__ #--------------------------------------------------------- # Filename: zoo.pl #--------------------------------------------------------- use Zoo::Zoo; my $o = Zoo::Zoo->new(); for ( my $i = 1; $i<= 5; $i++ ) { my $o_camel = $o->add_camel(); my $o_camel = $o->add_lama(); } print STDOUT $o->{ _type } . " has " . $o->{ _camel_count } . " camels +\n"; print STDOUT $o->{ _type } . " has " . $o->{ _lama_count } . " lamas\n +";

Comment on Creating Common Constructor
Select or Download Code
Re: Creating Common Constructor
by broquaint (Abbot) on Jul 10, 2003 at 15:03 UTC
    You could use a 'factory method' to keep track of the objects you create e.g
    sub Zoo::factory { my($self, $class, $args) = @_; my $obj = "Zoo::Animal::$class"->new( $args ); $self->{"_${class}_count"}++; return $obj; } my $zoo = Zoo->new; my $camel = $zoo->factory("Camel");
    That code isn't complete or tested but it should give you some idea of how to go about implementing a factory method.
    HTH

    _________
    broquaint

      I like this, but I would implement this with a small difference:

      sub Zoo::factory {
        my ($self, $class, @args)=@_;
      
        my $obj="Zoo::Animal::$class"->new(@args);
        $self->{count}->{$class}++;
      
        return $obj;
      }
      
      my $zoo=Zoo->new();
      my $camel=$zoo->factory("Camel");
      
      

      I would implement this difference so I could use $zoo->{zbr} for something else, and would be easier to find the counts to every specie in the $Zoo, 'cause every key in the %{$zoo->{count}} would be a diferent specie.

      The other way I think I could implement was without a factory method, but with a adquire method, with some changes:

      #Zoo.pm file
      sub new {
        ...
        $self->{animals}=[];
        ...
      }
      
      sub adquire {
        my $self=shift;
        push @{$self->{animals}}, @_;
      }
      
      sub count {
        my $self=shift;
        my %count=();
        for my $anim (@{$self->{animals}}) {
          $count{$anim->specie()}++;
        }
        return %count;
      }
      
      #Zoo/Animal.pm
      ...
      sub specie {
        return "unknow specie";
      }
      ...
      
      #Zoo/Animal/Camel.pm
      ...
      sub specie {
        return "cameloid Dromedarius"
      }
      
      # Main
      my $zoo=Zoo->new();
      $zoo->adquire(Zoo::Animal::Camel->new(), Zoo::Animal::Camel->new());
      %count=$zoo->count();
      
      


      If you prefer you could yet implement the count as an hash, and increment it in the adquire Zoo method, like this:

      sub adquire {
        my $self=shift;
        for my $anim (@_) {
          $self->{count}->{$anim->specie()}++;
          push @{$self->{animals}}, $anim;
        }
      }
      
      


Re: Creating Common Constructor
by jaa (Friar) on Jul 10, 2003 at 15:16 UTC

    Maybe something like:

    #---------------------------------------- package Zoo::Animal; use strict; 1; sub new { my $class = shift; my $sref_oid = Zoo::Zoo->_gen_oid(); my $self = { _oid => $$sref_oid, @_ }; bless $self, $class; print "Animal initialised\n"; return $self; } #---------------------------------------- package Zoo::Camel; use strict; use base qw( Zoo::Animal ); sub new { my ( $class ) = @_; my $self = $class->SUPER::new( _type => 'camel', _color => 'grey', _legs => 4, _humps => 2, ); print "Camel initialised\n"; return $self; } #---------------------------------------- package Zoo::Lama; use strict; use base qw( Zoo::Animal ); sub new { my ( $class ) = @_; my $self = $class->SUPER::new( _type => 'lama', _color => 'white', _legs => 4, ); print "Lama initialised\n"; return $self; }
    I don't know if I agree with your Zoo::Zoo 8-)
    package Zoo::Zoo; use UUID; use lib '.'; use base qw( Zoo::Animal Zoo::Camel Zoo::Lama );
    This seems to say to me that a Zoo::Zoo is an Animal, a Camel or a Lama - I would have thought the Zoo is more like a container of Animals, rather than an actual beastie?
Re: Creating Common Constructor
by exussum0 (Vicar) on Jul 10, 2003 at 15:52 UTC
    Use the factory pattern in your Zoo object. It will create objects on your set of animal's behalf.

    Don't create a method for each count. If you can ID each object created in a generic fashion, then you can use a hash/map to keep track. Then when you want to know the counts, just feed it to a function taht can also figure out the ID w/o instanciation.

Re: Creating Common Constructor
by DeadPoet (Scribe) on Jul 10, 2003 at 16:08 UTC

    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

      Still some things here that don't make sense from a OO perspective.

      Like you said previously, a Zoo has Animals, an Animal is not a Zoo. Therefore, Animals shouldn't really be a subclass of Zoo.

      Your implementation still hard codes the animal types into the Zoo class. If you want to add a new type of animal, there are a lot of changes to make.
      Instead, the count methods should be members of the Animal subclasses. Zoo should have an array of objects of type Animal, and be able to get the count for each one.

      Here's my ideal design:

        jmanning2k, I am interested in your design thoughts, as well may be others, please post additional information. One other aspect that is not illustrated here but will be in my final post is the implementation of persistence by way of Storable.


        Additional Information:

        ** The Zoo object will act as a mapper object to all other created object and will be persistent (Storable) thus maintaining its state (knowledge) of all Animals.

        ** The Animal objects will be persistent thus maintaining their state.

        ** The Zoo object when loaded must be able to re-animate (load) all previously known Animals.

        Questions:

        ** How does this additional information change or affect your design?

        DeadPoet

Re: Creating Common Constructor
by smalhotra (Scribe) on Jul 10, 2003 at 16:25 UTC
    Try subclassing with something like this:

    package Zoo::Animal; ## it's a hashref! my $count = {}; sub new { ## get the first argument, could be a blessed object or a package na +me my $type = shift; ## get the package name my $class = ref $type || $type; my $self = bless {} $class; ## get the name of the animal my ($animal) = $class =~ /^Zoo::Animal::(.+)$/; $count->{$animal}++; return $self->_init(@_); ## call the animal's init method and retur +n what it returns } ## does nothing in package Zoo::Animal sub _init {} #### package Zoo::Animal::Camel ## no sub new sub _init { $self = shift; ### blah blah blah $self->{title} = "Programming Perl"; return $self; } ... # will call Zoo::Animal::new() then Zoo::Animal::Camel::_init() my $camel = Zoo::Animal::Camel->new();
    -hth
    Sidharth.

    $will->code for @food or $$;

Re: Creating Common Constructor
by Flame (Deacon) on Jul 10, 2003 at 16:27 UTC

    Inheritance is another way to go.

    package Foo; our $count = 0; sub new { my $class = (ref($_[0]) ? ref(shift) : shift); $count++; return bless({ @_ }, $class); } package Bar; our @ISA = ('Foo'); sub new { my $self = SUPER::new(@_); #Anything unique to this class can now be applied to the object... return $self; }

    I often use this approach when there are several attributes guaranteed to be present in all of the instances, such as the name of the creature or whatever. Also, thanks to inheritance, you can place any methods that all of these classes should support into the base class.

    I hope this helps, I've only been awake for... about 3 minutes now, so my interpretation of your question may be a little... off...

    Edit/Note: SUPER::new is a common trick used in many object oriented languages when the parent contstructor has code to take care of a lot of the setup work.



    My code doesn't have bugs, it just develops random features.

    Flame ~ Lead Programmer: GMS (DOWN) | GMS (DOWN)

      Just realize, that he wants to garantee keeping track of them. So if someone writes an animal object without a super, he's screwed.

      But for the attribute thing, i'm sure there's something he can work out.. perhaps keeping the various attributes to create in a config file, have the parent read in said config file, and evertytime you want an object created, the zoo object would dynamically know what to make. Hrm....

Re: Creating Common Constructor
by Anonymous Monk on Jul 13, 2003 at 13:09 UTC
    If you are really adventerous you could try Class::Maker (badly documented though):
    use Class::Maker qw(:all); class 'Zoo', { public => { array => [qw( animals )], } }; class 'Animal', { public => { string => [qw( name )], } }; class 'Camel', { isa => [qw( Animal )], }; class 'Lama', { isa => [qw( Animal )], }; my $z = Zoo->new(); push @{ $z->animals }, Camel->new( name => 'Murat' );
    It provides a default constructor which is quite elegant. Good Luck, Murat

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://272998]
Approved by broquaint
Front-paged by gmax
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (4)
As of 2014-08-31 05:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (294 votes), past polls