#####################################################
# sample Singleton Design Pattern implementation
#
# I haven't tried to build this with 
# inheritence in mind; if that's what you
# want you'll have to do more work.
#
# Usage:
#   use Singleton;
#   my $a = new Singleton;
#
#   $a->property( color => 'blue' );
#   print $a->property( 'color' );   # This will print 'blue'.
#
#   my $b = new Singleton;
#   print $b->property( 'color' );   # This will also print 'blue'.
#
####################################
package Singleton;

our $uniqueObject;

# Return an empty hash which has been blessed into the Singleton class.
sub _newUniqueObject {
  return bless {}, "Singleton";
}

# If the singleton object doesn't exist yet, then create one.
# If it does exist, then just return it.
sub new {
  $uniqueObject = _newUniqueObject() unless defined $uniqueObject;
  return $uniqueObject;
}

# Any other methods go here.  This one gets or sets any property.
# Usage:  
#   $object->property( $key => $value );   # set a property
#   $value = $object->property($key);      # get a property
sub property {
  my $self = shift;  # This should always be the unique global.
  my ($key, $value) = @_;
  $self->{$key} = $value if $key && $value;
  return $self->{$key};				
}

##############################################################################
# Run this test if we're invoked from the command line as "perl Simpleton.pm".
if (not caller) {
  print "creating object 'a'\n";
  my $a = new Singleton;

  print "setting it's color to blue\n";
  $a->property( color => 'blue' );
  print " The color of 'a' is '" . $a->property( 'color' ) . "'\n";

  print "creating object 'b'\n";
  my $b = new Singleton;
  print " The color of 'b' is '" . $b->property( 'color' ) . "'\n";
  
}

1;