253 |
{ |
{ |
254 |
my $self = shift; |
my $self = shift; |
255 |
|
|
256 |
eval ("use Data::UUID;"); |
my $guid; |
257 |
my $ug = Data::UUID->new(); |
|
258 |
my $guid = $ug->create_str(); |
# try to use Data::UUID first ... |
259 |
|
eval("use Data::UUID;"); |
260 |
|
if (!$@) { |
261 |
|
my $ug = Data::UUID->new(); |
262 |
|
$guid = $ug->create_str(); |
263 |
|
|
264 |
|
# ... if this fails, try to fallback to Data::UUID::PurePerl instead ... |
265 |
|
} else { |
266 |
|
eval("use Data::UUID::PurePerl;"); |
267 |
|
if (!$@) { |
268 |
|
$guid = Data::UUID::PurePerl::generate_id(); |
269 |
|
} else { |
270 |
|
croak "couldn't create globally unique identifier"; |
271 |
|
} |
272 |
|
} |
273 |
|
|
274 |
return $guid; |
return $guid; |
275 |
} |
} |
482 |
return $self->id($obj) |
return $self->id($obj) |
483 |
if $self->id($obj); |
if $self->id($obj); |
484 |
|
|
485 |
# insert global unique identifier in object to persist across re-deploys |
# insert global unique identifier in object to persist across re-deploys |
486 |
$obj->{guid} = $self->make_guid(); |
$obj->{guid} = $self->make_guid(); |
|
|
|
|
# debug |
|
|
use Data::Dumper; |
|
|
print Dumper($obj); |
|
487 |
|
|
488 |
$saving->insert($obj); |
$saving->insert($obj); |
489 |
|
|
705 |
my $row = _fetch_object_state($self, $id, $class); |
my $row = _fetch_object_state($self, $id, $class); |
706 |
|
|
707 |
my $obj = $self->read_object($id, $class->{name}, $row); |
my $obj = $self->read_object($id, $class->{name}, $row); |
708 |
|
#return undef unless defined $row; |
709 |
|
|
710 |
# ??? $self->{-residue} = \@row; |
# ??? $self->{-residue} = \@row; |
711 |
|
|
723 |
my $class = $self->{schema}->classdef( $self->{id2class}{ int(substr($id, -$self->{cid_size})) } ); |
my $class = $self->{schema}->classdef( $self->{id2class}{ int(substr($id, -$self->{cid_size})) } ); |
724 |
|
|
725 |
my $row = _fetch_object_state($self, $id, $class); |
my $row = _fetch_object_state($self, $id, $class); |
726 |
|
#return undef unless defined $row; |
727 |
_row_to_object($self, $obj, $id, $class->{name}, $row); |
_row_to_object($self, $obj, $id, $class->{name}, $row); |
728 |
|
|
729 |
return $obj; |
return $obj; |
795 |
|
|
796 |
$sth->execute($self->{export_id}->($id)); |
$sth->execute($self->{export_id}->($id)); |
797 |
my $state = [ $sth->fetchrow_array() ]; |
my $state = [ $sth->fetchrow_array() ]; |
798 |
|
#croak "no object with id $id" unless (@{$state}); |
799 |
|
#unless (@$state) { |
800 |
|
# return undef unless $sth->err; |
801 |
|
# croak "error during load of object id=$id: $sth->err"; |
802 |
|
#} |
803 |
$sth->finish(); |
$sth->finish(); |
804 |
|
|
805 |
return $state; |
return $state; |