Class-AutoDB

 view release on metacpan or  search on metacpan

lib/Class/AutoDB.pm  view on Meta::CPAN

package Class::AutoDB;
# $Id: AutoDB.pm,v 1.49 2006/05/15 18:38:18 natgoodman Exp $
use vars qw(@ISA @AUTO_ATTRIBUTES @OTHER_ATTRIBUTES %SYNONYMS);
use strict;
use DBI;
use Class::AutoClass;
use Hash::AutoHash::Args;
use Class::AutoDB::Globals;
use Class::AutoDB::Connect;
use Class::AutoDB::Database;
use Class::AutoDB::Registry;
use Class::AutoDB::RegistryDiff;
our $VERSION = '1.291';
$VERSION=eval $VERSION;		# I think this is the accepted idiom..

# NG 09-11-24: move Database first so AutoClass::get will not mask Database::get
#              this breaks the usual rule that AutoClass must be first, but it's okay 
#              since we know Database and Connect do not provide 'new' methods.
#              note also that AutoClass redundant here since Database and Connect
#              both inherit from AutoClass anyway
use base qw(Class::AutoDB::Database Class::AutoDB::Connect Class::AutoClass);

@AUTO_ATTRIBUTES=qw(read_only read_only_schema alter_param index_param
		    object_table registry
		    session cursors
		    _db_cursor);
@OTHER_ATTRIBUTES=qw(server=>'host');
%SYNONYMS=();
Class::AutoClass::declare;

use vars qw($AUTO_REGISTRY);	# TODO: move to Globals
$AUTO_REGISTRY=new Class::AutoDB::Registry;
our $GLOBALS=Class::AutoDB::Globals->instance();

# usual case is compile time registration: autodb not yet set
sub auto_register {
  my($args)=@_;
  my $autodb=$GLOBALS->autodb;
  $autodb? $autodb->register($args): $AUTO_REGISTRY->register($args);
}

sub _init_self {
  my($self,$class,$args)=@_;
  return unless $class eq __PACKAGE__; # to prevent subclasses from re-running this
  $GLOBALS->autodb($self) unless $GLOBALS->autodb;
  return unless $self->is_connected; # connection handled in Class::AutoDB::Connect
  # NG 09-12-05: alter, index needed by register. find, get no longer supported
  # NG 11-01-07: register allowed to alter if -create set
  # my($alter,$index)=@$args{qw(alter index)};
  # $self->set(create_param=>$create,alter_param=>$alter,index_param=>$index);
  my($create,$alter,$index)=@$args{qw(create alter index)};
  # NG 11-01-07: setting alter_param harder than it looks 'cuz of default semantics.. 
  $alter=($alter||$create)? 1: (!defined $alter? undef: 0);
  $self->set(alter_param=>$alter,index_param=>$index);
  $self->manage_registry($args);
  # NG 09-12-05: find, get params no longer supported
  #   my $find=$args->find;
  #   my $get=$args->get;
  #  unless ($find) {
  #    $self->manage_registry($args);
  #  } else {
  #     $self->manage_query($find,$args);
  #   }
}
# NG 09-12-06: rewrote to reduce redundacy with _init_self and to be compatible with 'new'
sub renew {
  my($self,@args)=@_;
  my $args=new Hash::AutoHash::Args(@args);
  $self->reconnect($args);	# disconnect and reconnect
  # set attributes not already set in reconnect
  $self->Class::AutoClass::set_attributes([qw(read_only read_only_schema)],$args);
  $self->_init_self(ref $self,$args);
  return unless $self->is_connected;
  $self;
}
sub register {
  my $self=shift;
  $self->registry->register(@_);
  # NG: 09-12-05: store registry after programmatic change
  #               uses alter, index params from 'new'
  $self->manage_registry
    (new Hash::AutoHash::Args alter=>$self->alter_param,index=>$self->index_param);
}
# NG 10-09-16: realized some time ago that is_extant, is_deleted redundant since overloaded
#              'bool' does same thing more easily, but forgot to comment them out from here
# NG 10-09-07: added is_extant, is_deleted to support deleted objects

lib/Class/AutoDB.pm  view on Meta::CPAN

=head1 NAME

Class::AutoDB - Almost automatic object persistence coexisting with human-engineered database

=head1 VERSION

Version 1.291

