view release on metacpan or  search on metacpan

lib/Class/Persist/Proxy.pm  view on Meta::CPAN

  return $self->set('class', shift) if @_;

  unless ($self->get('class')) {
    require Class::Persist::Tracker;
    my $tracker = Class::Persist::Tracker->load($self->oid)
      or return $self->record('Class::Persist::Error::DB::NotFound', "object " . $self->oid . " not found", 1);
    $self->set('class', $tracker->class);
  }
  return $self->get('class');
}

=head2 owner( $obj )

Get / set owner.
The owner is automatically proxied.

=cut

sub owner {
  my $self = shift;
  if (my ($owner) = @_) {
    blessed($owner) or Class::Persist::Error::InvalidParameters->throw(text => "owner should be an object");
    unless ($owner->isa('Class::Persist::Proxy')) {
      my $proxy = Class::Persist::Proxy->new();
      $proxy->class( ref $owner );
      $proxy->oid( $owner->oid );
      $owner = $proxy;
    }
    return $self->set('owner', $owner);
  }
  return $self->get('owner') || $self->load->owner;
}


=head2 load()

Replace the proxy by its target object

=cut

sub load {
  my $self  = shift;
  my $class = $self->class or return $self->record('Class::Persist::Error::InvalidParameters', "A class should be defined in proxy", 1);
  $self->loadModule( $class ) or return;

  my $obj = $class->load($self->get('owner') || $self->oid);

  unless ($obj) {
    require Class::Persist::Tracker;
    if (my $tracker = Class::Persist::Tracker->load($self->get('owner') || $self->oid)) {
      if (my $object = $tracker->object) {
        $self->_duplicate_from($object);
        bless $self => ref($object);
        return $self;
      }
    }
    return $self->record('Class::Persist::Error::DB::NotFound', "Could not load $class for $self", 1)
  }

  $self->_duplicate_from( $obj );
  bless $self => $class;
}


=head2 proxy( $obj )

Replace object by proxy

=cut

sub proxy {
  my $class  = shift;
  my $obj    = shift;
  my $owner = shift;
  return $obj if $obj->isa(__PACKAGE__);
  $obj->isa('Class::Persist') or Class::Persist::Error::InvalidParameters->throw(text => "object to proxy should be a Class::Persist");
  
  $class->loadModule( ref $obj ) or return;
  my $self = $class->new();
  $self->class( ref $obj );
  if ($owner) {
    $self->owner( $owner );
  }
  $self->real_id( $obj->oid );
  $obj->_duplicate_from( $self );
  bless $obj => $class;
}


sub AUTOLOAD {
  my $self = shift;
  $self = $self->load() or return; # die "Can't find in DB from ".(caller)[0]." line ".(caller)[2];
  my $meth = substr($AUTOLOAD, rindex($AUTOLOAD, ':') + 1);
  my $can = $self->can($meth) or EO::Error::Method::NotFound->throw(text => "Method $meth unknownin class ".ref($self));
  $can->($self, @_);
}

sub DESTROY { 1 }

sub clone {
  my $self = shift;
  $self = $self->load or return;
  return $self->clone(@_);
}

1;

=head1 SEE ALSO

Class::Persist

=head1 AUTHOR

Fotango

=cut

# Local Variables:
# mode:CPerl
# cperl-indent-level: 2
# indent-tabs-mode: nil
# End: