package Singleton;
my $singleton;
sub new {
my $class = shift;
$singleton ||= bless {}, $class;
}
####
package SingletonBase;
my $singleton;
sub new {
my $class = shift;
$singleton{ $class } ||= bless {}, $class;
}
##
##
# encapsulated class data
{
my %_singleton;
my %_attr_data =
( _dbd => [ undef, 'r/w' ],
_dbname => [ undef, 'r/w' ],
_dbpass => [ undef, 'r/w' ],
_dbserver => [ undef, 'r/w' ]
);
my $_count = 0;
sub _get {
my ( $class ) = @_;
return $_singleton{ $class } if ( $defined( _singleton{ $class } ) );
return 0;
}
sub _create {
my ( $self ) = @_;
my $_singleton{ ref($self) } = $self;
}
sub _accessible {
my ( $self, $attr, $mode ) = @_;
$_attr_data{$attr}[1] =~ /$mode/;
}
sub _default_for {
my ( $self, $attr ) = @_;
$_attr_data{$attr}[0];
}
sub _standard_keys {
keys %_attr_data
}
sub _count {
my ( $self ) = @_;
++$_count;
$self->{ "_id" } = $_count;
}
}
sub new {
my ( $caller, %arg ) = @_;
my $caller_is_obj = ref( $caller );
my $class = $caller_is_obj || $caller;
return _get( $class ) if ( _get( $class ) );
my $self = bless {}, $class;
$self->_create();
foreach my $attrname ( $self->_standard_keys() ) {
my ( $argname ) = ( $attrname =~ /^_(.*)/ );
if ( exists $arg{ $argname } )
{ $self->{ $attrname } = $arg{ $argname } }
elsif ( $caller_is_obj )
{ $self->{ $attrname } = $caller->{ $attrname } }
else
{ $self->{ $attrname } = $self->_default_for( $attrname ) }
}
$self->_count();
return $self;
}