/[cvs]/nfo/patches/cpan/Tangram/Storage.pm
ViewVC logotype

Diff of /nfo/patches/cpan/Tangram/Storage.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by jonen, Mon Dec 16 05:08:22 2002 UTC revision 1.9 by joko, Thu Apr 24 00:21:27 2003 UTC
# Line 247  sub make_id Line 247  sub make_id
247      return sprintf "%d%0$self->{cid_size}d", $id, $class_id;      return sprintf "%d%0$self->{cid_size}d", $id, $class_id;
248    }    }
249    
250    
251    # create global unique identifers using Data::UUID
252    sub make_guid
253      {
254        my $self = shift;
255    
256        my $guid;
257    
258        # 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;
275      }
276    
277  sub make_1st_id_in_tx  sub make_1st_id_in_tx
278    {    {
279      my ($self) = @_;      my ($self) = @_;
# Line 455  sub _insert Line 482  sub _insert
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
486              $obj->{guid} = $self->make_guid();
487            
488      $saving->insert($obj);      $saving->insert($obj);
489    
490      my $class_name = ref $obj;      my $class_name = ref $obj;
# Line 484  sub _insert Line 514  sub _insert
514    
515            if ($Tangram::TRACE) {            if ($Tangram::TRACE) {
516                  printf $Tangram::TRACE "executing %s with (%s)\n",                  printf $Tangram::TRACE "executing %s with (%s)\n",
517                  $cache->{INSERTS}[$i],                  $cache->{INSERTS}[$i],
518                  join(', ', map { $_ || 'NULL' } @state[ @{ $fields->[$i] } ] )                  join(', ', map { $_ || 'NULL' } @state[ @{ $fields->[$i] } ] )
519            }            }
520    
# Line 675  sub load Line 705  sub load
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    
# Line 692  sub reload Line 723  sub reload
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;
# Line 763  sub _fetch_object_state Line 795  sub _fetch_object_state
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;
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.9
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed