[Openinteract-commits] CVS: SPOPS/SPOPS GDBM.pm,1.14,1.15

[Chris W. <la...@us...>]

Update of /cvsroot/openinteract/SPOPS/SPOPS
In directory usw-pr-cvs1:/tmp/cvs-serv5608

Modified Files:
	GDBM.pm 
Log Message:
changes to new(), initialize() failed some tests; working now


Index: GDBM.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS/GDBM.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** GDBM.pm	2001/10/22 11:50:00	1.14
--- GDBM.pm	2001/10/23 12:16:01	1.15
***************
*** 36,40 ****
  # Dummy for subclasses to override
  
! sub _class_initialize { return 1; }
  
  # Override the default SPOPS initialize call so we can use mixed-case
--- 36,40 ----
  # Dummy for subclasses to override
  
! sub _class_initialize { return 1 }
  
  # Override the default SPOPS initialize call so we can use mixed-case
***************
*** 60,69 ****
      }
  
!     # Use all lowercase to allow people to give us fieldnames in mixed
!     # case (we are very nice)
  
!     my %data = map { lc $_ => $p->{ $_ } } keys %{ $p };
!     foreach my $key ( keys %data ) {
!         $self->{ $key } = $data{ $key };
      }
      return $self;
--- 60,69 ----
      }
  
!     # Go through the field list and set any that are passed in
  
!     foreach my $field ( @{ $self->field_list } ) {
!         next unless ( $p->{ $field } );
!         $self->{ $field } = $p->{ $field };
!         DEBUG && _w( 2, "Initialized ($field) to ($self->{ $field })" );
      }
      return $self;
***************
*** 72,76 ****
  # Override this to get the db handle from somewhere else, if necessary
  
