Class-Persist
view release on metacpan - search on metacpan
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:
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.395 second using v1.00-cache-2.02-grep-82fe00e-cpan-503542c4f10 )