=head1 SYNOPSIS

  # code that defines persistent class
  #
  package Person;
  use base qw(Class::AutoClass);
  use vars qw(@AUTO_ATTRIBUTES %AUTODB);
  @AUTO_ATTRIBUTES=qw(name sex id friends);
  %AUTODB=
    (collection=>'Person',
     keys=>qq(name string, sex string, id integer));  
  Class::AutoClass::declare;

  ########################################
  # code that uses persistent class

  # create and store new objects
  #
  use Class::AutoDB;
  use Person;
  my $autodb=new Class::AutoDB(database=>'test'); # open database

  # make some objects. not yet stored in database
  my $joe=new Person(name=>'Joe',sex=>'M',id=>1);
  my $mary=new Person(name=>'Mary',sex=>'F',id=>2);
  my $bill=new Person(name=>'Bill',sex=>'M',id=>3);

  # set up friends lists. each is a list of Person objects
  $joe->friends([$mary,$bill]);
  $mary->friends([$joe,$bill]);
  $bill->friends([$joe,$mary]);

  # store objects in database
  $autodb->put_objects;

  # retrieve existing objects
  #
  use Class::AutoDB;
  use Person;
  my $autodb=new Class::AutoDB(database=>'test');

  # retrieve list of objects
  my @persons=$autodb->get(collection=>'Person');        # everyone
  my @males=$autodb->get(collection=>'Person',sex=>'M'); # just the boys  

  # do something with the retrieved objects, for example, print friends lists
  for my $person (@persons) {
    my @friend_names=map {$_->name} @{$person->friends};
    print $person->name,"'s friends are @friend_names\n";
  }
 
  # retrieve and process objects one-by-one
  my $cursor=$autodb->find(collection=>'Person'); 
  while (my $person=$cursor->get_next) {
    # do what you want with $person, for example, print friends list
    my @friend_names=map {$_->name} @{$person->friends};
    print $person->name,"'s friends are @friend_names\n";
 }

  # connect auto-persistent objects with engineered tables
  # assume database has human-engineered tables
  #   Dept(id int, name varchar(255)), EmpDept(emp_id int, dept_id int)
  # this query retrieves the names of Joe's departments
  use DBI;
  my $dbh=$autodb->dbh;
  my $depts=$dbh->selectcol_arrayref
    (qq(SELECT Dept.name FROM Dept, EmpDept, Person 
        WHERE Dept.id=EmpDept.dept_id AND EmpDept.emp_id=Person.id 
        AND Person.name='Joe'));

  ########################################
  # new features in verion 1.20

  # retrieve objects using SQL
  # assuming the above database (with human-engineered tables Dept and EmpDept),
  # this query retrieves Person objects for employees in the toy department
  my @toy_persons=
  $autodb->get
    (sql=>qq(SELECT oid FROM Dept, EmpDept, Person 
             WHERE Dept.id=EmpDept.dept_id AND EmpDept.emp_id=Person.id 
             AND Dept.name='toy'));

  # retrieve all objects
  my @all_objects=$autodb->get;

  # delete objects
  #
  $autodb->del(@males);                                  # delete the boys  


=head1 DESCRIPTION

This class works closely with L<Class::AutoClass> to provide almost
transparent object persistence that can coexist with a
human-engineered database. The auto-persistence mechanism provides
hooks for connecting the two parts of the database together.

B<Caveat>: The current version only works with MySQL.

For applications where performance is not pressing, you can use this
class for all your persistent data.  In other cases, you can use it
for structurally complex, but low volume, parts of your database,
while storing performance-critical data in carefully engineered
tables.  This class is also handy for prototyping persistent
applications and lets you incrementally replace auto-persistent
components with engineered tables as your design proceeds.

=head2 Persistence model

This section presents a brief overview of the class.  Please see later
sections for details.

