view release on metacpan or  search on metacpan

lib/Basset/Object/Persistent.pm  view on Meta::CPAN

package Basset::Object::Persistent;

#Basset::Object::Persistent Copyright and (c) 2000, 2002, 2003, 2004, 2005, 2006 James A Thomason III
#Basset::Object::Persistent is distributed under the terms of the Perl Artistic License.

our $VERSION = '1.03';

=pod

=head1 NAME

Basset::Object::Persistent - subclass of Basset::Object that allows objects to be easily stored into a relational database.
Presently only supports MySQL, but that may change in the future.

=head1 AUTHOR

Jim Thomason, jim@jimandkoka.com

=head1 SYNOPSIS

(no synopsis, this is an abstract super class that should never be instantiated directly, it should be subclassed for all
persistent objects and used through them)

=head1 DESCRIPTION

Basset::Object is the uber module in my Perl world. All objects should decend from Basset::Object. It handles defining attributes,
error handling, construction, destruction, and generic initialization. It also talks to Basset::Object::Conf to allow conf file use.

But, some objects cannot simply be recreated constantly every time a script runs. Sometimes you need to store the data in an object
between uses so that you can recreate an object in the same form the last time you left it. Storing user information, for instance.

Basset::Object::Persistent allows you to do that transparently and easily. Persistent objects need to define several pieces of additional
information to allow them to commit to the database, including their table definitions. Once these items are defined, you'll have access
to the load and commit methods to allow you to load and store the objects in a database.

It is assumed that an object is stored in the database in a primary table. The primary table
contains a set of columns named the same as object attributes. The attributes are stored in those columns.

 Some::Package->add_attr('foo');
 my $obj = Some::Package->new();
 $obj->foo('bar');
 $obj->commit();

 in the database, the 'foo' column will be set to 'bar'.

=cut

use Scalar::Util qw(weaken isweak);

use Basset::Object;
our @ISA = Basset::Object->pkg_for_type('object'); 

use strict;
use warnings;

=pod

=head1 ATTRIBUTES

=over

=item loaded

boolean flag 1/0.

This flag tells you whether or not the objects you are operating on has been loaded from a database or initially created
at this time and not loaded. This flag is set internally, and you should only read it.

=cut

=pod

=begin btest(loaded)

my $o = __PACKAGE__->new();
$test->ok($o, "Got object");
$test->is(scalar(__PACKAGE__->loaded), undef, "could not call object method as class method");
$test->is(__PACKAGE__->errcode, "BO-08", "proper error code");
$test->is(scalar($o->loaded), 0, 'loaded is 0');
$test->is($o->loaded('abc'), 'abc', 'set loaded to abc');
$test->is($o->loaded(), 'abc', 'read value of loaded - abc');
my $h = {};
$test->ok($h, 'got hashref');
$test->is($o->loaded($h), $h, 'set loaded to hashref');
$test->is($o->loaded(), $h, 'read value of loaded  - hashref');
my $a = [];
$test->ok($a, 'got arrayref');
$test->is($o->loaded($a), $a, 'set loaded to arrayref');
$test->is($o->loaded(), $a, 'read value of loaded  - arrayref');

=end btest(loaded)

lib/Basset/Object/Persistent.pm  view on Meta::CPAN

				$place + 1,					#place
				$init{'vars'}->[$place],	#value
				$init{'table'}				#sql type if we have a table, undef otherwise
					? $driver->sql_type($definition->{$init{'cols'}->[$place]})
					: undef	
			) or return $self->$errormethod($stmt->errstr, "BOP-03");
#			$place++;
		};
	} else {
		#otherwise, just notify with the query
		$self->notify('debug', $init{'query'});
	}

	$stmt->execute() or return $self->$errormethod($stmt->errstr, "BOP-04");

	$self->end() or return;

	return $stmt if $init{'iterator'};# && $selecting_query;

	if ($selecting_query){

		my @data = ();

		#into determines our fetchmethod
		my $fetchmethod = $init{'into'} =~ /^array$/i ? 'fetchrow_arrayref' : 'fetchrow_hashref';	#default to hashes

		while (my $stuff = $stmt->$fetchmethod()){
			#push @data, $stuff;
			if ($fetchmethod eq 'fetchrow_hashref'){
			#	$stuff = {map {lc $_, $stuff->{$_}} keys %$stuff};
				#push @data, {%$stuff};
				push @data, {map {lc $_, $stuff->{$_}} keys %$stuff};
			}
			else {
				push @data, [@$stuff];
			};
		};

		$stmt->finish()
			or return $self->error($stmt->errstr, "BOP-10");

		return \@data;
	};

	$stmt->finish()
		or return $self->error($stmt->errstr, "BOP-10");

	return 1;
};

=pod

=item driver

The driver method is just a shortcut wrapper for Basset::DB->new(); Only give it the same arguments in the same
format as you would give to Basset::DB->new() itself. The driver object returned will be cached here for all time,
unless you explicitly wipe it out or set it to something else.

If the driver hasn't been accessed in the last 5 minutes, then it pings the database handle
before returning the driver to ensure that it's still live. If the ping fails and the driver
has no transaction stack, then you transparently just get back a new driver.

But if the ping fails AND the driver had an active transaction stack, then you get back an error.
Calling ->driver again will create a new handle, but you would presumably have an error condition
to deal with.

=cut

=pod

=begin btest(driver)

=end btest(driver)

=cut

__PACKAGE__->add_class_attr('_driver');

sub driver {
	my $self = shift;

	return $self->local_driver if $self->local_driver;

	if (@_) {
		return $self->_driver(shift);
	} elsif (my $driver = $self->_driver) {
		#if ($ENV{'MOD_PERL'} && ! $driver->ping) {
		if (! $driver->ping) {
			if ($driver->stack) {
				$self->notify("warnings", "Silently disconnecting stale driver with transaction stack");
			}
			$driver->recreate_handle;
		};
		return $driver;
	} else {
		my $driver = $self->factory('type' => 'driver') or return;
		return $self->_driver($driver);
	}
};

=pod

=item local_driver

Normally, you're always talking to one database with all of your objects in all of your classes. And in a perfect world, that would
always be the case. However, you may need to speak to more than one database at a time, and that's where local_driver comes in. Much like
->error, this is a method that may be called on either an object or a class to specify a localized driver for that class or object.

To make all Sub::Class objects talk to a different database:

 Sub::Class->local_driver(
 	Sub::Class->factory(
 		'type' => 'driver',
 		'dsn' => 'dbi:Pg:dbname=otherdatabase'
 	)
 );

To make just one talk to a different database:

 my $obj = Sub::Class->new(
 	'local_driver' => Sub::Class->factory(