File Coverage

blib/lib/EO.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	32	93.7

package EO;

use strict;
use warnings;

use EO::Error;
use Data::UUID;
use EO::Attributes;
use EO::NotAttributes;
use Class::Accessor::Chained;
use Data::Structure::Util qw( get_blessed );
use Storable;

use base qw( Class::Accessor::Chained );

our $VERSION = 0.96;
our $AUTOLOAD;

exception EO::Error::New;
exception EO::Error::Method;
exception EO::Error::Method::Private  extends => 'EO::Error::Method';
exception EO::Error::Method::NotFound extends => 'EO::Error::Method';
exception EO::Error::Method::Abstract extends => 'EO::Error::Method';
exception EO::Error::InvalidParameters;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = bless $class->primitive(), $class;
    my $text = "Couldn't create object of class '$class'";
    throw EO::Error::New text => $text unless $self->init( @_ );
    if (!$self->{ _eo_init_success }) {
      require Carp;
      my $class = ref($self);
      Carp::cluck("init not passed up the call chain");
    }
    return $self;
}

sub init {
  my $self = shift;
  $self->{ _eo_init_success } = 1;
}

sub generate_oid {
  Data::UUID->new()->create_str();
}

sub primitive : Private {
  return { _eo_init_success => 0 };
}

sub set_oid : Private {
  my $self = shift;
  if (@_) {
    $self->{ oid } = shift;
    return $self;
  }
}

sub oid {
  my $self = shift;
  if (@_) {
    throw EO::Error::InvalidParameters text => "Can't set read-only valid oid";
  }
  ## generate oids lazily
  if (!$self->{ oid }) {
    $self->set_oid( $self->generate_oid() );
  }
  return $self->{ oid };
}

sub AUTOLOAD {
  my $self = shift;
  my $class = ref($self) ? ref($self) : $self;
  my $meth = substr($AUTOLOAD, rindex($AUTOLOAD, ':') + 1);
  my $text = "Can't locate object method \"$meth\" via package '$class'";
  local($Error::Depth) = $Error::Depth + 1;
  throw EO::Error::Method::NotFound text => $text;
}

sub clone {
  my $self = shift;
  my $clone = Storable::dclone( $self );
  my $objs  = get_blessed( $clone );
  ## ensure we regenerate the oids.
  foreach my $object (@$objs) {
    if ($object->isa('EO')) {
      $object->set_oid( $object->generate_oid() );
    }
  }
  $clone;
}

sub as_string {
  my $self = shift;
  my $class = ref($self);
  return "I am an '$class' object";
}

sub DESTROY { 1; }

1;

__END__