package Class::Capsule;

$VERSION = 1.0;

use strict;
use Data::Dumper;
$Data::Dumper::Indent = 1;
use Pod::Usage;
use WeakRef;

# Here's the subtle magic.  Object instances are stored in this class-
# level hash, keyed by a unique memory address.  Object instances are 
# stored under a single class level hash, keyed by memory address.
our %data;

=head2 NAME

  Class::Capsule - Base Encapsulation Class for Objects

=head2 DESCRIPTION

  This class provides a default constructor and automatic set, get, and 
  delete methods.  I call these collectively: 'accessors'.  The class
  enforces encapsulation in child classes using the memory address key 
  method (props to Damian Conway).

  The default constructor, new(), takes a hash of parameters and calls the 
  appropriate set method to set their values, then resets the '_MODIFIED'
  instance variable to zero.  It calls '_init()' before returning if it is 
  provided in the child class.  This allows you to do error checking and 
  initialize the object as needed.

  The class uses AUTOLOAD to provide automatic accessor methods for 
  instance variables.  You can provide your own accessor implementations,
  but you should follow the naming convention.  If you violate the naming 
  convention, the default accessors will exist anyway and you lose two 
  important benefits.

  First, AUTOLOADed accessors enforce a naming convention.  Set methods 
  must begin with 'set_'.  Get methods must begin with 'get_'.  Delete 
  methods must begin with 'del_'.  You can, and probably should, override 
  these methods.  This has the effect of encouraging a predictable 
  interface.  If you chose to name your accessors differently, this 
  benefit is foregone.

  Second, AUTOLOADed accessors count the number of times the object was 
  modified via 'set_' and 'del_'.  This is important for persistence.  
  For instance ;^), you need only save objects to your persistence store 
  if they have been modified.  If you choose to override the accessors, you 
  should make sure each set and delete method for which you write 
  implementations calls 'increment__MODIFIED()' within the method.  This 
  increments the '_MODIFIED' instance variable to flag the object as a 
  candidate for persistence.  Never set '_MODIFIED' unless you are 
  resetting it to zero with 'zero__MODIFIED'.

  The class level hash approach used to provide encapsulation 
  unfortunately also provides opacity.  Introspective methods, like 
  to_string() are provided to compensate for that.

  The class provides a usage() method which dies with the SYNOPSIS, 
  ARGUMENTS, and OPTIONS from the class POD.  Do this instead of dying
  when the class is misused.

=head2 SYNOPSIS

  #### A child class.
  package CapsuleChild;

  use Class::Capsule;
  @ISA = qw(Class::Capsule);
  use strict;

  sub _init {
     my ( $self ) = @_;
	 $self->usage("A stooge is required!") unless $self->get_stooge;
  }

  sub persist {
     my ( $self ) = @_;
     print "Saving " . $self->get_package . "\n";
  }

  1;

  #### Using the child.
  # Create the object and set an attribute.
  my $c = CapsuleChild->new( stooge => 'Moe' );

  # Create and set an instance variable.
  $c->set_marx( 'Harpo' );

  # Get an instance variable.
  print $c->get_stooge . "\n";

  # Delete an instance variable.
  $c->del_stooge;

  # Get a Data::Dumper serialized object.
  print $c->to_string;

  # Get a Data::Dumper of all Class::Capsule objects.
  print $c->to_string_all;          # Instance method.
  print Class::Capsule::to_string_all();   # Class method.

  # Get the object package.
  print $c->get_package . "\n";

  # Get the object's keys as an array reference.
  my $keys = $c->get_keys;
  print Dumper $keys;

  # Use the '_MODIFIED' flag for conditional persistence.
  $c->persist if $c->get__MODIFIED;

=cut

=head2 METHODS

=head2 new()

  Accepts a hash of arguments and calls the appropriate 'set_' method.  
  Calls $self->_init().  Use _init() to further populate the object and 
  check whether required arguments were passed in.

=cut

sub new {

	my ( $caller, %params ) = @_;

	my $class = ref($caller) || $caller;
	my $self = bless \my($scalar), $class;
	$data{$self} = { self => $self };

	for ( keys %params ) {
		my $method = "set_" . $_;
		$self->$method( $params{$_} );
	}
	
	$self->zero__MODIFIED;

	weaken $data{$self}{self};

	$self->_init if $self->can( '_init' );

	return $self;
}

# Avert your eyes!  Evil approacheth!

