MQdb_0.954/0000775007462200007660000000000011211420763013541 5ustar jessicajessica00000000000000MQdb_0.954/Changes0000644007462200007660000000101211211417647015033 0ustar jessicajessica00000000000000Revision history for Perl module package MQdb. 0.954 June 3, 2009 - added some more perldoc - fixed MQdb::Database to work better with sqlite and other file-based database engines - removed ->isa() check when setting database in DBObject for speed 0.953 Friday 17 April, 2009 - improved the perldoc formating and content - removed some deprecated methods 0.952 Thursday April 2, 2009 - perldoc formating 0.951 Thursday April 2, 2009 - original version and first upload to CPAN MQdb_0.954/lib/0000775007462200007660000000000011211420770014305 5ustar jessicajessica00000000000000MQdb_0.954/lib/MQdb/0000775007462200007660000000000011211420775015135 5ustar jessicajessica00000000000000MQdb_0.954/lib/MQdb/Database.pm0000640007462200007660000003772711210111172017174 0ustar jessicajessica00000000000000# $Id: Database.pm,v 1.34 2009/05/30 01:57:14 severin Exp $ =pod =head1 NAME - MQdb::Database =head1 DESCRIPTION Generalized handle on an DBI database handle. Used to provide an instance which holds connection information and allows a higher level get_connection/ disconnect logic that persists above the specific DBI connections. Also provides a real object for use with the rest of the toolkit. =head1 SUMMARY MQdb::Database provides the foundation of the MappedQuery system. Databases are primarily specified with a URL format. The URL format includes specification of a driver so this single method can select among the supported DBD drivers. Currently the system supports MYSQL, Oracle, and SQLite. The URL also allows the system to provide the foundation for doing federation of persisted objects. Each DBObject contains a pointer to the Database instance where it is stored. With the database URL and internal database ID, each object is defined in a global space. Attributes of MQdb::Database driver : mysql, oracle, sqlite (default mysql) user : username if the database requires password : password if the database requires host : hostname of the database server machine port : IP port of the database if required (mysql default is 3306) dbname : database/schema name on the database server for sqlite, this is the database file Example URLS mysql://:@:/ mysql://:/ mysql://@:/ mysql:/// oracle://:@/ oracle://:@:/ sqlite:/// =head1 CONTACT Jessica Severin =head1 LICENSE * Software License Agreement (BSD License) * MappedQueryDB [MQdb] toolkit * copyright (c) 2006-2009 Jessica Severin * All rights reserved. * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Jessica Severin nor the * names of its contributors may be used to endorse or promote products * derived from this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ''AS IS'' AND ANY * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE * DISCLAIMED. IN NO EVENT SHALL COPYRIGHT HOLDERS BE LIABLE FOR ANY * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. =head1 APPENDIX The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _ =cut $VERSION=0.954; package MQdb::Database; use strict; use DBI; =head2 new Description: instance creation method Parameter : a hash reference of options same as attribute methods Returntype : instance of this Class (subclass) Exceptions : none =cut =head2 new Description: instance creation method Returntype : instance of this Class (subclass) Exceptions : none =cut sub new { my ($class, @args) = @_; my $self = {}; bless $self,$class; $self->init(@args); return $self; } =head2 init Description: initialization method which subclasses can extend Returntype : $self Exceptions : subclass dependent =cut sub init { my ($self, %params) = @_; $self->{'_uuid'} = ''; #initially not set $self->{'_driver'} = 'mysql'; $self->{'_host'} = $params{'-host'}; $self->{'_port'} = $params{'-port'}; $self->{'_user'} = $params{'-user'}; $self->{'_database'} = $params{'-database'} if(defined($params{'-database'})); $self->{'_database'} = $params{'-dbname'} if(defined($params{'-dbname'})); $self->{'_password'} = $params{'-pass'} if(defined($params{'-pass'})); $self->{'_password'} = $params{'-password'} if(defined($params{'-password'})); $self->{'_disconnect_count'} = 0; $self->_load_aliases; return $self; } =head2 new_from_url Description: primary instance creation method Parameter : a string in URL format Returntype : instance of MQdb::Database Examples : my $db = MQdb::Database->new_from_url("mysql://:@:/"); e.g. mysql://:/ e.g. mysql://@:/ e.g. mysql:/// e.g. sqlite:/// my $class = shift; Exceptions : none =cut sub new_from_url { #e.g. mysql://:@:/ #e.g. mysql://:/ #e.g. mysql://@:/ #e.g. mysql:/// #e.g. sqlite:/// my $class = shift; my $url = shift; my $pass = shift; my $self = {}; bless $self, $class; return undef unless($url); $self->_load_aliases; my $driver = 'mysql'; my $user = ''; my $host = ''; my $port = 3306; my $dbname = undef; my $path = ''; my $discon = 0; my $species; my $type; my ($p, $p2, $p3); #print("FETCH $url\n"); $p = index($url, "://"); return undef if($p == -1); $driver = substr($url, 0, $p); $url = substr($url, $p+3, length($url)); #print ("db_url=$url\n"); $p = index($url, "/"); return undef if($p == -1); my $conn = substr($url, 0, $p); $dbname = substr($url, $p+1, length($url)); my $params = undef; if(($p2=index($dbname, ";")) != -1) { $params = substr($dbname, $p2+1, length($dbname)); $dbname = substr($dbname, 0, $p2); } if((($driver eq 'mysql') or ($driver eq 'oracle')) and ($p2=index($dbname, "/")) != -1) { $path = substr($dbname, $p2+1, length($dbname)); $dbname = substr($dbname, 0, $p2); } while($params) { my $token = $params; if(($p2=rindex($params, ";")) != -1) { $token = substr($params, 0, $p2); $params = substr($params, $p2+1, length($params)); } else { $params= undef; } if($token =~ /type=(.*)/) { $type = $1; } if($token =~ /discon=(.*)/) { $discon = $1; } if($token =~ /species=(.*)/) { $species = $1; } } $species=$host . "_" . $dbname unless(defined($species)); #print(" conn=$conn\n dbname=$dbname\n path=$path\n"); my($hostPort, $userPass); if(($p=index($conn, "@")) != -1) { $userPass = substr($conn,0, $p); $hostPort = substr($conn,$p+1,length($conn)); if(($p2 = index($userPass, ':')) != -1) { $user = substr($userPass, 0, $p2); unless(defined($pass)) { $pass = substr($userPass, $p2+1, length($userPass)); } } elsif(defined($userPass)) { $user = $userPass; } } else { $hostPort = $conn; } if(($p3 = index($hostPort, ':')) != -1) { $port = substr($hostPort, $p3+1, length($hostPort)) ; $host = substr($hostPort, 0, $p3); } else { $host=$hostPort; } #return undef unless($host and $dbname); unless(defined($pass)) { $pass = ''; } ($host,$port) = $self->_check_alias($host,$port); $self->{'_uuid'} = ''; $self->{'_driver'} = $driver; $self->{'_host'} = $host; $self->{'_port'} = $port; $self->{'_database'} = $dbname; $self->{'_user'} = $user; $self->{'_password'} = $pass; my $full_url = $self->full_url; return $self; } =head2 copy Description: makes a copy of the database configuration. New instance will have its own database connection Returntype : instance of MQdb::Database =cut sub copy { my $self = shift; my $class = ref($self); my $copy = $class->new; $self->{'_uuid'} = $self->uuid; $self->{'_driver'} = $self->driver; $self->{'_host'} = $self->host; $self->{'_port'} = $self->port; $self->{'_user'} = $self->user; $self->{'_password'} = $self->password; $self->{'_database'} = $self->dbname; return $copy; } =head2 dbc Description: connects to database and returns a DBI connection Returntype : DBI database handle Exceptions : none =cut sub dbc { my $self = shift; return $self->get_connection; } sub get_connection { my($self) = @_; my $dbc = $self->{"DB_CONNECTION"}; if(defined($dbc)) { if($dbc->ping()) { return $dbc; } else { print STDERR "Failed Ping....\n"; $dbc->disconnect(); } } my $driver = $self->{'_driver'}; my $host = $self->{'_host'}; my $port = $self->{'_port'}; my $database = $self->{'_database'}; my $user = $self->{'_user'}; my $password = $self->{'_password'}; if($driver eq 'mysql') { my $dsn = "DBI:mysql:database=$database;host=$host;port=$port"; $dbc = DBI->connect($dsn, $user, $password, {RaiseError=>1, AutoCommit=>1}); } if($driver eq 'oracle') { my $dsn = "DBI:Oracle:" . $self->{'_database'}; $dbc = DBI->connect($dsn, $user, $password, {RaiseError=>1, AutoCommit=>1}); } if($driver eq 'sqlite') { my $dsn = "DBI:SQLite:dbname=/$database"; $dbc = DBI->connect($dsn, $user, $password); } $self->{"DB_CONNECTION"} = $dbc; return $dbc } =head2 disconnect Description: disconnects handle from database, but retains object and all information so that it can be reconnected again at a later time. Returntype : none Exceptions : none =cut sub disconnect { my $self = shift; return unless($self->{'DB_CONNECTION'}); my $dbc = $self->{'DB_CONNECTION'}; if($dbc->{ActiveKids} != 0) { warn("Problem disconnect : kids=",$dbc->{Kids}, " activekids=",$dbc->{ActiveKids},"\n"); return 1; } $dbc->disconnect(); $self->{'_disconnect_count'}++; $self->{'DB_CONNECTION'} = undef; #print("DISCONNECT\n"); return $self; } sub DESTROY { my $self = shift; #$self->disconnect(); } ############################################# # attribute access methods (no setting) ############################################# sub uuid { my $self = shift; return $self->{'_uuid'} = shift if(@_); return $self->{'_uuid'}; } sub driver { return shift->{'_driver'}; } sub host { return shift->{'_host'}; } sub port { my $self=shift; return $self->{'_port'}; } sub user { my $self=shift; return $self->{'_user'}; } sub password { my $self=shift; return $self->{'_password'}; } sub dbname { my $self=shift; return $self->{'_database'}; } sub disconnect_count { my $self=shift; return $self->{'_disconnect_count'}; } =head2 full_url Description: returns the URL of this database with user and password Returntype : string Exceptions : none =cut sub full_url { my $self = shift; my $full_url = sprintf("%s://%s:%s@%s:%s/%s", $self->driver, $self->user, $self->password, $self->host, $self->port, $self->dbname); #printf(" full_url : %s\n", $full_url); return $full_url; } =head2 url Description: returns URL of this database but without user:password used for global referencing and federation systems Returntype : string Exceptions : none =cut sub url { #no username or password in URL my $self = shift; return $self->{'_short_url'} if(defined($self->{'_short_url'})); my $url = $self->driver . "://"; if($self->host) { if($self->port) { $url .= $self->host .":". $self->port; } else { $url .= $self->host; } } $url .= "/". $self->dbname; $self->{'_short_url'} = $url; return $self->{'_short_url'}; } =head2 xml Description: returns XML of this database but without user:password used for global referencing and federation systems Returntype : string Exceptions : none =cut sub xml { #no username or password in URL my $self = shift; my $xml = sprintf("alias, $self->url); if($self->uuid) { $xml .= sprintf("uuid=\"%s\" ", $self->uuid); } $xml .= "/>"; return $xml; } sub alias { my $self = shift; $self->{'alias'} = shift if(@_); $self->{'alias'} = $self->dbname unless(defined($self->{'alias'})); return $self->{'alias'}; } #################################################### # # URL related methods # #################################################### sub _load_aliases { my $self = shift; $self->{'_aliases'} = {}; return unless(defined($ENV{'HOME'})); my $alias_file = $ENV{'HOME'} . "/.mqdb_url_aliases"; return unless(-e $alias_file); #print("found ALIAS file $alias_file\n"); open (ALIASFP,$alias_file) || return; while() { chomp; my($from, $to) = split(/\s+/); $self->{'_aliases'}->{$from} = $to; } close(ALIASFP); } sub _check_alias { my $self = shift; my $host = shift; my $port = shift; my $key = "$host:$port"; my $alias = $self->{'_aliases'}->{$key}; return ($host,$port) unless($alias); ($host,$port) = split(/:/, $alias); #print("translate alias $key into $host : $port\n"); return ($host,$port); } ################################################# # high level wrappers for direct queries ################################################# =head2 execute_sql Description : executes SQL statement with external parameters and placeholders Example : $db->execute_sql("insert into table1(id, value) values(?,?)", $id, $value); Parameter[1] : sql statement string Parameter[2..] : optional parameters for the SQL statement Returntype : none Exceptions : none =cut sub execute_sql { my $self = shift; my $sql = shift; my @params = @_; if($self->driver eq 'sqlite') { $sql =~ s/INSERT ignore/INSERT or ignore/g; } my $dbc = $self->get_connection; my $sth = $dbc->prepare($sql); eval { $sth->execute(@params); }; if($@) { printf(STDERR "ERROR with query: %s\n", $sql); printf(STDERR " params: "); foreach my $param (@params) { print(STDERR "'%s' ", $param); } print(STDERR "\n"); } $sth->finish; } =head2 do_sql Description : executes SQL statement with "do" and no external parameters Example : $db->do_sql("insert into table1(id, value) values(null,'hello world');"); Parameter : sql statement string with no external parameters Returntype : none Exceptions : none =cut sub do_sql { my $self = shift; my $sql = shift; if($self->driver eq 'sqlite') { $sql =~ s/INSERT ignore/INSERT or ignore/g; if(uc($sql) =~ /^UNLOCK TABLES/) { $sql = "END TRANSACTION;"; } if(uc($sql) =~ /^LOCK TABLE/) { $sql = "BEGIN TRANSACTION;"; } } my $dbc = $self->get_connection; if(!($dbc->do($sql))) { printf(STDERR "WARNING with query: %s\n", $sql); #die; } } =head2 fetch_col_value Arg (1) : $sql (string of SQL statement with place holders) Arg (2...) : optional parameters to map to the placehodlers within the SQL Example : $value = $self->fetch_col_value($db, "select some_column from my_table where id=?", $id); Description: General purpose function to allow fetching of a single column from a single row. Returntype : scalar value Exceptions : none Caller : within subclasses to easy development =cut sub fetch_col_value { my $self = shift; my $sql = shift; my @params = @_; my $dbc = $self->get_connection; my $sth = $dbc->prepare($sql); $sth->execute(@params); my ($value) = $sth->fetchrow_array(); $sth->finish; return $value; } 1; MQdb_0.954/lib/MQdb/DBObject.pm0000640007462200007660000002114411211416204017073 0ustar jessicajessica00000000000000# $Id: DBObject.pm,v 1.13 2009/06/03 06:47:32 severin Exp $ =head1 NAME MQdb::DBObject - DESCRIPTION of Object =head1 SYNOPSIS Root class for all objects in MappedQuery toolkit =head1 DESCRIPTION Root object for toolkit and all derived subclasses. All objects in the MappedQuery structure are designed to be persisted in a database. Here database is a more broad term and can be considered any object persistance systems. Currently the toolkit works with SQL based systems but object databases or custom storage engines are possible. Provides base common methods used by all objects. =head1 AUTHOR Contact Jessica Severin: jessica.severin@gmail.com =head1 LICENSE * Software License Agreement (BSD License) * MappedQueryDB [MQdb] toolkit * copyright (c) 2006-2009 Jessica Severin * All rights reserved. * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Jessica Severin nor the * names of its contributors may be used to endorse or promote products * derived from this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ''AS IS'' AND ANY * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE * DISCLAIMED. IN NO EVENT SHALL COPYRIGHT HOLDERS BE LIABLE FOR ANY * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. =head1 APPENDIX The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _ =cut $VERSION=0.954; package MQdb::DBObject; use strict; use MQdb::Database; ################################################# # Factory methods ################################################# =head2 new Description: instance creation method Returntype : instance of this Class (subclass) Exceptions : none =cut sub new { my ($class, @args) = @_; my $self = {}; bless $self,$class; $self->init(@args); #my $idx = rindex $class, "::"; #$self->{'_class'} = substr($class, $idx+2); return $self; } =head2 init Description: initialization method which subclasses can extend Returntype : $self Exceptions : subclass dependent =cut sub init { my $self = shift; #internal variables minimal allocation $self->{'_primary_db_id'} = undef; $self->{'_database'} = undef; return $self; } =head2 copy Description: Shallow copy which copies all base attributes of object to new instance of same class Returntype : same as calling instance Exceptions : subclass dependent =cut sub copy { my $self = shift; my $class = ref($self); my $copy = $class->new; foreach my $key (keys %{$self}) { $copy->{$key} = $self->{$key}; } #print('self = ', $self, "\n"); #print('copy = ', $copy, "\n"); return $copy; } sub DESTROY { my $self = shift; #If I need to do any cleanup - do it here $self->SUPER::DESTROY if $self->can("SUPER::DESTROY"); } ################################################# # Instance methods ################################################# =head2 class Description: fixed string symbol for this class. Must be implemented for each subclass and each subclass within toolkit should return a unique name. used by global methods. Returntype : string Exceptions : error if subclass does not redefine =cut sub class { my $self = shift; printf("ERROR:: DBObject subclass needs to implement class() method\n"); die(); } =head2 database Description: the MQdb::Database where this object is permanently persisted to. Here database is any object persistance system. Returntype : MQdb::Database Exceptions : die if invalid setter value type is provided =cut sub database { my $self = shift; if(@_) { my $db = shift; $self->{'_database'} = $db; } return $self->{'_database'}; } =head2 primary_id Description: the unique identifier for this object within database. Returntype : scalar or UNDEF Exceptions : none =cut sub primary_id { my $self = shift; $self->{'_primary_db_id'} = shift if @_; return $self->{'_primary_db_id'}; } =head2 id Description: the unique identifier for this object within database. Returns empty string if not persisted. Returntype : scalar or '' Exceptions : none =cut sub id { my $self = shift; $self->{'_primary_db_id'} = shift if @_; if(!defined($self->{'_primary_db_id'})) { return ''; } return $self->{'_primary_db_id'}; } =head2 db_id Description: the worldwide unique identifier for this object. A URL-like combination of database, class, and id Returntype : string or undef if database is not defined Exceptions : none =cut sub db_id { my $self = shift; return $self->{'_db_id'} if(defined($self->{'_db_id'})); return undef unless($self->database); if($self->database->uuid) { $self->{'_db_id'} = $self->database->uuid . "::" . $self->primary_id . ":::" . $self->class; } else { $self->{'_db_id'} = sprintf("%s://%s:%s/%s/%s?id=%d", $self->database->driver, $self->database->host, $self->database->port, $self->database->dbname, $self->class, $self->primary_id); } return $self->{'_db_id'}; } =head2 display_desc Description: general purpose debugging method that returns a nice human readable description of the object instance contents. Each subclass should implement and return a nice string. Returntype : string scalar Exceptions : none =cut sub display_desc { my $self = shift; return $self; #return object identifier for printing } =head2 display_info Description: convenience method which prints the display_desc string with a carriage return to STDOUT. useful for debugging. Returntype : none Exceptions : none =cut sub display_info { my $self = shift; printf("%s\n", $self->display_desc); } =head2 xml Description: every object in system should be persistable in XML format. returns an XML description of the object and all child objects. Each subclass must implement and return a proper XML string. Best if one implements xml_start() and xml_end() and use here. Returntype : string scalar Exceptions : none Default : default is a simple xml_start + xml_end =cut sub xml { my $self = shift; return $self->xml_start() . $self->xml_end(); } =head2 xml_start Description: every object in system should be persistable in XML format. returns an XML description of the object and all child objects. Each subclass should OVERRIDE this method and return a proper XML string. xml_start is the primary XML start tag Example : return sprintf("", $id, $name....); Returntype : string scalar Exceptions : none =cut sub xml_start { my $self = shift; return ''; } =head2 xml_end Description: every object in system should be persistable in XML format. returns an XML description of the object and all child objects. Each subclass should OVERRIDE this method and return a proper XML string. xml_end is the primary XML end tag Example : return ""; Returntype : string scalar Exceptions : none =cut sub xml_end { my $self = shift; return ''; } =head2 simple_xml Description: short hand for xml_start() . xml_end() Can be used when only the primary XML start tag and attributes are needed No need to override if xml_start() and xml_end() are implemented Returntype : string scalar Exceptions : none =cut sub simple_xml { my $self = shift; return $self->xml_start() . $self->xml_end(); } 1; MQdb_0.954/lib/MQdb/DBStream.pm0000640007462200007660000002034211211416204017117 0ustar jessicajessica00000000000000# $Id: DBStream.pm,v 1.15 2009/06/03 06:47:32 severin Exp $ =head1 NAME MQdb::DBStream - DESCRIPTION of Object =head1 SYNOPSIS A simplified object to manage a collection of information related to streaming data from a database. at least with MYSQL, the perl driver does odd caching so to stream one needs to create a new database connection in order to stream =head1 DESCRIPTION =head1 CONTACT Jessica Severin =head1 LICENSE * Software License Agreement (BSD License) * MappedQueryDB [MQdb] toolkit * copyright (c) 2006-2009 Jessica Severin * All rights reserved. * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Jessica Severin nor the * names of its contributors may be used to endorse or promote products * derived from this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ''AS IS'' AND ANY * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE * DISCLAIMED. IN NO EVENT SHALL COPYRIGHT HOLDERS BE LIABLE FOR ANY * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. =head1 APPENDIX The rest of the documentation details each of the object methods. Internal methods are labeled. =cut my $__mqdb_dbstream_should_use_result = undef; $VERSION=0.954; package MQdb::DBStream; use strict; use MQdb::DBObject; our @ISA = qw(MQdb::DBObject); ################################################# # Class methods ################################################# sub class { return "DBStream"; } =head2 set_stream_useresult_behaviour Description : sets a global behaviour for all DBStreams. setting use_result to "on" will leave the results on the database and will keep the database connection open durring streaming. Both methods have similar speed performance, but keeping the results on the database server means the client uses essentially no memory. The risk of turning this on is that the the database connection remains open and there is risk of it timing out if processing takes a long time to stream all data. When turned off, the entire result set is transfered in bulk to the driver (DBD::mysql) and streaming happens from the underlying driver code and the perl code layer. Default is "off" since this is safer but one risks needing lots of memory on the client. Parameter[1] : 1 or "y" or "on" turns the use_result on and keeps the database connection open Returntype : none Exceptions : none Example : MQdb::DBStream->set_stream_useresult_behaviour(1); =cut sub set_stream_useresult_behaviour { my $class = shift; my $mode = shift; if(defined($mode) and (($mode == 1) or ($mode eq "y") or ($mode eq "on"))) { $__mqdb_dbstream_should_use_result = 1; } else { $__mqdb_dbstream_should_use_result = undef; } return $__mqdb_dbstream_should_use_result; } ################################################# # user API stream access methods ################################################# =head2 next_in_stream Description: gets the next object in the stream. If the stream is empty it return undef. Returntype : instance of the defined DBStream::stream_class, or undef Exceptions : none Example : my $stream = WorldKit::Person->stream_all_by_country_region($db, "USA", "wisconsin"); while(my $person = $stream->next_in_stream) { #do something } =cut sub next_in_stream { my $self = shift; return undef unless(defined($self->sth)); my $class = $self->stream_class; my $sth = $self->sth; if(my $row_hash = $sth->fetchrow_hashref) { my $obj = $class->new(); $obj = $obj->mapRow($row_hash); #required by subclass $obj->database($self->database) if($obj); return $obj; } $sth->finish; $self->{'_stream_sth'} = undef; return undef; } =head2 as_array Description: instantiates all remaining instances in the stream and returns them as an array Returntype : reference to array of instances of the defined class of this stream Exceptions : none Example : my $stream = WorldKit::Person->stream_all_by_country_region($db, "USA", "wisconsin"); my $all_people = $stream->as_array; #because I have a large memory machine and need them all in memory foreach my $person (@$all_people) { #do something } =cut sub as_array { my $self = shift; my @array; while(my $obj = $self->next_in_stream) { push @array, $obj; } return \@array; } ################################################# # attribute methods ################################################# sub init { my $self = shift; my %args = @_; $self->SUPER::init(@_); if($args{'db'}) { $self->database($args{'db'}); } if($args{'class'}) { $self->stream_class($args{'class'}); } } =head2 stream_database Description: this is an internal system method. Needs to have two database connections open, one for the active stream handle, and one for lazy-loading additional data on the returned objects. This is used to set the database which is the one streaming objects Arg (1) : $database (MQdb::Database) for setting Returntype : MQdb::Database Exceptions : none Callers : MQdb::MappedQuery =cut sub stream_database { my $self = shift; if($self->database and !defined($self->{'_stream_database'})) { $self->{'_stream_database'} = MQdb::Database->new_from_url($self->database->full_url); } return $self->{'_stream_database'}; } =head2 stream_class Description: this is an internal system method. Set/get the class used for creation of objects on this stream. The class must be a subclass of MQdb::MappedQuery Arg (1) : $class (must be subclass of MQdb::MappedQuery) for setting Returntype : a class which is a subclass of MQdb::MappedQuery Exceptions : none Callers : MQdb::MappedQuery =cut sub stream_class { my $self = shift; return $self->{'_stream_class'} = shift if(@_); return $self->{'_stream_class'}; } sub sth { my $self = shift; return $self->{'_stream_sth'}; } ################################################# # stream prepare and access methods ################################################# =head2 prepare Description: this is an internal system method. It is used to set the SQL query used to stream objects out of a database. Must be have stream_class() set to a subclass of MappedQuery which implements the mapRow() method. Returntype : $self Exceptions : none Callers : MQdb::MappedQuery =cut sub prepare { my $self = shift; my $sql = shift; my @params = @_; throw("no database defined\n") unless($self->stream_database); my $dbc = $self->stream_database->get_connection; if($__mqdb_dbstream_should_use_result) { #keeps sth open and streams results from server $self->{'_stream_sth'} = $dbc->prepare($sql, { "mysql_use_result" => 1 }); } else { #bulk transfers result to mysql driver and streams from driver cache $self->{'_stream_sth'} = $dbc->prepare($sql); } $self->{'_stream_sth'}->execute(@params); return $self; } 1; MQdb_0.954/lib/MQdb/MappedQuery.pm0000640007462200007660000003206111211416204017713 0ustar jessicajessica00000000000000# $Id: MappedQuery.pm,v 1.23 2009/06/03 06:47:32 severin Exp $ =head1 NAME MQdb::MappedQuery - DESCRIPTION of Object =head1 SYNOPSIS An Object_relational_mapping (ORM) design pattern based on mapping named_column results from any query into attributes of an object. As long as the column_names are parsable into attributes, any query is ok. This is an evolution of several ideas I have either used or created over the last 15 years of coding. This is a variation on the ActiveRecord design pattern but it trades more flexibility, power and control for slightly less automation. It still provides a development speed/ease advange over many ORM patterns. =head1 DESCRIPTION MappedQuery is an abstract superclass that is a variation on the ActiveRecord design pattern. Instead of actively mapping a table into an object, this will actively map the result of a query into an object. The query is standardized for a subclass of this object, and the columns returned by the query define the attributes of the object. This gives much more flexibility than the standard implementation of ActiveRecord. Since this design pattern is based around mapping a query (from potentially a multiple table join) to a single class object, this pattern is called MappedQuery. In this particular implementation of this design pattern (mainly due to some limitations in perl) several aspects must be hand coded as part of the implementation of a subclass. Subclasses must handcode - all accessor methods - override the mapRow method - APIs for all explicit fetch methods (by using the superclass fetch_single and fetch_multiple) - the store methods are coded by general DBI code (no framework assistance) Individual MQdb::Database handle objects are assigned at an instance level for each object. This is different from some ActiveRecord implementations which place database handles into a global context or at the Class level. By placing it with each instance, this allows creation of instances of the same class pulled from two different databases, but with similar schemas. This is very useful when building certain types of data analysis systems. The only restriction is that the database handle must be able run the queries that the object requires for it to work. Future implementations could do more automatic code generation but this version already speeds development time by 2x-3x without imposing any limitations and retains all the flexibility of handcoding with DBI. =head1 CONTACT Jessica Severin =head1 LICENSE * Software License Agreement (BSD License) * MappedQueryDB [MQdb] toolkit * copyright (c) 2006-2009 Jessica Severin * All rights reserved. * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Jessica Severin nor the * names of its contributors may be used to endorse or promote products * derived from this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ''AS IS'' AND ANY * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE * DISCLAIMED. IN NO EVENT SHALL COPYRIGHT HOLDERS BE LIABLE FOR ANY * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. =head1 APPENDIX The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _ =cut $VERSION=0.954; package MQdb::MappedQuery; use strict; use MQdb::Database; use MQdb::DBStream; use MQdb::DBObject; our @ISA = qw(MQdb::DBObject); ################################################# # Subclass must override these methods ################################################# =head2 mapRow Description: This method must be overridden by subclasses to do the mapping of columns from the query response into attributes of the object. This is part of the internal factory machinery. The instance of the class is created before this method is called and the default init() method has already been called. The purpose of this method is to initialize the rest of the state of the instance based on the $row_hash Arg (1) : $row_hash perl hash Arg (2) : optional $dbc DBI connection (not generally used by most sublcasses) Returntype : $self Exceptions : none Caller : only called by internal factory methods Example : sub mapRow { my $self = shift; my $rowHash = shift; $self->primary_id($rowHash->{'symbol_id'}); $self->type($rowHash->{'sym_type'}); $self->symbol($rowHash->{'sym_value'}); return $self; } =cut sub mapRow { my $self = shift; my $row_hash = shift; my $dbc = shift; #optional die("mapRow must be implemented by subclasses"); #should by implemented by subclass to map columns into instance variables return $self; } =head2 store Description: This method is just an empty template as part of the API definition. How it is defined, and how parameters are handled are completely up to each subclass. Each subclass should override and implement. Returntype : $self Exceptions : none Caller : general loader scripts =cut sub store { my $self = shift; die("store must be implemented by subclass"); } ################################################# # Factory methods ################################################# =head2 fetch_single Description: General purpose template method for fetching a single instance of this class(subclass) using the mapRow method to convert a row of data into an object. Arg (1) : $database (MQdb::Database) Arg (2) : $sql (string of SQL statement with place holders) Arg (3...) : optional parameters to map to the placehodlers within the SQL Returntype : instance of this Class (subclass) Exceptions : none Caller : subclasses (not public methods) Example : sub fetch_by_id { my $class = shift; my $db = shift; my $id = shift; my $sql = "SELECT * FROM symbol WHERE symbol_id=?"; return $class->fetch_single($db, $sql, $id); } =cut sub fetch_single { my $class = shift; my $db = shift; my $sql = shift; my @params = @_; die("no database defined\n") unless($db); my $dbc = $db->get_connection; my $sth = $dbc->prepare($sql, { ora_auto_lob => 0 }); $sth->execute(@params); my $obj = undef; my $row_hash = $sth->fetchrow_hashref; if($row_hash) { $obj = $class->new(); $obj->database($db); $obj = $obj->mapRow($row_hash, $dbc); #required by subclass } $sth->finish; return $obj; } =head2 fetch_multiple Description: General purpose template method for fetching an array of instance of this class(subclass) using the mapRow method to convert a row of data into an object. Arg (1) : $database (MQdb::Database) Arg (2) : $sql (string of SQL statement with place holders) Arg (3...) : optional parameters to map to the placehodlers within the SQL Returntype : array of all instances of this Class (subclass) which match the query Exceptions : none Caller : subclasses (not public methods) Example : sub fetch_all_by_value { my $class = shift; my $db = shift; my $name = shift; my $sql = "SELECT * FROM symbol WHERE sym_value=?"; return $class->fetch_multiple($db, $sql, $name); } =cut sub fetch_multiple { my $class = shift; my $db = shift; my $sql = shift; my @params = @_; die("no database defined\n") unless($db); my $obj_list = []; my $dbc = $db->get_connection; my $sth = $dbc->prepare($sql, { ora_auto_lob => 0 }); eval { $sth->execute(@params); }; if($@) { printf("ERROR with query: %s\n", $sql); printf(" params: "); foreach my $param (@params) { print("'%s' ", $param); } print("\n"); die; } while(my $row_hash = $sth->fetchrow_hashref) { my $obj = $class->new(); $obj->database($db); $obj = $obj->mapRow($row_hash, $dbc); #required by subclass push @$obj_list, $obj; } $sth->finish; return $obj_list; } =head2 stream_multiple Description: General purpose template method for fetching multiple instance of this class(subclass) using the mapRow method to convert a row of data into an object. Instead of instantiating all instance at once and returning as array, this method returns a DBStream instance which then creates each instance from an open handle on each $stream->next_in_stream() call. Arg (1) : $database (MQdb::Database) Arg (2) : $sql (string of SQL statement with place holders) Arg (3...) : optional parameters to map to the placehodlers within the SQL Returntype : DBStream object Exceptions : none Caller : subclasses use this internally when creating new API stream_by....() methods Example : sub stream_by_value { my $class = shift; my $db = shift; my $name = shift; my $sql = "SELECT * FROM symbol WHERE sym_value=?"; return $class->stream_multiple($db, $sql, $name); } =cut sub stream_multiple { my $class = shift; my $db = shift; my $sql = shift; my @params = @_; die("no database defined\n") unless($db); my $stream = new MQdb::DBStream(db=>$db, class=>$class); $stream->prepare($sql, @params); return $stream; } =head2 fetch_col_value Description: General purpose function to allow fetching of a single column from a single row. Arg (1) : $sql (string of SQL statement with place holders) Arg (2...) : optional parameters to map to the placehodlers within the SQL Example : $value = $self->fetch_col_value($db, "select symbol_id from symbol where sym_type=? and sym_value=?", $type,$value); Returntype : scalar value Exceptions : none Caller : within subclasses to easy development =cut sub fetch_col_value { my $class = shift; my $db = shift; my $sql = shift; my @params = @_; die("no database defined\n") unless($db); my $dbc = $db->get_connection; my $sth = $dbc->prepare($sql); $sth->execute(@params); my ($value) = $sth->fetchrow_array(); $sth->finish; return $value; } =head2 fetch_col_array Description: General purpose function to allow fetching of a single column from many rows into a simple array. Arg (1) : $sql (string of SQL statement with place holders) Arg (2...) : optional parameters to map to the placehodlers within the SQL Example : $array_ref = $self->fetch_col_array($db, "select some_column from my_table where source_id=?", $id); Returntype : array reference of scalar values Exceptions : none Caller : within subclasses to easy development =cut sub fetch_col_array { my $class = shift; my $db = shift; my $sql = shift; my @params = @_; my @col_array=(); die("no database defined\n") unless($db); my $dbc = $db->get_connection; my $sth = $dbc->prepare($sql); $sth->execute(@params); while(my ($value) = $sth->fetchrow_array()) { push @col_array, $value; } $sth->finish; return \@col_array; } =head2 next_sequence_id Description: Convenience method for working with SEQUENCES in ORACLE databases. Arg (1) : $sequenceName Returntype : scalar of the nextval in the sequence Exceptions : none =cut sub next_sequence_id { my $self = shift; my $sequenceName = shift; my $dbh = $self->database->get_connection; my $sql = 'select '. $sequenceName . '.nextval from sys.dual'; my $sth = $dbh->prepare($sql); $sth->execute(); my ($dbID) = $sth->fetchrow_array(); $sth->finish; #printf("incremented sequence $sequenceName id:%d\n", $dbID); return $dbID; } 1; MQdb_0.954/lib/MQdb.pm0000644007462200007660000000443011210110726015461 0ustar jessicajessica00000000000000# $Id: MQdb.pm,v 1.7 2009/05/30 01:54:30 severin Exp $ =pod =head1 NAME - MQdb =head1 DESCRIPTION MQdb.pm is a base toolkit for working with relational databases in the context of a federation of object databases. It provides some base federation support and a variation on an Object-relational-mapped template model. =head1 SUMMARY =head1 CONTACT Jessica Severin =head1 LICENSE * Software License Agreement (BSD License) * MappedQueryDB [MQdb] toolkit * copyright (c) 2006-2009 Jessica Severin * All rights reserved. * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Jessica Severin nor the * names of its contributors may be used to endorse or promote products * derived from this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ''AS IS'' AND ANY * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE * DISCLAIMED. IN NO EVENT SHALL COPYRIGHT HOLDERS BE LIABLE FOR ANY * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. =head1 APPENDIX The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _ =cut $VERSION=0.954; package MQdb; use strict; use DBI; use MQdb::Database; use MQdb::DBObject; use MQdb::DBStream; use MQdb::MappedQuery; 1; MQdb_0.954/Makefile.PL0000755007462200007660000000060411165071146015521 0ustar jessicajessica00000000000000use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'MQdb', 'VERSION_FROM' => 'lib/MQdb.pm', # finds $VERSION 'AUTHOR' => 'Jessica Severin ', 'PREREQ_PM' => { DBI => 1.51, DBD::mysql => 3.0005, DBD::SQLite => 1.14, }, ); MQdb_0.954/README0000644007462200007660000000736211211420034014416 0ustar jessicajessica00000000000000README for MQdb.pm MQdb.pm is a base toolkit for working with relational databases in the context of a federation of object databases. It provides some base federation support and a variation on an Object-relational-mapped template model. Currently it supports mysql, oracle, and sqlite. In theory it can also be used as a base object class for federation without using relational databases. Refer to the pod for full documentation and an example script, or to the following mirrors: 1/ http://search.cpan.org/perldoc?MQdb 2/ http://search.cpan.org/~jms copyright (c) 2006-2009 Jessica Severin CONTACT POINT ------------- jessica.severin@gmail.com http://search.cpan.org/~jms LICENSE ------- * Software License Agreement (BSD License) * MappedQueryDB [MQdb] system * copyright (c) 2006-2009 Jessica Severin * All rights reserved. * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of Jessica Severin nor the * names of its contributors may be used to endorse or promote products * derived from this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ''AS IS'' AND ANY * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE * DISCLAIMED. IN NO EVENT SHALL COPYRIGHT HOLDERS BE LIABLE FOR ANY * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. OVERVIEW -------- MQdb.pm is a base toolkit for working with relational databases in the context of a federation of object databases. It provides some base federation support and a variation on other Object-relational-mapped template systems. VERSION ------- 0.954 Wednesday June 3, 2009 0.953 Friday April 17, 2009 0.951 Thursday April 2, 2009 DOCUMENTATION ------------- The following documentation is available: pod in perldoc format (type perldoc MQdb::... on command line) INSTALLATION INSTRUCTIONS ------------------------- ***THERE ARE TWO WAYS TO IMPLEMENT MQdb MODULE IN PERL*** 1/ Systems with CPAN support (all Unix/Linux/BSD/Mac): ----------------------------------------------------- Install the new distribution via the Perl CPAN module: In a shell: /home/somewhere% perl -MCPAN -e"install MQdb" 2/ The hard way (requires make or nmake, tar, gunzip, and gcc): --------------------------------------------------------------- This method was tested in Irix, FreeBSD, Cygwin, debian linux, and Mac OSX Hard-headed users can directly get the distribution from First download the source. Then, in a shell: /home/somewhere% tar -xzvf MQdb-0.954.tar.gz cd MQdb-0.954 make make install KNOWN BUGS & ISSUES ------------------- none at this time. COMMENTS/FEEDBACK ----------------- Please email your feedback, comments, questions to the email address at the top of this document. I will do my best to answer promptly. Jessica Severin