You declare a class to be persistent by defining the %AUTODB variable
in the module.  L<Class::AutoClass> (specifically,

lib/Class/AutoDB.pm  view on Meta::CPAN

Actually, in most cases, you can just assume that there is a
connection, because 'new' will fail if it cannot establish the
connection, and the underlying DBI software will reconnect
automatically if the connection breaks.

=head2 Queries

The methods described here operate on Class::AutoDB objects.  See
L<METHODS AND FUNCTIONS - Cursors|"Cursors"> for related methods operating on
Class::AutoDB::Cursor objects.

=head3 get

 Title   : get
 Usage   : my @males=$autodb->get(collection=>'Person',name=>'Joe',sex=>'M')
           -- OR --
           my $males=$autodb->get(collection=>'Person',name=>'Joe',sex=>'M')
           -- OR --
           my @males=$autodb->get(collection=>'Person',
                                  query=>{name=>'Joe',sex=>'M'})
           -- OR --
           my $males=$autodb->get(collection=>'Person',
                                  query=>{name=>'Joe',sex=>'M'})
           -- OR --
           my @all_objects=$autodb->get
           -- OR --
           my $all_objects=$autodb->get
           -- OR --
           my @joe_bill=$autodb->get(sql=>qq(SELECT oid FROM Person 
                                             WHERE name='Joe' OR name='Bill'))
           -- OR --
           my $joe_bill=$autodb->get(sql=>qq(SELECT oid FROM Person 
                                             WHERE name='Joe' OR name='Bill'))
 Function: Execute query and return results
 Returns : list or ARRAY of objects satisfying query
 Args    : collection Name of collection being queried
           query      search_key=>value pairs. Each search key must be defined
                      for collection. Each value must be single value of correct
                      type for search key. For all types except 'object' or 
                      'list(object)', value must be simple scalar (string or 
                      integer). For 'object' or 'list(object)', value must be
                      persistent object
           sql        raw SQL that selects oids of objects to be retrieved 
           other args interpreted as search_key=>value pairs
 Notes   : With no arguments, retrieves all objects.
           Okay to include both search keys and SQL

search_key=>value pairs are ANDed. For list types, the query is true if
any element on list has the value. If a collection has a search key named
'collection', you must use an explicit 'query' arg to include it in a query.

The SQL argument must select a single column which is interpreted as
containing the oids of objects to be retrieved. Our code adds
additional SQL that uses the oids to select objects from _AutoDB.

If you supply search_key=>value pairs and a SQL statement, they are ANDed.

=head3 find

 Title   : find
 Usage   : my $cursor=$autodb->find(collection=>'Person',name=>'Joe',sex=>'M')
           -- OR --
           my $cursor=$autodb->find(collection=>'Person',
                                    query=>{name=>'Joe',sex=>'M'})
           -- OR --
           my $cursor=$autodb->find
           -- OR --
           my $cursor=$autodb->find(sql=>qq(SELECT oid FROM Person 
                                            WHERE name='Joe' OR name='Bill'))
 Function: Execute query. 
 Returns : Class::AutoDB::Cursor object which can be used to retrieve results
 Args    : same as 'get'
 Notes   : same as 'get'

=head3 count

 Title   : count
 Usage   : my $count=$autodb->count(collection=>'Person',name=>'Joe',sex=>'M')
           -- OR --
           my $count=$autodb->count(collection=>'Person',
                                    query=>{name=>'Joe',sex=>'M'})
           -- OR --
           my $cursor=$autodb->find
           -- OR --
           my $cursor=$autodb->find(sql=>qq(SELECT oid FROM Person 
                                            WHERE name='Joe' OR name='Bill'))
 Function: Count number of objects satisfying query
 Returns : number
 Args    : same as 'get'
 Notes   : same as 'get'

=head3 oid

 Title   : oid
 Usage   : my $oid=$autodb->oid($object)
 Function: Access object's oid (immutable object identifier)
 Returns : oid as number, NOT Class::AutoDB::Oid object. undef if argument not
           persistent
 Args    : persistent object, Class::AutoDB::Oid object, or 
           Class::AutoDB::OidDeleted object

=head2 Cursors

The methods described here operate on Class::AutoDB::Cursor objects
returned by L<"find">.  See L<METHODS AND FUNCTIONS - Queries|"Queries"> for
related methods operating on Class::AutoDB objects.

=head3 get

 Title   : get
 Usage   : my @males=$cursor->get
           -- OR --
           my $males=$cursor->get
 Function: Retrieve results of query associated with cursor
 Returns : list or ARRAY of objects satisfying query
 Args    : none

It is possible to mix 'get' and 'get_next' operations. If some
'get_next' operations have been run on cursor, 'get' retrieves
remaining objects

=head3 get_next

 Title   : get_next
 Usage   : my $object=$cursor->get_next
 Function: Retrieve next result for cursor or undef if there are no more
 Returns : object satisfying query or undef
 Args    : none
 Notes   : Allows simple while loops to iterate over results as in SYNOPSIS

=head3 count

 Title   : count
 Usage   : my $count=$cursor->count
 Function: Count number of objects satisfying query associated with cursor
 Returns : number
 Args    : none

=head3 reset

 Title   : reset
 Usage   : $cursor->reset
 Function: Re-execute query associated with cursor.
 Returns : nothing
 Args    : none
 Notes   : Subsequent 'get' or 'get_next' operation will start at beginning 

=head2 Updates

=head3 put

 Title   : put
 Usage   : $autodb->put(@objects)
 Function: Store one or more objects in database
 Returns : nothing
 Args    : list of persistent objects, Oids, or OidDeleteds
 Notes   : nop (does nothing) on Oids and OidDeleteds

The difference between 'put' and 'put_objects' is that when called
with no objects, 'put' does nothing, while 'put_objects' stores all
persistent objects

=head3 put_objects

 Title   : put_objects
 Usage   : $autodb->put_objects
           -- OR --
           $autodb->put_objects(@objects)
 Function: Store all persistent objects (first form) or list of persistent 
           objects (second form)
 Returns : nothing
 Args    : list of persistent objects, Oids, or OidDeleteds
 Notes   : nop (does nothing) on Oids and OidDeleteds

The difference between 'put' and 'put_objects' is that when called
with no objects, 'put' does nothing, while 'put_objects' stores all
persistent objects

=head3 del

 Title   : del
 Usage   : $autodb->del(@objects)
 Function: Delete one or more objects from memory and database
 Returns : nothing
 Args    : list of persistent objects, Oids, or OidDeleteds
 Notes   : nop (does nothing) on OidDeleteds

=head2 Manage database schema 

=head3 exists

 Title   : exists
 Usage   : my $bool=$autodb->exists
 Function: Test whether AutoDB database exists
 Returns : boolean
 Args    : none

=head3 register

 Title   : register
 Usage   : $autodb->register(class=>'Person',collection=>'Person', 
                             keys=>qq(name string, sex string, id integer),
                             transients=>qq(name_prefix sex_word))



( run in 1.797 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )