package DBIx::Recordset::Playground; use strict; use warnings; use DBI; use DBIx::Recordset; require Exporter; our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use DBIx::Recordset::Playground ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); our $VERSION = sprintf '%s', q$Revision: 1.12 $ =~ /Revision:\s+(\S+)\s+/ ; # Preloaded methods go here. 1; __END__ # Below is stub documentation for your module. You'd better edit it! =head1 NAME DBIx::Recordset::Playground - working sample usages of DBIx::Recordset =head1 INTRODUCTION This document serves several purposes. One, it makes it easy to get started with DBIx::Recordset. Two, it serves as a place for those experienced with recordset to examine the code to discover how to make usage of recordset even simpler. Finally, it serves as a place for me to clarify all the areas in the original docs that were a bit confusing to me. After creating a database using L, you will be able to manipulate it using from DBIx::Recordset using the examples here. Let the games begin! =head1 Preliminaries: =head2 Our Generic Connection/Library Script This script contains our connection information and a variety of convenience subroutines. The existence of these points to how we might want to abstract Recordset usage further, once we are comfortable with the basics. # # scripts/dbconn.pl # use Data::Dumper; use DBIx::Recordset; # change to match your local connection parameters my ($dsn, $user, $pass); # mysql { last; $dsn = 'DBI:mysql:database=princepawn;host=localhost'; $user='princepawn'; $pass='money1'; } # psql $dsn = 'DBI:Pg:dbname=test;host=localhost'; my $attr= { RaiseError => 1 }; sub dbh { *DBIx::Recordset::LOG = \*STDOUT; $DBIx::Recordset::Debug = 2; my $dbh = DBI->connect($dsn, $user, $pass, $attr) or die $DBI::errstr; } sub conn_dbh { ( '!DataSource' => dbh() ); } sub author_table { ( '!Table' => 'authors' ); } sub royalty_table { ( '!Table' => 'roysched' ); } sub tblnm { ( '!Table' => shift() ) } sub print_recordset { my $glob = shift; my $set = $glob; while ( my $rec = $set->Next ) { print Dumper(\%set); } } 1; =head2 Create and Populate the Database The schema description is given in: L which is built via: perl -MDBSchema::Sample -e load =head1 LIVING CODE SAMPLES =head2 Building Where Clauses =head3 FIELD $cmp A OR FIELD $cmp B or FIELD $cmp C ... # # scripts/build-where/or-conjunct.pl # require '../dbconn.pl'; use DBIx::Recordset; use strict; use vars qw(*set); # Find all authors whose phone number is in area code 801 or 415 my @area_code = qw(801 415); *set = DBIx::Recordset -> Search ({ conn_dbh(), '!Table' => 'authors', '*phone' => 'LIKE', phone => ( join "\t", map { "$_%" } @area_code ), }); while ($set->Next) { print Dumper(\%set) } =head4 Specialization of above when A, B, C not tab separated # # scripts/build-where/or-conjunct-valuesplit.pl # require '../dbconn.pl'; use DBIx::Recordset; use strict; use vars qw(*set); # Find all authors whose zip is 94705, 94152 or 94609 my $zip = "94705 84152\t94609"; *set = DBIx::Recordset -> Search ({ conn_dbh(), '!Table' => 'authors', zip => $zip, '$valuesplit' => '\s+' }); while ($set->Next) { print Dumper(\%set) } =head2 Selecting data with where criteria in a hash # # scripts/select-using-href.pl # require 'dbconn.pl'; use DBIx::Recordset; use strict; use vars qw(*set); *set = DBIx::Recordset -> Search ({ au_lname => 'Ringer', state => 'UT', conn_dbh(), author_table() }); warn 1.0; #print Dumper(\@set); # results not fetched because FetchsizeWarn not disabled warn 1.01; $DBIx::Recordset::FetchsizeWarn = 0; print Dumper(\@set); # results are now fetched warn 1.1; print Dumper(\%set); # only print current record warn 1.2; # Here we print all $set->Reset; while ($set->Next) { print Dumper(\%set) } warn 1.3; # Here we print all in another way $set->Reset; while (my $rec = $set->Next) { print Dumper($rec); } warn 1.4; # This doesnt work either <... why?> $set->Reset; while ($set->MoreRecords) { print Dumper($set->Next); } This is useful when your have formdata in a hash for instance. =head2 Selecting data where values are in an arrayref: # # scripts/select-using-aref.pl # require 'dbconn.pl'; #use Data::Dumper; use DBIx::Recordset; use strict; use vars qw(*rs); *rs = DBIx::Recordset -> Search ({ '$where' => 'au_lname = ? and state = ?', '$values' => ['Ringer', "UT"], conn_dbh(), author_table() }); # print Dumper($rs[0]) only works if FetchsizeWarn siabled warn $rs{au_fname}; =head2 Selecting data using a full SQL query In Recordset > 0.24, one can input a full query for processing: # # scripts/select-using-query.pl # require 'dbconn.pl'; use DBIx::Recordset; use strict; use vars qw(*set); *set = DBIx::Recordset -> Search ({ '!DataSource' => dbh(), '$max' => 4, '!Query' => 'SELECT * FROM AUTHORS' }); while ($set->Next) { print Dumper(\%set) } =head2 Update # # scripts/synopsis-update.pl # require 'dbconn.pl'; #use Data::Dumper; use DBIx::Recordset; use strict; use vars qw(*rs); *rs = DBIx::Recordset -> Setup ({ conn_dbh(), author_table() }); $rs->Update ( { state => 'Utah' # SET }, { state => 'UT' # WHERE } ); # It worked. The field is truncated to 2 chars =head2 Reusing a Set Object to do Another Search: # # scripts/do-another-search.pl # require 'dbconn.pl'; use DBIx::Recordset; use vars qw(*set); *set = DBIx::Recordset -> Search ({ au_fname => 'Akiko', conn_dbh(), author_table() }); print $set{address}, $/; # Now do another search $set->Search({ au_fname => 'Sylvia' }); print $set{address}, $/; =head2 Using C =head3 Using C to Iterate over a Result Set: # # scripts/all-users-with.pl # require 'dbconn.pl'; use DBIx::Recordset; use strict; use vars qw(*set); my %where = (title_id => 'MC3026'); *set = DBIx::Recordset -> Search ({ %where, conn_dbh(), royalty_table() }); while (my $rec = $set->Next) { print $rec->{royalty}, $/; } =head3 Using C but Using the Implicitly Bound Hash: # # scripts/using-implicit-hash.pl # require 'dbconn.pl'; use DBIx::Recordset; use strict; use vars qw(*set); my %where = (title_id => 'MC3026'); *set = DBIx::Recordset -> Search ({ %where, conn_dbh(), royalty_table() }); while ($set->Next) { print $set{royalty}, $/; } =head2 Filtering Data on Input/Output to/from Database # # scripts/filter-authors.pl # require 'dbconn.pl'; use DBIx::Recordset; use strict; use vars qw(*set); *set = DBIx::Recordset -> Search ({ conn_dbh(), author_table(), '$max' => 10, '!Filter' => { DBI::SQL_VARCHAR => [ undef, # no input filtering sub { uc (shift()) } ] } }); while ($set->Next) { print Dumper(\%set) } =head2 Tying a Table to a Hash for Easy Lookup by Primary Key # # scripts/hash-as-row-key.pl # require 'dbconn.pl'; use DBIx::Recordset; use strict; use vars qw(*set); *set = DBIx::Recordset -> Setup ({ conn_dbh(), '!Table' => 'authors', '!HashAsRowKey' => 1, '!PrimKey' => 'au_id' }); my @au_id = qw( 409-56-7008 213-46-8915 998-72-3567 ); warn Dumper($set{$_}) for @au_id; =head2 Tying Hashes with Expirable Caches to Databases L allows you to tie a hash to a database table, and retrieve the records of the table via the hash's key. You can tie the entire table or create an expirable "view" of a subset of the table via Recordset's C option. Your view can be expired based on a fixed amount of seconds or via a boolean subroutine which accepts the (tied hash via a scalar?) as an argument. # # scripts/prefetch-expire.pl # #!/usr/bin/perl require 'dbconn.pl'; use DBIx::Recordset; use strict; # This program repeatedly presents sales data on STDOUT, refreshing # the view every $view_refresh seconds. It refreshes its # model (from the database) every $model_refresh seconds. # The default values for $model_refresh and $view_refresh imply that # the model will refreshed after 2.6 view refreshes or practically speaking # on every 3rd view refresh. # You can verify that it makes new hits on the database by noting the # DBIx::Recordset log messages. You will see this after every 3 view # displays: # DB: 'SELECT * FROM sales ORDER BY sonum DESC LIMIT 6' bind_values=<> bind_types=<> # To spice things up, you can open a different terminal window and run # prefetch-insert.pl, which will insert a new record into the sales table # every $x seconds. # This program requires a version of DBIx::Recordset > 0.24, which is the # current CPAN release. Or you can apply the patch recently posted to # the embperl@perl.apache.org mailing list. my $model_refresh = 13; my $view_refresh = 5; use vars qw(%sales); tie %sales, 'DBIx::Recordset::Hash', { conn_dbh(), '!Table' => 'sales', '!PreFetch' => { '$max' => 5, '$order' => 'sonum DESC' }, '!PrimKey' => 'sonum', '!Expires' => $model_refresh }; sub bynumber { $a <=> $b } while (1) { my (@key) = keys %sales; print $sales{$_}{sonum}, $/ for sort bynumber @key; sleep $view_refresh; print $/; } # # scripts/prefetch-insert.pl # require 'dbconn.pl'; use DBIx::Recordset; use strict; # This program takes one argument, an integer indicating how often it should # insert a random record into the sales table. my $insert_frequency = shift or die 'must specify insert frequency'; use vars qw(*set); sub rand_ponum { sprintf "%s%d%s", chr(65 + rand 25), rand 400 + rand 1000, lc chr(65 + rand 25); } *set = DBIx::Recordset->Search ({ conn_dbh(), '!Table' => 'sales', '!Fields' => 'max(sonum) as max_id', }); my $max_id = $set{max_id}; while (1) { DBIx::Recordset->Insert ( { conn_dbh(), '!Table' => 'sales', sonum => ++$max_id, stor_id => (sprintf "%d", 7000 + rand 1000), ponum => rand_ponum, sdate => '2003-10-22' } ); sleep $insert_frequency; } =head1 Most functions which set up an object return a B. A typeglob in Perl is an object which holds pointers to all datatypes with the same name. Therefore a typeglob must always have a name and B be declared with B. You can only use it as B (package) variable or declare it with B. The trick for using a typglob is that setup functions can return a B, an B and a B at the same time. B<... concerns about package variables and mod_perl ...> However, most if not all Recordset functionality is useable from the object alone, thus it suffices to setup the object by returning a reference into a lexical or package-scoped scalar. =head1 ARGUMENTS NOTE 1: Fieldnames specified with !Order can't be overridden. If you plan to use other fields with this object later, use $order instead. B<... of course the question being how to do ascending and descending> =head1 WORKING WITH MULTIPLE TABLES =item B Condition which describes the relation between the given tables (e.g. tab1.id = tab2.id) (See also L.) Let's look at a query and it's results: mysql> select title_id,ponum from sales, salesdetails where sales.sonum=salesdetails.sonum and qty_ordered=15; +----------+----------+ | title_id | ponum | +----------+----------+ | MC3021 | 423LL922 | | BU7832 | QQ2299 | | PS3333 | P3087a | +----------+----------+ Or in English: What was the title and purchase order number for all sales whose order quantity was 15. Now let's see it rendered in Recordset: # # scripts/join-tabrelation.pl # require 'dbconn.pl'; use DBIx::Recordset; use vars qw(*set); *set = DBIx::Recordset -> Search ({ '!TabRelation' => 'sales.sonum = salesdetails.sonum', 'qty_ordered' => 15, '$fields' => 'title_id,ponum', conn_dbh(), tblnm('sales,salesdetails') }); while ( $set->Next) { print join "\t", $set{title_id}, $set{ponum}, $/; } =item B !TabJoin allows you to specify an B which is used in a B