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");
[download]

_________
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;
  }
}

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.

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;
}
[download]

package Zoo::Zoo;

use UUID;
use lib '.';
use base qw( Zoo::Animal Zoo::Camel Zoo::Lama );
[download]

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:

Read more... (2 kB)

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

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;
}
[download]

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....

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();
[download]

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

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' );
[download]