sub AUTOLOAD {

	my ( $self, $new ) = @_;
	
	our $AUTOLOAD;

	$AUTOLOAD =~ /.*::(set_|get_|del_)(.+)/;

	unless ( $2 ) {
		my $package = "Unknown";
		$package = $self->get_package if ref($self);
		my $error = "AUTOLOAD error:\nEither you're attempting to call a non-existent method ($AUTOLOAD)\nor you're not following the accessor naming convention.  Accessors must \nbegin with 'set_', 'get_', or 'del_' in $package.";
		die $error;
	}

	if ( $1 eq 'set_' ) {
		$data{$self}{$2} = $new;
		$self->increment__MODIFIED;
	} elsif ( $1 eq 'del_' ) {
		delete $data{$self}{$2};
		$self->increment__MODIFIED;
	}

	return $data{$self}{$2} if exists $data{$self}{$2};
}

=head2 increment__MODIFIED()

  Takes no arguments and returns nothing.  Increments the '_MODIFIED' 
  instance variable.  This should be called internally by every 'set_' 
  and 'del_' method.  Use this to determine whether an object should 
  be saved in the persistence store.

=cut

sub increment__MODIFIED {

	my ( $self ) = @_;

	$data{$self}{_MODIFIED}++;
}

=head2 zero__MODIFIED()

  Takes no arguments and returns nothing.  Sets the '_MODIFIED'
  instance variable to zero.  Never set '_MODIFIED' unless you 
  are resetting it to zero with this method.

=cut

sub zero__MODIFIED {

	my ( $self ) = @_;

	$data{$self}{_MODIFIED} = 0;
}

=head2 get_<instance variable>()

  Takes no arguments.  Returns the value of an instance variable.

  Overriding the 'get_' methods differs from the usual approach.  Instead 
  of doing this internally,

  return $self->{foo};

  Do this,

  return $Class::Capsule::data{$self}{foo};

=head2 set_<instance variable>()

  Takes a scalar (can be a reference).  Sets the instance variable's 
  value and returns the new value.  If you override this method, make 
  sure you call 'increment__MODIFIED()' within the method.  This increments 
  the '_MODIFIED' instance variable to flag the object as a candidate for 
  persistence:

  $self->increment__MODIFIED;

  Overriding the 'set_' methods differs from the usual approach.  You 
  should always return the new value.  Instead of doing this internally,

  $self->{foo} = 1;
  return $self->{foo};

  Do this,

  $Class::Capsule::data{$self}{foo} = 1;
  return $Class::Capsule::data{$self}{foo};

=head2 del_<instance variable>()

  Takes no arguments.  Deletes the instance variable.  If you override
  this method, make sure you call 'increment__MODIFIED()' within the method.  
  This increments the '_MODIFIED' instance variable to flag the object as a 
  candidate for persistence:

  $self->increment__MODIFIED;

  There is really no reason to override the delete method.

=head2 get_package()

  Returns the package name for the object instance.

=cut

sub get_package {

	my ( $self ) = @_;

	return ref( $self );
}

=head2 get_keys()

  Provided to enhance transparency, this returns the current keys 
  as an array reference.  You still will not be able to break
  encapsulation though.  :D

=cut

sub get_keys {

	my ( $self ) = @_;

	my @keys;
	for ( keys %{$data{$self}} ) {
		next if /self/;
		push( @keys, $_ );
	}

	return \@keys;
}

=head2 to_string()

  Provided to enhance transparency, this returns the serialized object 
  courtesy of Data::Dumper.

=cut

sub to_string {

	my ( $self ) = @_;

	return Dumper $data{$self};
}

=head2 to_string_all()

  Here is a little bonus.  This method dumps every object that inherits
  from Class::Capsule, via Data::Dumper.  It can be called as an instance method 
  or Class::Capsule class method.

=cut

sub to_string_all {

	my ( $self ) = @_;

	return Dumper \%data;
}

=head2 usage() 

  Takes a message string.  Dies printing SYNOPSIS, ARGUMENTS, and OPTIONS from 
  the class POD.

=cut

sub usage {

	my ( $self, $msg ) = @_;

	my $filepath = $self->get_package . ".pm";

	pod2usage( -input => $filepath, -verbose => 1, -msg => $msg );
}

=head2 DEPENDENCIES

  WeakRef.pm, Pod::Usage.pm

=cut

=head2 AUTHOR

  Todd Shoenfelt (aisarosenbaum@gmail.com)

=cut

1;