|
From: Chris W. <la...@us...> - 2001-10-23 12:16:04
|
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)
|