! sub global_gdbm_tie {
      my ( $item, $p ) = @_;
      return $p->{db}    if ( ref $p->{db} );
--- 72,78 ----
  # Override this to get the db handle from somewhere else, if necessary
  
! sub global_gdbm_tie { my $item = shift; return $item->global_datasource_handle( @_ ) }
! 
! sub global_datasource_handle {
      my ( $item, $p ) = @_;
      return $p->{db}    if ( ref $p->{db} );
***************
*** 88,92 ****
          $gdbm_filename ||= $item->global_config->{gdbm_info}{filename};
      }
!     DEBUG() && _w( 1, "Trying file $gdbm_filename to connect" );
      unless ( $gdbm_filename ) {
          die "Insufficient/incorrect information to tie to GDBM file! ($gdbm_filename)\n";
--- 90,94 ----
          $gdbm_filename ||= $item->global_config->{gdbm_info}{filename};
      }
!     DEBUG() && _w( 1, "Trying file ($gdbm_filename) to connect" );
      unless ( $gdbm_filename ) {
          die "Insufficient/incorrect information to tie to GDBM file! ($gdbm_filename)\n";
***************
*** 121,124 ****
--- 123,127 ----
  }
  
+ 
  sub object_key {
      my ( $self, $id ) = @_;
***************
*** 126,137 ****
      die "Cannot create object key without object or id!\n"  unless ( $id );
      my $class = ref $self || $self;
!     return join '--', $class, $id;
  }
  
  # Given a key, return the data structure from the db file
  
  sub _return_structure_for_key {
      my ( $class, $key, $p ) = @_;
!     my $db    = $class->global_gdbm_tie( $p );
      my $item_info = $db->{ $key };
      return undef unless ( $item_info );
--- 129,141 ----
      die "Cannot create object key without object or id!\n"  unless ( $id );
      my $class = ref $self || $self;
!     return join( '--', $class, $id );
  }
  
+ 
  # Given a key, return the data structure from the db file
  
  sub _return_structure_for_key {
      my ( $class, $key, $p ) = @_;
!     my $db    = $class->global_datasource_handle( $p );
      my $item_info = $db->{ $key };
      return undef unless ( $item_info );
***************
*** 145,159 ****
  }
  
  # Retreive an object
  
  sub fetch {
      my ( $class, $id, $p ) = @_;
      my $data = $p->{data} || {};
!     unless ( $data ) {
          return undef unless ( $id and $id !~ /^tmp/ );
          return undef unless ( $class->pre_fetch_action( { id => $id } ) );
          $data = $class->_return_structure_for_key( $class->object_key( $id ),
!                                                    { filename => $p->{filename},
                                                       directory => $p->{directory} } );
      }
      my $obj = $class->new({ %{ $data }, skip_default_values => 1 });
--- 149,166 ----
  }
  
+ 
  # Retreive an object
  
  sub fetch {
      my ( $class, $id, $p ) = @_;
+     DEBUG && _w( 2, "Trying to fetch ID ($id)" );
      my $data = $p->{data} || {};
!     unless ( scalar keys %{ $data } ) {
          return undef unless ( $id and $id !~ /^tmp/ );
          return undef unless ( $class->pre_fetch_action( { id => $id } ) );
          $data = $class->_return_structure_for_key( $class->object_key( $id ),
!                                                    { filename  => $p->{filename},
                                                       directory => $p->{directory} } );
+         DEBUG && _w( 2, "Returned data from GDBM: ", Dumper( $data ) );
      }
      my $obj = $class->new({ %{ $data }, skip_default_values => 1 });
***************
*** 167,171 ****
  sub fetch_group {
      my ( $item, $p ) = @_;
!     my $db = $item->global_gdbm_tie( $p );
      my $class = ref $item || $item;
      DEBUG() && _w( 1, "Trying to find keys beginning with ($class)" );
--- 174,178 ----
  sub fetch_group {
      my ( $item, $p ) = @_;
!     my $db = $item->global_datasource_handle( $p );
      my $class = ref $item || $item;
      DEBUG() && _w( 1, "Trying to find keys beginning with ($class)" );
***************
*** 204,208 ****
  
      my $obj_index  = $self->object_key;
!     my $db = $self->global_gdbm_tie( $p );
      $db->{ $obj_index } = $obj_string;
  
--- 211,215 ----
  
      my $obj_index  = $self->object_key;
!     my $db = $self->global_datasource_handle( $p );
      $db->{ $obj_index } = $obj_string;
  
***************
*** 217,221 ****
      my ( $self, $p ) = @_;
      my $obj_index  = $self->object_key;
!     my $db = $self->global_gdbm_tie({ perm => 'write', %{ $p } });
      $self->clear_change;
      $self->clear_save;
--- 224,228 ----
      my ( $self, $p ) = @_;
      my $obj_index  = $self->object_key;
!     my $db = $self->global_datasource_handle({ perm => 'write', %{ $p } });
      $self->clear_change;
      $self->clear_save;
***************
*** 243,261 ****
  
  Implements SPOPS persistence in a GDBM database. Currently the
! interface is not as robust or powerful as the C<SPOPS::DBI>
  implementation, but if you want more robust data storage, retrieval
! and searching needs you should probably be using a SQL database anyway.
  
! This is also a little different than the C<SPOPS::DBI> module in that
! you have a little more flexibility as to how you refer to the actual
! GDBM file required. Instead of defining one database throughout the
! operation, you can change in midstream. (To be fair, you can also do
! this with the C<SPOPS::DBI> module, it is just a little more
! difficult.) For example:
  
   # Read objects from one database, save to another
!  my @objects = Object::Class->fetch_group( { filename => '/tmp/object_old.gdbm' } );
   foreach my $obj ( @objects ) {
!    $obj->save( { is_add => 1, gdbm_filename => '/tmp/object_new.gdbm' } );
   }
  
--- 250,269 ----
  
  Implements SPOPS persistence in a GDBM database. Currently the
! interface is not as robust or powerful as the L<SPOPS::DBI|SPOPS::DBI>
  implementation, but if you want more robust data storage, retrieval
! and searching needs you should probably be using a SQL database
! anyway.
  
! This is also a little different than the L<SPOPS::DBI|SPOPS::DBI>
! module in that you have a little more flexibility as to how you refer
! to the actual GDBM file required. Instead of defining one database
! throughout the operation, you can change in midstream. (To be fair,
! you can also do this with the L<SPOPS::DBI|SPOPS::DBI> module, it is
! just a little more difficult.) For example:
  
   # Read objects from one database, save to another
!  my @objects = Object::Class->fetch_group({ filename => '/tmp/object_old.gdbm' });
   foreach my $obj ( @objects ) {
!      $obj->save({ is_add => 1, gdbm_filename => '/tmp/object_new.gdbm' });
   }
  
***************
*** 280,287 ****
   my $obj = Object::Class->new( { GDBM_FILENAME = '/tmp/mydata.gdbm' } );
  
! B<global_gdbm_tie( \%params )>
  
  Returns a tied hashref if successful.
  
  There are many different ways of creating a filename used for
  GDBM. You can define a default filename in your package configuration;
--- 288,298 ----
   my $obj = Object::Class->new( { GDBM_FILENAME = '/tmp/mydata.gdbm' } );
  
! B<global_datasource_handle( \%params )>
  
  Returns a tied hashref if successful.
  
+ Note: This is renamed from C<global_gdbm_tie()>. The old method will
+ still work for a while.
+ 
  There are many different ways of creating a filename used for
  GDBM. You can define a default filename in your package configuration;
***************
*** 304,311 ****
  'read', 'write', or 'create' instead of these constants.
  
! If you pass nothing, C<SPOPS::GDBM> will assume 'read'. Also note that
! on some GDBM implementations, specifying 'write' permission to a file
! that has not yet been created still creates it, so 'create' might be
! redundant on your system.
  
  B<filename> ($) (optional)
--- 315,322 ----
  'read', 'write', or 'create' instead of these constants.
  
! If you pass nothing, L<SPOPS::GDBM|SPOPS::GDBM> will assume
! 'read'. Also note that on some GDBM implementations, specifying
! 'write' permission to a file that has not yet been created still
! creates it, so 'create' might be redundant on your system.
  
  B<filename> ($) (optional)