File Coverage

blib/lib/DBIx/SQLEngine/Driver.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             DBIx::SQLEngine::Driver - DBI Wrapper with Driver Subclasses
4              
5             =head1 SYNOPSIS
6              
7             B: Adds methods to a DBI database handle.
8              
9             $sqldb = DBIx::SQLEngine->new( $dbi_dsn, $dbi_user, $dbi_passwd );
10             $sqldb = DBIx::SQLEngine->new( $dbh ); # or use your existing handle
11              
12             $dbh = $sqldb->get_dbh(); # get the wraped DBI dbh
13             $sth = $sqldb->prepare($statement); # or just call any dbh method
14              
15             B Prepare and fetch in one call.
16              
17             $row_count = $sqldb->try_query($sql, \@params, 'get_execute_rowcount');
18             $array_ary = $sqldb->try_query($sql, \@params, 'fetchall_arrayref');
19             $hash_ary = $sqldb->try_query($sql, \@params, 'fetchall_hashref');
20              
21             B SQL generation with flexible arguments.
22              
23             $hash_ary = $sqldb->fetch_select(
24             table => 'students', where => { 'status'=>'minor' },
25             );
26            
27             $sqldb->do_insert(
28             table => 'students',
29             values => { 'name'=>'Dave', 'age'=>'19', 'status'=>'minor' },
30             );
31            
32             $sqldb->do_update(
33             table => 'students', where => 'age > 20',
34             values => { 'status'=>'adult' },
35             );
36            
37             $sqldb->do_delete(
38             table => 'students', where => { 'name'=>'Dave' },
39             );
40              
41             B Pre-define connections and queries.
42              
43             DBIx::SQLEngine->define_named_connections(
44             'test' => 'dbi:AnyData:test',
45             'production' => [ 'dbi:Mysql:our_data:dbhost', 'user', 'passwd' ],
46             );
47              
48             DBIx::SQLEngine->define_named_queries(
49             'all_students' => 'select * from students',
50             'delete_student' => [ 'delete * from students where id = ?', \$1 ],
51             );
52              
53             $sqldb = DBIx::SQLEngine->new( 'test' );
54              
55             $hash_ary = $sqldb->fetch_named_query( 'all_students' );
56              
57             $rowcount = $sqldb->do_named_query( 'delete_student', $my_id );
58              
59             B Uses driver's idioms or emulation.
60              
61             $hash_ary = $sqldb->fetch_select( # uses database's limit syntax
62             table => 'students', order => 'last_name, first_name',
63             limit => 20, offset => 100,
64             );
65            
66             $hash_ary = $sqldb->fetch_select( # use "join on" or merge with "where"
67             table => ['students'=>{'students.id'=>\'grades.student'}=>'grades'],
68             where => { 'academic_year'=>'2004' },
69             );
70            
71             $hash_ary = $sqldb->fetch_select( # combines multiple query results
72             union => [ { table=>'students', columns=>'first_name, last_name' },
73             { table=>'staff', columns=>'name_f, name_l' } ],
74             );
75              
76             $sqldb->do_insert( # use auto_increment/sequence column
77             table => 'students', sequence => 'id',
78             values => { 'name'=>'Dave', 'age'=>'19', 'status'=>'minor' },
79             );
80              
81              
82             =head1 DESCRIPTION
83              
84             DBIx::SQLEngine::Driver objects are wrappers around DBI database handles which
85             add methods that support ad-hoc SQL generation and query execution in a single
86             call. Dynamic subclassing based on database server type enables cross-platform
87             portability.
88              
89             For more information about this framework, see L.
90              
91             =cut
92              
93             ########################################################################
94              
95             =head2 Driver Subclasses
96              
97             The only methods that are actually provided by the DBIx::SQLEngine::Driver
98             package itself are the constructors like new(). All of the other
99             methods described here are defined in DBIx::SQLEngine::Driver::Default,
100             or in one of its automatically-loaded subclasses.
101              
102             After setting up the DBI handle that it will use, the SQLEngine is reblessed
103             into a matching subclass, if one is available. Thus, if you connect a
104             DBIx::SQLEngine through DBD::mysql, by passing a DSN such as "dbi:mysql:test",
105             your object will automatically shift to being an instance of the
106             DBIx::SQLEngine::Driver::Mysql class. This allows the driver-specific
107             subclasses to compensate for differences in the SQL dialect or execution
108             ideosyncracies of that platform.
109              
110             This release includes the following driver subclasses, which support the listed database platforms:
111              
112             =over 10
113              
114             =item Mysql
115              
116             MySQL via DBD::mysql or DBD::ODBC (Free RDBMS)
117              
118             =item Pg
119              
120             PostgreSQL via DBD::Pg or DBD::ODBC (Free RDBMS)
121              
122             =item Oracle
123              
124             Oracle via DBD::Oracle or DBD::ODBC (Commercial RDBMS)
125              
126             =item Sybase
127              
128             Sybase via DBD::Sybase or DBD::ODBC (Commercial RDBMS)
129              
130             =item Informix
131              
132             Informix via DBD::Informix or DBD::ODBC (Commercial RDBMS)
133              
134             =item MSSQL
135              
136             Microsoft SQL Server via DBD::ODBC (Commercial RDBMS)
137              
138             =item Sybase::MSSQL
139              
140             Microsoft SQL Server via DBD::Sybase and FreeTDS libraries
141              
142             =item SQLite
143              
144             SQLite via DBD::SQLite (Free Package)
145              
146             =item AnyData
147              
148             AnyData via DBD::AnyData (Free Package)
149              
150             =item CSV
151              
152             CSV files via DBD::CSV (Free Package)
153              
154             =back
155              
156             To understand which SQLEngine driver class will be used for a given database
157             connection, see the discussion of driver and class names in L.
158              
159             The public interface of described below is shared by all of the driver
160             subclasses. The superclass methods aim to produce and perform generic queries
161             in an database-independent fashion, using standard SQL syntax. Subclasses may
162             override these methods to compensate for idiosyncrasies of their database
163             server or mechanism. To facilitate cross-platform subclassing, many of these
164             methods are implemented by calling combinations of other methods, which may
165             individually be overridden by subclasses.
166              
167             =cut
168              
169             ########################################################################
170              
171             package DBIx::SQLEngine::Driver;
172              
173 12     12   76 use strict;
  12         23  
  12         528  
174              
175 12     12   31233 use DBI;
  12         292923  
  12         1066  
176 12     12   32870 use DBIx::AnyDBD;
  0            
  0            
177             use Class::MakeMethods;
178              
179             ########################################################################
180              
181             ########################################################################
182              
183             =head1 DRIVER INSTANTIATION
184              
185             These methods allow the creation of SQLEngine Driver objects connected to your databases.
186              
187             =head2 Driver Object Creation
188              
189             Create one SQLEngine Driver for each DBI datasource you will use.
190              
191             B Call the new() method to create a Driver object with associated DBI database handle.
192              
193             =over 4
194              
195             =item new()
196              
197             DBIx::SQLEngine->new( $dsn ) : $sqldb
198             DBIx::SQLEngine->new( $dsn, $user, $pass ) : $sqldb
199             DBIx::SQLEngine->new( $dsn, $user, $pass, $args ) : $sqldb
200             DBIx::SQLEngine->new( $dbh ) : $sqldb
201             DBIx::SQLEngine->new( $cnxn_name ) : $sqldb
202             DBIx::SQLEngine->new( $cnxn_name, @params ) : $sqldb
203              
204             Based on the arguments supplied, invokes one of the below new_with_* methods and returns the resulting new object.
205              
206             =back
207              
208             B These methods are called internally by new().
209              
210             =over 4
211              
212             =item new_with_connect()
213              
214             DBIx::SQLEngine::Driver->new_with_connect( $dsn ) : $sqldb
215             DBIx::SQLEngine::Driver->new_with_connect( $dsn, $user, $pass ) : $sqldb
216             DBIx::SQLEngine::Driver->new_with_connect( $dsn, $user, $pass, $args ) : $sqldb
217              
218             Accepts the same arguments as the standard DBI connect method.
219              
220             =item new_with_dbh()
221              
222             DBIx::SQLEngine::Driver->new_with_dbh( $dbh ) : $sqldb
223              
224             Accepts an existing DBI database handle and creates a new Driver object around it.
225              
226             =item new_with_name()
227              
228             DBIx::SQLEngine::Driver->new_with_name( $cnxn_name ) : $sqldb
229             DBIx::SQLEngine::Driver->new_with_name( $cnxn_name, @params ) : $sqldb
230              
231             Passes the provided arguments to interpret_named_connection, defined below, and uses its results to make a new connection.
232              
233             =back
234              
235             =cut
236              
237             sub new {
238             my $class = shift;
239             ref( $_[0] ) ? $class->new_with_dbh( @_ ) :
240             $class->named_connections( $_[0] ) ? $class->new_with_name( @_ ) :
241             $class->new_with_connect( @_ )
242             }
243              
244             sub new_with_connect {
245             my ($class, $dsn, $user, $pass, $args) = @_;
246             $args ||= { AutoCommit => 1, PrintError => 0, RaiseError => 1 };
247             DBIx::SQLEngine::Driver::Default->log_connect( $dsn )
248             if DBIx::SQLEngine::Driver::Default->DBILogging;
249             my $self = DBIx::AnyDBD->connect($dsn, $user, $pass, $args,
250             'DBIx::SQLEngine::Driver');
251             return undef unless $self;
252             $self->{'reconnector'} = sub { DBI->connect($dsn, $user, $pass, $args) };
253             return $self;
254             }
255              
256             sub new_with_dbh {
257             my ($class, $dbh) = @_;
258             my $self = bless { 'package' => 'DBIx::SQLEngine::Driver', 'dbh' => $dbh }, 'DBIx::AnyDBD';
259             $self->rebless;
260             $self->_init if $self->can('_init');
261             return $self;
262             }
263              
264             sub new_with_name {
265             my ($class, $name, @args) = @_;
266             $class->new( $class->interpret_named_connection( $name, @args ) );
267             }
268              
269             ########################################################################
270              
271             =head2 Named Connections
272              
273             The following methods maanage a collection of named connection parameters.
274              
275             B Call these methods to define connections.
276              
277             =over 4
278              
279             =item define_named_connections()
280              
281             DBIx::SQLEngine->define_named_connections( $name, $cnxn_info )
282             DBIx::SQLEngine->define_named_connections( %names_and_info )
283              
284             Defines one or more named connections using the names and definitions provided.
285              
286             The definition for each connection is expected to be in one of the following formats:
287              
288             =over 4
289              
290             =item *
291              
292             A DSN string which will be passed to a DBI->connect call.
293              
294             =item *
295              
296             A reference to an array of a DSN string, and optionally, a user name and password. Items which should later be replaced by per-connection parameters can be represented by references to the special Perl variables $1, $2, $3, and so forth, corresponding to the order and number of parameters to be supplied.
297              
298             =item *
299              
300             A reference to a subroutine or code block which will process the user-supplied arguments and return a connected DBI database handle or a list of connection arguments.
301              
302             =back
303              
304             =item define_named_connections_from_text()
305              
306             DBIx::SQLEngine->define_named_connections_from_text($name, $cnxn_info_text)
307             DBIx::SQLEngine->define_named_connections_from_text(%names_and_info_text)
308              
309             Defines one or more connections, using some special processing to facilitate storing dynamic connection definitions in an external source such as a text file or database table.
310              
311             The interpretation of each definition is determined by its first non-whitespace character:
312              
313             =over 4
314              
315             =item *
316              
317             Definitions which begin with a [ character are presumed to contain an array definition and are evaluated immediately.
318              
319             =item *
320              
321             Definitions which begin with a " or ; character are presumed to contain a code definition and evaluated as the contents of an anonymous subroutine.
322              
323             =item *
324              
325             Other definitions are assumed to contain a plain string DSN.
326              
327             =back
328              
329             All evaluations are done via a Safe compartment, which is required when this function is first used, so the code is fairly limited in terms of what actions it can perform.
330              
331             =back
332              
333             B The following methods are called internally by new_with_name().
334              
335             =over 4
336              
337             =item named_connections()
338              
339             DBIx::SQLEngine::Driver->named_connections() : %names_and_info
340             DBIx::SQLEngine::Driver->named_connections( $name ) : $cnxn_info
341             DBIx::SQLEngine::Driver->named_connections( \@names ) : @cnxn_info
342             DBIx::SQLEngine::Driver->named_connections( $name, $cnxn_info, ... )
343             DBIx::SQLEngine::Driver->named_connections( \%names_and_info )
344              
345             Accessor and mutator for a class-wide hash mappping connection names to their definitions. Used internally by the other named_connection methods.
346              
347             =item named_connection()
348              
349             DBIx::SQLEngine::Driver->named_connection( $name ) : $cnxn_info
350              
351             Retrieves the connection definition matching the name provided. Croaks if no connection has been defined for that name. Used interally by the interpret_named_connection method.
352              
353             =item interpret_named_connection()
354              
355             DBIx::SQLEngine::Driver->interpret_named_connection($name, @params) : $dbh
356             DBIx::SQLEngine::Driver->interpret_named_connection($name, @params) : $dsn
357             DBIx::SQLEngine::Driver->interpret_named_connection($name, @params) : @args
358              
359             Combines the connection definition matching the name provided with the following arguments and returns the resulting connection arguments. Croaks if no connection has been defined for that name.
360              
361             Depending on the definition associated with the name, it is combined with the provided parameters in one the following ways:
362              
363             =over 4
364              
365             =item *
366              
367             A string. Any connection parameters are assumed to be the user name and password, and are simply appended and returned.
368              
369             =item *
370              
371             A reference to an array, possibly with embedded placeholders in the C<\$1> style described above. Uses clone_with_parameters() to make and return a copy of the array, substituting the connection parameters in place of the placeholder references. An exception is thrown if the number of parameters provided does not match the number of special variables referred to.
372              
373             =item *
374              
375             A reference to a subroutine. The connection parameters are passed
376             along to the subroutine and its results returned for execution.
377              
378             =back
379              
380             For more information about the parameter replacement and argument count checking, see the clone_with_parameters() function from L.
381              
382             =back
383              
384             B These samples demonstrate use of the named_connections feature.
385              
386             =over 2
387              
388             =item *
389              
390             Here's a simple definition with a DSN string:
391              
392             DBIx::SQLEngine->define_named_connections('test'=>'dbi:mysql:test');
393              
394             $sqldb = DBIx::SQLEngine->new( 'test' );
395              
396             =item *
397              
398             Here's an example that includes a user name and password:
399              
400             DBIx::SQLEngine->define_named_connections(
401             'reference' => [ 'dbi:mysql:livedata', 'myuser', 'mypasswd' ],
402             );
403              
404             $sqldb = DBIx::SQLEngine->new( 'reference' );
405              
406             =item *
407              
408             Here's a definition that requires a user name and password to be provided:
409              
410             DBIx::SQLEngine->define_named_connections(
411             'production' => [ 'dbi:mysql:livedata', \$1, \$2 ],
412             );
413              
414             $sqldb = DBIx::SQLEngine->new( 'production', $user, $password );
415              
416             =item *
417              
418             Here's a definition using Perl code to set up the connection arguments:
419              
420             DBIx::SQLEngine->define_named_connections(
421             'finance' => sub { "dbi:oracle:accounting", "bob", "123" },
422             );
423              
424             $sqldb = DBIx::SQLEngine->new( 'finance' );
425              
426             =item *
427              
428             Connection names are interpreted recursively, allowing them to be used as aliases:
429              
430             DBIx::SQLEngine->define_named_connections(
431             'test' => 'dbi:AnyData:test',
432             'production' => 'dbi:Mysql:our_data:dbhost',
433             );
434              
435             DBIx::SQLEngine->define_named_connections(
436             '-active' => 'production',
437             );
438              
439             $sqldb = DBIx::SQLEngine->new( '-active' );
440              
441             =item *
442              
443             You can also use named connecctions to hijack regular connections:
444              
445             DBIx::SQLEngine->define_named_connections(
446             'dbi:Mysql:students:db_host' => 'dbi:AnyData:test',
447             );
448            
449             $sqldb = DBIx::SQLEngine->new( 'dbi:Mysql:students:db_host' );
450              
451             =item *
452              
453             Connection definitions can be stored in external text files or other sources and then evaluated into data structures or code references. The below code loads a simple text file of query definitions
454              
455             open( CNXNS, '/path/to/my/connections' );
456             %cnxn_info = map { split /\:\s*/, $_, 2 } grep { /^[^#]/ } ;
457             close CNXNS;
458              
459             $sqldb->define_named_connections_from_text( %cnxn_info );
460              
461             Placing the following text in the target file will define all of the connections used above:
462              
463             # Simple DSN that doesn't need any parameters
464             test: dbi:mysql:test
465            
466             # Definition that includes a user name and password
467             reference: [ 'dbi:mysql:livedata', 'myuser', 'mypasswd' ]
468            
469             # Definition that requires a user name and password
470             production: [ 'dbi:mysql:livedata', \$1, \$2 ]
471              
472             # Definition using Perl code to set up the connection arguments
473             finance: "dbi:oracle:accounting", "bob", "123"
474              
475             =back
476              
477             =cut
478              
479             use Class::MakeMethods ( 'Standard::Global:hash' => 'named_connections' );
480              
481             use DBIx::SQLEngine::Utility::CloneWithParams ':all';
482              
483             # $cnxn_def = DBIx::SQLEngine::Driver->named_connection( $name )
484             sub named_connection {
485             my ( $self, $name ) = @_;
486             $self->named_connections( $name ) or croak("No connection named '$name'");
487             }
488              
489             # ($dsn) = DBIx::SQLEngine::Driver->interpret_named_connection($name, @args)
490             # ($dsn, $user, $pass) = DBIx::SQLEngine::Driver->interpret_named_connection(...)
491             # ($dsn, $user, $pass, $opts) = DBIx::SQLEngine::Driver->interpret_named_connection(...)
492             sub interpret_named_connection {
493             my ( $self, $name, @cnxn_args ) = @_;
494             my $cnxn_def = $self->named_connection( $name );
495             if ( ! $cnxn_def ) {
496             croak("No definition was provided for named connection '$name': $cnxn_def")
497             } elsif ( ! ref $cnxn_def ) {
498             return ( $cnxn_def, @cnxn_args );
499             } elsif ( ref($cnxn_def) eq 'ARRAY' ) {
500             return ( @{ clone_with_parameters($cnxn_def, @cnxn_args) } );
501             } elsif ( ref($cnxn_def) eq 'CODE' ) {
502             my @results = $cnxn_def->( @cnxn_args );
503             unshift @results, 'sql' if scalar(@results) == 1;
504             return @results;
505             } else {
506             croak("Unable to interpret definition of named connection '$name': $cnxn_def")
507             }
508             }
509              
510             # DBIx::SQLEngine::Driver->define_named_connections( $name, $string_hash_or_sub, ... )
511             sub define_named_connections {
512             my $self = shift;
513             while ( scalar @_ ) {
514             $self->named_connections( splice( @_, 0, 2 ) )
515             }
516             }
517             sub define_named_connection { (shift)->define_named_connections(@_) }
518              
519             # DBIx::SQLEngine::Driver->define_named_connections_from_text( $name, $string )
520             sub define_named_connections_from_text {
521             my $self = shift;
522             while ( scalar @_ ) {
523             my ( $name, $text ) = splice( @_, 0, 2 );
524             my $cnxn_def = do {
525             if ( $text =~ /^\s*[\[|\{]/ ) {
526             safe_eval_with_parameters( $text );
527             } elsif ( $text =~ /^\s*[\"|\;]/ ) {
528             safe_eval_with_parameters( "sub { $text }" );
529             } else {
530             $text
531             }
532             };
533             $self->define_named_connection( $name, $cnxn_def );
534             }
535             }
536              
537             ########################################################################
538              
539             # Provide aliases for methods that might be called on the factory class
540             foreach my $method ( qw/ DBILogging SQLLogging
541             named_queries define_named_queries define_named_queries_from_text / ) {
542             no strict 'refs';
543             *{$method} = sub { shift; DBIx::SQLEngine::Driver::Default->$method( @_ ) }
544             }
545              
546             ########################################################################
547              
548             ########################################################################
549              
550             # Set up default driver package and ensure that we don't try to require it later
551             package DBIx::SQLEngine::Driver::Default;
552              
553             BEGIN { $INC{'DBIx/SQLEngine/Driver.pm'} = __FILE__ }
554             BEGIN { $INC{'DBIx/SQLEngine/Driver/Default.pm'} = __FILE__ }
555              
556             use strict;
557             use Carp;
558             use DBI;
559              
560             use DBIx::SQLEngine::Utility::CloneWithParams ':all';
561              
562             ########################################################################
563              
564             ########################################################################
565              
566             =head1 FETCHING DATA (SQL DQL)
567              
568             Information is obtained from a DBI database through the Data Query Language features of SQL.
569              
570             =head2 Select to Retrieve Data
571              
572             The following methods may be used to retrieve data using SQL select statements. They all accept a flexible set of key-value arguments describing the query to be run, as described in the "SQL Select Clauses" section below.
573              
574             B There are several ways to retrieve information from a SELECT query.
575              
576             The fetch_* methods select and return matching rows.
577              
578             =over 4
579              
580             =item fetch_select()
581              
582             $sqldb->fetch_select( %sql_clauses ) : $row_hashes
583             $sqldb->fetch_select( %sql_clauses ) : ($row_hashes, $column_hashes)
584              
585             Retrieve rows from the datasource as an array of hashrefs. If called in a list context, also returns an array of hashrefs containing information about the columns included in the result set.
586              
587             =item fetch_select_rows()
588              
589             $sqldb->fetch_select_rows( %sql_clauses ) : $row_arrays
590             $sqldb->fetch_select_rows( %sql_clauses ) : ($row_arrays, $column_hashes)
591              
592             Like fetch_select, but returns an array of arrayrefs, rather than hashrefs.
593              
594             =item fetch_one_row()
595              
596             $sqldb->fetch_one_row( %sql_clauses ) : $row_hash
597              
598             Calls fetch_select, then returns only the first row of results.
599              
600             =item fetch_one_value()
601              
602             $sqldb->fetch_one_value( %sql_clauses ) : $scalar
603              
604             Calls fetch_select, then returns the first value from the first row of results.
605              
606             =back
607              
608             The visit_* and fetchsub_* methods allow you to loop through the returned records without necessarily loading them all into memory at once.
609              
610             =over 4
611              
612             =item visit_select()
613              
614             $sqldb->visit_select( $code_ref, %sql_clauses ) : @results
615             $sqldb->visit_select( %sql_clauses, $code_ref ) : @results
616              
617             Retrieve rows from the datasource as a series of hashrefs, and call the user provided function for each one. For your convenience, will accept a coderef as either the first or the last argument. Returns the results returned by each of those function calls. Processing with visit_select rather than fetch_select can be more efficient if you are looping over a large number of rows and do not need to keep them all in memory.
618              
619             Note that some DBI drivers do not support simultaneous use of more than one statement handle; if you are using such a driver, you will receive an error if you run another query from within your code reference.
620              
621             =item visit_select_rows()
622              
623             $sqldb->visit_select_rows( $code_ref, %sql_clauses ) : @results
624             $sqldb->visit_select_rows( %sql_clauses, $code_ref ) : @results
625              
626             Like visit_select, but for each row the code ref is called with the current row retrieved as a list of values, rather than a hash ref.
627              
628             =item fetchsub_select()
629              
630             $self->fetchsub_select( %clauses ) : $coderef
631              
632             Execute a query and returns a code reference that can be called repeatedly to retrieve a row as a hashref. When all of the rows have been fetched it will return undef.
633              
634             The code reference is blessed so that when it goes out of scope and is destroyed it can call the statement handle's finish() method.
635              
636             Note that some DBI drivers do not support simultaneous use of more than one statement handle; if you are using such a driver, you will receive an error if you run another query while this code reference is still in scope.
637              
638             =item fetchsub_select_rows()
639              
640             $self->fetchsub_select_rows( %clauses ) : $coderef
641              
642             Like fetchsub_select, but for each row returns a list of values, rather than a hash ref. When all of the rows have been fetched it will return an empty list.
643              
644             =back
645              
646             B: The above select methods accept a hash describing the clauses of the SQL statement they are to generate, using the values provided for the keys defined below.
647              
648             =over 4
649              
650             =item 'sql'
651              
652             May contain a plain SQL statement to be executed, or a reference to an array of a SQL statement followed by parameters for embedded placeholders. Can not be used in combination with the table and columns arguments.
653              
654             =item 'named_query'
655              
656             Uses the named_query catalog to build the query. May contain a defined query name, or a reference to an array of a query name followed by parameters to be handled by interpret_named_query. See L for details.
657              
658             =item 'union'
659              
660             Calls sql_union() to produce a query that combines the results of multiple calls to sql_select(). Should contain a reference to an array of hash-refs, each of which contains key-value pairs to be used in one of the unified selects. Can not be used in combination with the table and columns arguments.
661              
662             =item 'table' I 'tables'
663              
664             The name of the tables to select from. Required unless one of the above parameters is provided. May contain a string with one or more table names, or a reference to an array or hash of table names and join criteria. See the sql_join() method for details.
665              
666             =item 'columns'
667              
668             Optional; defaults to '*'. May contain a comma-separated string of column names, or an reference to an array of column names, or a reference to a hash mapping column names to "as" aliases, or a reference to an object with a "column_names" method.
669              
670             =item 'distinct'
671              
672             Optional. Boolean. Adds the "distinct" keyword to the query if value is true.
673              
674             =item 'where' I 'criteria'
675              
676             Optional. May contain a literal SQL where clause, an array ref with a SQL clause and parameter list, a hash of field => value pairs, or an object that supports a sql_where() method. See the sql_where() method for details.
677              
678             =item 'group'
679              
680             Optional. May contain a comma-separated string of column names or experessions, or an reference to an array of the same.
681              
682             =item 'order'
683              
684             Optional. May contain a comma-separated string of column names or experessions, optionally followed by "DESC", or an reference to an array of the same.
685              
686             =item 'limit'
687              
688             Optional. Maximum number of rows to be retrieved from the server. Relies on DBMS-specific behavior provided by sql_limit().
689              
690             =item 'offset'
691              
692             Optional. Number of rows at the start of the result which should be skipped over. Relies on DBMS-specific behavior provided by sql_limit().
693              
694             =back
695              
696             B These samples demonstrate use of the select features.
697              
698             =over 2
699              
700             =item *
701              
702             Each query can be written out explicitly or generated on demand using whichever syntax is most appropriate to your application; the following examples are functionally equivalent:
703              
704             $hashes = $sqldb->fetch_select(
705             sql => "select * from students where status = 'minor'"
706             );
707              
708             $hashes = $sqldb->fetch_select(
709             sql => [ 'select * from students where status = ?', 'minor' ]
710             );
711              
712             $hashes = $sqldb->fetch_select(
713             sql => 'select * from students', where => { 'status' => 'minor' }
714             );
715              
716             $hashes = $sqldb->fetch_select(
717             table => 'students', where => [ 'status = ?', 'minor' ]
718             );
719              
720             $hashes = $sqldb->fetch_select(
721             table => 'students', where => { 'status' => 'minor' }
722             );
723              
724             $hashes = $sqldb->fetch_select(
725             table => 'students', where =>
726             DBIx::SQLEngine::Criteria->type_new('Equality','status'=>'minor')
727             );
728              
729             =item *
730              
731             Both generated and explicit SQL can be stored as named queries and then used again later; the following examples are equivalent to those above:
732              
733             $sqldb->define_named_query(
734             'minor_students' => "select * from students where status = 'minor'"
735             );
736             $hashes = $sqldb->fetch_select(
737             named_query => 'minor_students'
738             );
739              
740             $sqldb->define_named_query(
741             'minor_students' => {
742             table => 'students', where => { 'status' => 'minor' }
743             }
744             );
745             $hashes = $sqldb->fetch_select(
746             named_query => 'minor_students'
747             );
748              
749             =item *
750              
751             Here's a use of some optional clauses listing the columns returned, and specifying a sort order:
752              
753             $hashes = $sqldb->fetch_select(
754             table => 'students', columns => 'name, age', order => 'name'
755             );
756              
757             =item *
758              
759             Here's a where clause that uses a function to find the youngest people; note the use of a backslash to indicate that "min(age)" is an expression to be evaluated by the database server, rather than a literal value:
760              
761             $hashes = $sqldb->fetch_select(
762             table => 'students', where => { 'age' => \"min(age)" }
763             );
764              
765             =item *
766              
767             If you know that only one row will match, you can use fetch_one_row:
768              
769             $joe = $sqldb->fetch_one_row(
770             table => 'student', where => { 'id' => 201 }
771             );
772              
773             All of the SQL select clauses are accepted, including explicit SQL statements with parameters:
774              
775             $joe = $sqldb->fetch_one_row(
776             sql => [ 'select * from students where id = ?', 201 ]
777             );
778              
779             =item *
780              
781             And when you know that there will only be one row and one column in your result set, you can use fetch_one_value:
782              
783             $count = $sqldb->fetch_one_value(
784             table => 'student', columns => 'count(*)'
785             );
786              
787             All of the SQL select clauses are accepted, including explicit SQL statements with parameters:
788              
789             $maxid = $sqldb->fetch_one_value(
790             sql => [ 'select max(id) from students where status = ?', 'minor' ]
791             );
792              
793             =item *
794              
795             You can use visit_select to make a traversal of all rows that match a query without retrieving them all at once:
796              
797             $sqldb->visit_select(
798             table => 'student',
799             sub {
800             my $student = shift;
801             print $student->{id}, $student->{name}, $student->{age};
802             }
803             );
804              
805             You can collect values along the way:
806              
807             my @firstnames = $sqldb->visit_select(
808             table => 'student',
809             sub {
810             my $student = shift;
811             ( $student->{name} =~ /(\w+)\s/ ) ? $1 : $student->{name};
812             }
813             );
814              
815             You can visit with any combination of the other clauses supported by fetch_select:
816              
817             $sqldb->visit_select(
818             table => 'student',
819             columns => 'id, name',
820             order => 'name, id desc',
821             where => 'age < 22',
822             sub {
823             my $student = shift;
824             print $student->{id}, $student->{name};
825             }
826             );
827              
828             =item *
829              
830             You can use fetchsub_select to make a traversal of some or all rows without retrieving them all at once:
831              
832             my $fetchsub = $sqldb->fetchsub_select(
833             table => 'student',
834             where => 'age < 22',
835             );
836             while ( my $student = $fetchsub->() ) {
837             print $student->{id}, $student->{name}, $student->{age};
838             }
839              
840             You can use fetchsub_select_rows to treat each row as a list of values instead of a hashref:
841              
842             my $fetchsub = $sqldb->fetchsub_select_rows(
843             table => 'student',
844             columns => 'id, name, age',
845             );
846             while ( my @student = $fetchsub->() ) {
847             print $student[0], $student[1], $student[2];
848             }
849              
850             =back
851              
852             =cut
853              
854             # $rows = $self->fetch_select( %clauses );
855             sub fetch_select {
856             my $self = shift;
857             $self->fetch_sql( $self->sql_select( @_ ) );
858             }
859              
860             # $rows = $self->fetch_select_rows( %clauses );
861             sub fetch_select_rows {
862             my $self = shift;
863             $self->fetch_sql_rows( $self->sql_select( @_ ) );
864             }
865              
866             # $row = $self->fetch_one( %clauses );
867             sub fetch_one {
868             my $self = shift;
869             my $rows = $self->fetch_select( limit => 1, @_ ) or return;
870             $rows->[0];
871             }
872              
873             # $row = $self->fetch_one_row( %clauses );
874             sub fetch_one_row { (shift)->fetch_one( @_ ) }
875              
876             # $row = $self->fetch_one_values( %clauses );
877             sub fetch_one_values {
878             my $self = shift;
879             my $rows = $self->fetch_select_rows( limit => 1, @_ ) or return;
880             $rows->[0] ? @{ $rows->[0] } : ();
881             }
882              
883             # $value = $self->fetch_one_value( %clauses );
884             sub fetch_one_value {
885             my $self = shift;
886             my $row = $self->fetch_one_row( @_ ) or return;
887             (%$row)[1];
888             }
889              
890             # @results = $self->visit_select( %clauses, $coderef );
891             # @results = $self->visit_select( $coderef, %clauses );
892             sub visit_select {
893             my $self = shift;
894             $self->visit_sql( ( ref($_[0]) ? shift : pop ), $self->sql_select( @_ ) )
895             }
896              
897             # @results = $self->visit_select_rows( %clauses, $coderef );
898             # @results = $self->visit_select_rows( $coderef, %clauses );
899             sub visit_select_rows {
900             my $self = shift;
901             $self->visit_sql_rows( ( ref($_[0]) ? shift : pop ), $self->sql_select( @_ ) )
902             }
903              
904             # $coderef = $self->fetchsub_select( %clauses );
905             sub fetchsub_select {
906             my $self = shift;
907             $self->fetchsub_sql( $self->sql_select( @_ ) );
908             }
909              
910             # $coderef = $self->fetchsub_select_rows( %clauses );
911             sub fetchsub_select_rows {
912             my $self = shift;
913             $self->fetchsub_sql_rows( $self->sql_select( @_ ) );
914             }
915              
916             ########################################################################
917              
918             =pod
919              
920             B The following methods are used to construct select queries. They are called automatically by the public select methods, and do not need to be invoked directly.
921              
922             =over 4
923              
924             =item sql_select()
925              
926             $sqldb->sql_select ( %sql_clauses ) : $sql_stmt, @params
927              
928             Generate a SQL select statement and returns it as a query string and a list of values to be bound as parameters. Internally, this sql_ method is used by the fetch_ and visit_ methods above, and calls any of the other sql_ methods necessary.
929              
930             =item sql_where()
931              
932             $sqldb->sql_where( $criteria, $sql, @params ) : $sql, @params
933              
934             Modifies the SQL statement and parameters list provided to append the specified criteria as a where clause. Triggered by use of a where or criteria clause in a call to sql_select(), sql_update(), or sql_delete().
935              
936             The criteria may be a literal SQL where clause (everything after the word "where"), or a reference to an array of a SQL string with embedded placeholders followed by the values that should be bound to those placeholders.
937              
938             If the criteria argument is a reference to hash, it is treated as a set of field-name => value pairs, and a SQL expression is created that requires each one of the named fields to exactly match the value provided for it, or if the value is an array reference to match any one of the array's contents; see L for details.
939              
940             Alternately, if the criteria argument is a reference to an object which supports a sql_where() method, the results of that method will be used; see L for classes with this behavior.
941              
942             If no SQL statement or parameters are provided, this just returns the where clause and associated parameters. If a SQL statement is provided, the where clauses is appended to it; if the SQL statement already includes a where clause, the additional criteria are inserted into the existing statement and AND'ed together with the existing criteria.
943              
944             =item sql_escape_text_for_like()
945              
946             $sqldb->sql_escape_text_for_like ( $text ) : $escaped_expr
947              
948             Fails with message "DBMS-Specific Function".
949              
950             Subclasses should, based on the datasource's server_type, protect a literal value for use in a like expression.
951              
952             =item sql_join()
953              
954             $sqldb->sql_join( $table1, $table2, ... ) : $sql, @params
955             $sqldb->sql_join( \%table_names_and_criteria ) : $sql, @params
956             $sqldb->sql_join( $table1, \%criteria, $table2 ) : $sql, @params
957             $sqldb->sql_join( $table1, $join_type=>\%criteria, $table2 ) : $sql, @params
958              
959             Processes one or more table names to create the "from" clause of a select statement. Table names may appear in succession for normal "cross joins", or you may specify a "complex join" by placing an inner or outer joining operation between them.
960              
961             A joining operation consists of a string containing the word C, followed by an array reference or hash reference that specifies the criteria. The string should be one of the types of joins supported by your database, typically the following: "cross join", "inner join", "outer join", "left outer join", "right outer join". Any underscores in the string are converted to spaces, making it easier to use as an unquoted string.
962              
963             The joining criteria can be an array reference of a string containing a bit SQL followed by any necessary placeholder parameters, or a hash reference which will be converted to SQL with the DBIx::SQLEngine::Criteria package.
964              
965             If an array reference is used as a table name, its contents are evaluated by being passed to another call to sql_join, and then the results are treated as a parenthesized expression.
966              
967             If a hash reference is used as a table name, its contents are evaluated as criteria in "table1.column1" => "table2.column2" format. The table names and criteria are passed to another call to sql_join, and then the results are treated as a parenthesized expression.
968              
969             B While the cross and inner joins are widely supported, the various outer join capabilities are only present in some databases. Subclasses may provide a degree of emulation; for one implementation of this, see L.
970              
971             B These samples demonstrate use of the join feature.
972              
973             =over 2
974              
975             =item *
976              
977             Here's a simple inner join of two tables, using a hash ref to express the linkage:
978              
979             $hashes = $sqldb->fetch_select(
980             tables => { 'students.id' => 'grades.student_id' },
981             order => 'students.name'
982             );
983              
984             =item *
985              
986             You can also use bits of SQL to express the linkage between two tables:
987              
988             $hashes = $sqldb->fetch_select(
989             tables => [
990             'students',
991             INNER_JOIN=>['students.id = grades.student_id'],
992             'grades'
993             ],
994             order => 'students.name'
995             );
996              
997             =item *
998              
999             Any number of tables can be joined in this fashion:
1000              
1001             $hashes = $sqldb->fetch_select(
1002             tables => [
1003             'students',
1004             INNER_JOIN=>['students.id = grades.student_id'],
1005             'grades',
1006             INNER_JOIN=>['classes.id = grades.class_id' ],
1007             'classes',
1008             ],
1009             order => 'students.name'
1010             );
1011              
1012             =item *
1013              
1014             Here's yet another way of expressing a join, using a join type and a hash of criteria:
1015              
1016             $hashes = $sqldb->fetch_select(
1017             tables => [
1018             'students', INNER_JOIN=>{ 'students.id'=>\'grades.student_id' }, 'grades'
1019             ],
1020             order => 'students.name'
1021             );
1022              
1023             Note that we're using a backslash in our criteria hash again to make it clear that we're looking for tuples where the students.id column matches that the grades.student_id column, rather than trying to match the literal string 'grades.student_id'.
1024              
1025             =item *
1026              
1027             The inner join shown above is equivalent to a typical cross join with the same joining criteria:
1028              
1029             $hashes = $sqldb->fetch_select(
1030             tables => [ 'students', 'grades' ],
1031             where => { 'students.id' => \'grades.student_id' },
1032             order => 'students.name'
1033             );
1034              
1035             =item *
1036              
1037             You can use nested array references to produce grouped join expressions:
1038              
1039             $hashes = $sqldb->fetch_select( table => [
1040             [ 'table1', INNER_JOIN=>{ 'table1.foo' => \'table2.foo' }, 'table2' ],
1041             OUTER_JOIN=>{ 'table1.bar' => \'table3.bar' },
1042             [ 'table3', INNER_JOIN=>{ 'table3.baz' => \'table4.baz' }, 'table4' ],
1043             ] );
1044              
1045             =item *
1046              
1047             You can also simply pass in your own arbitrary join as text:
1048              
1049             $hashes = $sqldb->fetch_select(
1050             tables => 'students OUTER JOIN grades ON students.id = grades.student_id',
1051             order => 'students.name'
1052             );
1053              
1054             =back
1055              
1056             =item sql_limit()
1057              
1058             $sqldb->sql_limit( $limit, $offset, $sql, @params ) : $sql, @params
1059              
1060             Modifies the SQL statement and parameters list provided to apply the specified limit and offset requirements. Triggered by use of a limit or offset clause in a call to sql_select().
1061              
1062             B Limit and offset clauses are handled differently by various DBMS platforms. For example, MySQL accepts "limit 20,10", Postgres "limit 10 offset 20", and Oracle requires a nested select with rowcount. The sql_limit method can be overridden by subclasses to adjust this behavior.
1063              
1064             B These samples demonstrate use of the limit feature.
1065              
1066             =over 2
1067              
1068             =item *
1069              
1070             This query return records 101 through 120 from an alphabetical list:
1071              
1072             $hash_ary = $sqldb->fetch_select(
1073             table => 'students', order => 'last_name, first_name',
1074             limit => 20, offset => 100,
1075             );
1076              
1077             =back
1078              
1079             =item sql_union()
1080              
1081             $sqldb->sql_union( \%clauses_1, \%clauses_2, ... ) : $sql, @params
1082              
1083             Returns a combined select query using the C operator between the SQL statements produced by calling sql_select() with each of the provided arrays of arguments. Triggered by use of a union clause in a call to sql_select().
1084              
1085             B Union queries are only supported by some databases. Croaks if the dbms_union_unsupported() capability method is set. Subclasses may provide a degree of emulation; for one implementation of this, see L.
1086              
1087             B These samples demonstrate use of the union feature.
1088              
1089             =over 2
1090              
1091             =item *
1092              
1093             A union can combine any mixture of queries with generated clauses:
1094              
1095             $hash_ary = $sqldb->fetch_select(
1096             union=>[ { table=>'students', columns=>'first_name, last_name' },
1097             { table=>'staff', columns=>'name_f, name_l' }, ],
1098             );
1099              
1100             =item *
1101              
1102             Unions can also combine plain SQL strings:
1103              
1104             $hash_ary = $sqldb->fetch_select(
1105             union=>[ { sql=>'select first_name, last_name from students' },
1106             { sql=>'select name_f, name_l from staff' }, ],
1107             );
1108              
1109             =back
1110              
1111             =back
1112              
1113             =cut
1114              
1115             sub sql_select {
1116             my ( $self, %clauses ) = @_;
1117              
1118             my $keyword = 'select';
1119             my ($sql, @params);
1120              
1121             if ( my $named = delete $clauses{'named_query'} ) {
1122             my %named = $self->interpret_named_query( ref($named) ? @$named : $named );
1123             %clauses = ( %named, %clauses );
1124             }
1125              
1126             if ( my $action = delete $clauses{'action'} ) {
1127             confess("Action mismatch: expecting $keyword, not $action query")
1128             unless ( $action eq $keyword );
1129             }
1130              
1131             if ( my $union = delete $clauses{'union'} ) {
1132             if ( my ( $conflict ) = grep $clauses{$_}, qw/sql table tables columns/ ) {
1133             croak("Can't build a $keyword query using both union and $conflict args")
1134             }
1135             ref($union) eq 'ARRAY' or
1136             croak("Union clause must be a reference to an array of hashes or arrays");
1137            
1138             $clauses{'sql'} = [ $self->sql_union( @$union ) ]
1139             }
1140              
1141             if ( my $literal = delete $clauses{'sql'} ) {
1142             if ( my ($conflict) = grep $clauses{$_}, qw/distinct table tables columns/){
1143             croak("Can't build a $keyword query using both sql and $conflict clauses")
1144             }
1145             ($sql, @params) = ( ref($literal) eq 'ARRAY' ) ? @$literal : $literal;
1146            
1147             } else {
1148            
1149             if ( my $distinct = delete $clauses{'distinct'} ) {
1150             $keyword .= " distinct";
1151             }
1152            
1153             my $columns = delete $clauses{'columns'};
1154             if ( ! $columns ) {
1155             $columns = '*';
1156             } elsif ( ! ref( $columns ) and length( $columns ) ) {
1157             # should be one or more comma-separated column names
1158             } elsif ( UNIVERSAL::can($columns, 'column_names') ) {
1159             $columns = join ', ', $columns->column_names;
1160             } elsif ( ref($columns) eq 'ARRAY' ) {
1161             $columns = join ', ', @$columns;
1162             } elsif ( ref($columns) eq 'HASH' ) {
1163             $columns = join ', ', map { "$_ as $columns->{$_}" } sort keys %$columns;
1164             } else {
1165             confess("Unsupported column spec '$columns'");
1166             }
1167             $sql = "$keyword $columns";
1168            
1169             my $tables = delete $clauses{'table'} || delete $clauses{'tables'};
1170             if ( ! $tables ) {
1171             confess("You must supply a table name if you do not use literal SQL or a named query");
1172             } elsif ( ! ref( $tables ) and length( $tables ) ) {
1173             # should be one or more comma-separated table names
1174             } elsif ( UNIVERSAL::can($tables, 'table_names') ) {
1175             $tables = $tables->table_names;
1176             } elsif ( ref($tables) eq 'ARRAY' ) {
1177             ($tables, my @join_params) = $self->sql_join( @$tables );
1178             push @params, @join_params;
1179             } elsif ( ref($tables) eq 'HASH' ) {
1180             ($tables, my @join_params) = $self->sql_join( $tables );
1181             push @params, @join_params;
1182             } else {
1183             confess("Unsupported table spec '$tables'");
1184             }
1185             $sql .= " from $tables";
1186             }
1187            
1188             if ( my $criteria = delete $clauses{'criteria'} || delete $clauses{'where'} ){
1189             ($sql, @params) = $self->sql_where($criteria, $sql, @params);
1190             }
1191            
1192             if ( my $group = delete $clauses{'group'} ) {
1193             if ( ! ref( $group ) and length( $group ) ) {
1194             # should be one or more comma-separated column names or expressions
1195             } elsif ( ref($group) eq 'ARRAY' ) {
1196             $group = join ', ', @$group;
1197             } else {
1198             confess("Unsupported group spec '$group'");
1199             }
1200             if ( $group ) {
1201             $sql .= " group by $group";
1202             }
1203             }
1204            
1205             if ( my $order = delete $clauses{'order'} ) {
1206             if ( ! ref( $order ) and length( $order ) ) {
1207             # should be one or more comma-separated column names with optional 'desc'
1208             } elsif ( ref($order) eq 'ARRAY' ) {
1209             $order = join ', ', @$order;
1210             } else {
1211             confess("Unsupported order spec '$order'");
1212             }
1213             if ( $order ) {
1214             $sql .= " order by $order";
1215             }
1216             }
1217            
1218             my $limit = delete $clauses{limit};
1219             my $offset = delete $clauses{offset};
1220             if ( $limit or $offset) {
1221             ($sql, @params) = $self->sql_limit($limit, $offset, $sql, @params);
1222             }
1223            
1224             if ( scalar keys %clauses ) {
1225             confess("Unsupported $keyword clauses: " .
1226             join ', ', map "$_ ('$clauses{$_}')", keys %clauses);
1227             }
1228            
1229             $self->log_sql( $sql, @params );
1230            
1231             return( $sql, @params );
1232             }
1233              
1234             ########################################################################
1235              
1236             use DBIx::SQLEngine::Criteria;
1237              
1238             sub sql_where {
1239             my $self = shift;
1240             my ( $criteria, $sql, @params ) = @_;
1241            
1242             my ( $sql_crit, @cp ) = DBIx::SQLEngine::Criteria->auto_where( $criteria );
1243             if ( $sql_crit ) {
1244             if ( ! defined $sql ) {
1245             $sql = "where $sql_crit";
1246             } elsif ( $sql =~ s{(\bwhere\b)(.*?)(\border by|\bgroup by|$)}
1247             {$1 ($2) AND $sql_crit $3}i ) {
1248             } else {
1249             $sql .= " where $sql_crit";
1250             }
1251             push @params, @cp;
1252             }
1253            
1254             return ($sql, @params);
1255             }
1256              
1257             sub sql_escape_text_for_like {
1258             confess("DBMS-Specific Function")
1259             }
1260              
1261             ########################################################################
1262              
1263             # ( $sql, @params ) = $sqldb->sql_join( $table_name, $table_name, ... );
1264             # ( $sql, @params ) = $sqldb->sql_join( $table_name, \%crit, $table_name);
1265             # ( $sql, @params ) = $sqldb->sql_join( $table_name, join=>\%crit, $table_name);
1266             sub sql_join {
1267             my ($self, @exprs) = @_;
1268             my $sql = '';
1269             my @params;
1270             while ( scalar @exprs ) {
1271             my $expr = shift @exprs;
1272              
1273             my ( $table, $join, $criteria );
1274             if ( ! ref $expr and $expr =~ /^[\w\s]+join$/i and ref($exprs[0]) ) {
1275             $join = $expr;
1276             $criteria = shift @exprs;
1277             $table = shift @exprs;
1278              
1279             } elsif ( $sql and ref($expr) eq 'HASH' ) {
1280             $join = 'inner join';
1281             $criteria = $expr;
1282             $table = shift @exprs;
1283              
1284             } else {
1285             $join = ',';
1286             $criteria = undef;
1287             $table = $expr;
1288             }
1289            
1290             ( $table ) or croak("No table name provided to join to");
1291             ( $join ) or croak("No join type provided for link to $table");
1292            
1293             $join =~ tr[_][ ];
1294             $sql .= ( ( length($join) == 1 ) ? '' : ' ' ) . $join;
1295            
1296             my ( $expr_sql, @expr_params );
1297             if ( ! ref $table ) {
1298             $expr_sql = $table
1299             } elsif ( ref($table) eq 'ARRAY' ) {
1300             my ( $sub_sql, @sub_params ) = $self->sql_join( @$table );
1301             $expr_sql = "( $sub_sql )";
1302             push @expr_params, @sub_params
1303             } elsif ( ref($table) eq 'HASH' ) {
1304             my %seen_tables;
1305             my @tables = grep { ! $seen_tables{$_} ++ } map { ( /^([^\.]+)\./ )[0] } %$table;
1306             if ( @tables == 2 ) {
1307             my ( $sub_sql, @sub_params ) = $self->sql_join(
1308             $tables[0],
1309             inner_join => { map { $_ => \($table->{$_}) } keys %$table },
1310             $tables[1],
1311             );
1312             $expr_sql = $sub_sql;
1313             push @expr_params, @sub_params
1314             } else {
1315             confess("sql_join on hash with more than two tables not yet supported")
1316             }
1317             } elsif ( UNIVERSAL::can($table, 'name') ) {
1318             $expr_sql = $table->name
1319             } else {
1320             Carp::confess("Unsupported expression in sql_join: '$table'");
1321             }
1322              
1323             $sql .= " $expr_sql";
1324             push @params, @expr_params;
1325            
1326             if ( $criteria ) {
1327             my ($crit_sql, @crit_params) =
1328             DBIx::SQLEngine::Criteria->auto_where( $criteria );
1329             if ( $crit_sql ) {
1330             $sql .= " on $crit_sql";
1331             push @params, @crit_params;
1332             }
1333             }
1334              
1335             }
1336             $sql =~ s/^, // or carp("Suspect table join: '$sql'");
1337             ( $sql, @params );
1338             }
1339              
1340             ########################################################################
1341              
1342             sub sql_limit {
1343             my $self = shift;
1344             my ( $limit, $offset, $sql, @params ) = @_;
1345            
1346             $sql .= " limit $limit" if $limit;
1347             $sql .= " offset $offset" if $offset;
1348            
1349             return ($sql, @params);
1350             }
1351              
1352             ########################################################################
1353              
1354             sub sql_union {
1355             my ( $self, @queries ) = @_;
1356             my ( @sql, @params );
1357             if ( $self->dbms_union_unsupported ) {
1358             croak("SQL Union not supported by this database");
1359             }
1360             foreach my $query ( @queries ) {
1361             my ( $q_sql, @q_params ) = $self->sql_select(
1362             ( ref($query) eq 'ARRAY' ) ? @$query : %$query );
1363             push @sql, $q_sql;
1364             push @params, @q_params;
1365             }
1366             return ( join( ' union ', @sql ), @params )
1367             }
1368              
1369             sub detect_union_supported {
1370             my $self = shift;
1371             my $result = 0;
1372             eval {
1373             local $SIG{__DIE__};
1374             $self->fetch_select( sql => 'select 1 union select 2' );
1375             $result = 1;
1376             };
1377             return $result;
1378             }
1379              
1380             ########################################################################
1381              
1382             ########################################################################
1383              
1384             =head1 EDITING DATA (SQL DML)
1385              
1386             Information in a DBI database is entered and modified through the Data Manipulation Language features of SQL.
1387              
1388             =head2 Insert to Add Data
1389              
1390             B You can perform database INSERTs with these methods.
1391              
1392             =over 4
1393              
1394             =item do_insert()
1395              
1396             $sqldb->do_insert( %sql_clauses ) : $row_count
1397              
1398             Insert a single row into a table in the datasource. Should return 1, unless there's an exception.
1399              
1400             =item do_bulk_insert()
1401              
1402             $sqldb->do_bulk_insert( %sql_clauses, values => [ @array_or_hash_refs ] ) : $row_count
1403              
1404             Inserts several rows into a table. Returns the number of rows inserted.
1405              
1406             This is provided so that drivers which have alternate bulk-loader
1407             interfaces can hook into that support here, and to allow specialty
1408             options like C 100> in order to
1409             optimize performance on servers such as Oracle, where auto-committing
1410             one statement at a time is slow.
1411              
1412             =back
1413              
1414             B The following method is called by do_insert() and does not need to be called directly.
1415              
1416             =over 4
1417              
1418             =item sql_insert()
1419              
1420             $sqldb->sql_insert ( %sql_clauses ) : $sql_stmt, @params
1421              
1422             Generate a SQL insert statement and returns it as a query string and a list of values to be bound as parameters. Internally, this sql_ method is used by the do_ method above.
1423              
1424             =back
1425              
1426             B: The above insert methods accept a hash describing the clauses of the SQL statement they are to generate, and require a value for one or more of the following keys:
1427              
1428             =over 4
1429              
1430             =item 'sql'
1431              
1432             Optional; overrides all other arguments. May contain a plain SQL statement to be executed, or a reference to an array of a SQL statement followed by parameters for embedded placeholders.
1433              
1434             =item 'named_query'
1435              
1436             Uses the named_query catalog to build the query. May contain a defined query name, or a reference to an array of a query name followed by parameters to be handled by interpret_named_query. See L for details.
1437              
1438             =item 'table'
1439              
1440             Required. The name of the table to insert into.
1441              
1442             =item 'columns'
1443              
1444             Optional; defaults to '*'. May contain a comma-separated string of column names, or an reference to an array of column names, or a reference to a hash whose keys contain the column names, or a reference to an object with a "column_names" method.
1445              
1446             =item 'values'
1447              
1448             Required. May contain a string with one or more comma-separated quoted values or expressions in SQL format, or a reference to an array of values to insert in order, or a reference to a hash whose values are to be inserted. If an array or hash reference is used, each value may either be a scalar to be used as a literal value (passed via placeholder), or a reference to a scalar to be used directly (such as a sql function or other non-literal expression).
1449              
1450             =item 'sequence'
1451              
1452             Optional. May contain a string with the name of a column in the target table which should receive an automatically incremented value. If present, triggers use of the DMBS-specific do_insert_with_sequence() method, described below.
1453              
1454             =back
1455              
1456             B These samples demonstrate use of the insert feature.
1457              
1458             =over 2
1459              
1460             =item *
1461              
1462             Here's a simple insert using a hash of column-value pairs:
1463              
1464             $sqldb->do_insert(
1465             table => 'students',
1466             values => { 'name'=>'Dave', 'age'=>'19', 'status'=>'minor' }
1467             );
1468              
1469             =item *
1470              
1471             Here's the same insert using separate arrays of column names and values to be inserted:
1472              
1473             $sqldb->do_insert(
1474             table => 'students',
1475             columns => [ 'name', 'age', 'status' ],
1476             values => [ 'Dave', '19', 'minor' ]
1477             );
1478              
1479             =item *
1480              
1481             Here's a bulk insert of multiple rows:
1482              
1483             $sqldb->do_insert(
1484             table => 'students',
1485             columns => [ 'name', 'age', 'status' ],
1486             values => [
1487             [ 'Dave', '19', 'minor' ],
1488             [ 'Alice', '20', 'minor' ],
1489             [ 'Sam', '22', 'adult' ],
1490             ]
1491             );
1492              
1493             =item *
1494              
1495             Of course you can also use your own arbitrary SQL and placeholder parameters.
1496              
1497             $sqldb->do_insert(
1498             sql=>['insert into students (id, name) values (?, ?)', 201, 'Dave']
1499             );
1500              
1501             =item *
1502              
1503             And the named_query interface is supported as well:
1504              
1505             $sqldb->define_named_query(
1506             'insert_student' => 'insert into students (id, name) values (?, ?)'
1507             );
1508             $hashes = $sqldb->do_insert(
1509             named_query => [ 'insert_student', 201, 'Dave' ]
1510             );
1511              
1512             =back
1513              
1514             =cut
1515              
1516             # $rows = $self->do_insert( %clauses );
1517             sub do_insert {
1518             my $self = shift;
1519             my %args = @_;
1520            
1521             if ( my $seq_name = delete $args{sequence} ) {
1522             $self->do_insert_with_sequence( $seq_name, %args );
1523             } else {
1524             $self->do_sql( $self->sql_insert( @_ ) );
1525             }
1526             }
1527              
1528             sub do_bulk_insert {
1529             my $self = shift;
1530             my %args = @_;
1531             my $values = delete $args{values};
1532             foreach my $value ( @$values ) {
1533             $self->do_insert( %args, values => $value );
1534             }
1535             }
1536              
1537             sub sql_insert {
1538             my ( $self, %clauses ) = @_;
1539              
1540             my $keyword = 'insert';
1541             my ($sql, @params);
1542              
1543             if ( my $named = delete $clauses{'named_query'} ) {
1544             my %named = $self->interpret_named_query( ref($named) ? @$named : $named );
1545             %clauses = ( %named, %clauses );
1546             }
1547              
1548             if ( my $action = delete $clauses{'action'} ) {
1549             confess("Action mismatch: expecting $keyword, not $action query")
1550             unless ( $action eq $keyword );
1551             }
1552              
1553             if ( my $literal = delete $clauses{'sql'} ) {
1554             return ( ref($literal) eq 'ARRAY' ) ? @$literal : $literal;
1555             }
1556            
1557             my $table = delete $clauses{'table'};
1558             if ( ! $table ) {
1559             confess("Table name is missing or empty");
1560             } elsif ( ! ref( $table ) and length( $table ) ) {
1561             # should be a single table name
1562             } else {
1563             confess("Unsupported table spec '$table'");
1564             }
1565             $sql = "insert into $table";
1566            
1567             my $columns = delete $clauses{'columns'};
1568             if ( ! $columns and UNIVERSAL::isa( $clauses{'values'}, 'HASH' ) ) {
1569             $columns = $clauses{'values'}
1570             }
1571             if ( ! $columns or $columns eq '*' ) {
1572             $columns = '';
1573             } elsif ( ! ref( $columns ) and length( $columns ) ) {
1574             # should be one or more comma-separated column names
1575             } elsif ( UNIVERSAL::can($columns, 'column_names') ) {
1576             $columns = join ', ', $columns->column_names;
1577             } elsif ( ref($columns) eq 'HASH' ) {
1578             $columns = join ', ', sort keys %$columns;
1579             } elsif ( ref($columns) eq 'ARRAY' ) {
1580             $columns = join ', ', @$columns;
1581             } else {
1582             confess("Unsupported column spec '$columns'");
1583             }
1584             if ( $columns ) {
1585             $sql .= " ($columns)";
1586             }
1587            
1588             my $values = delete $clauses{'values'};
1589             my @value_args;
1590             if ( ! defined $values or ! length $values ) {
1591             croak("Values are missing or empty");
1592             } elsif ( ! ref( $values ) and length( $values ) ) {
1593             # should be one or more comma-separated quoted values or expressions
1594             @value_args = \$values;
1595             } elsif ( UNIVERSAL::isa( $values, 'HASH' ) ) {
1596             @value_args = map $values->{$_}, split /,\s?/, $columns;
1597             } elsif ( ref($values) eq 'ARRAY' ) {
1598             @value_args = @$values;
1599             } else {
1600             confess("Unsupported values spec '$values'");
1601             }
1602             ( scalar @value_args ) or croak("Values are missing or empty");
1603             my @v_literals;
1604             my @v_params;
1605             foreach my $v ( @value_args ) {
1606             if ( ! defined($v) ) {
1607             push @v_literals, 'NULL';
1608             } elsif ( ! ref($v) ) {
1609             push @v_literals, '?';
1610             push @v_params, $v;
1611             } elsif ( ref($v) eq 'SCALAR' ) {
1612             push @v_literals, $$v;
1613             } else {
1614             Carp::confess( "Can't use '$v' as part of a sql values clause" );
1615             }
1616             }
1617             $values = join ', ', @v_literals;
1618             $sql .= " values ($values)";
1619             push @params, @v_params;
1620            
1621             if ( scalar keys %clauses ) {
1622             confess("Unsupported $keyword clauses: " .
1623             join ', ', map "$_ ('$clauses{$_}')", keys %clauses);
1624             }
1625            
1626             $self->log_sql( $sql, @params );
1627            
1628             return( $sql, @params );
1629             }
1630              
1631             ########################################################################
1632              
1633             =pod
1634              
1635             B The following methods are called by do_insert() and do not need to be called directly.
1636              
1637             =over 4
1638              
1639             =item do_insert_with_sequence()
1640              
1641             $sqldb->do_insert_with_sequence( $seq_name, %sql_clauses ) : $row_count
1642              
1643             Insert a single row into a table in the datasource, using a sequence to fill in the values of the column named in the first argument. Should return 1, unless there's an exception.
1644              
1645             Fails with message "DBMS-Specific Function".
1646              
1647             B Auto-incrementing sequences are handled differently by various DBMS platforms. For example, the MySQL and MSSQL subclasses use auto-incrementing fields, Oracle and Pg use server-specific sequence objects, and AnyData and CSV lack this capability, which can be emulated with an ad-hoc table of incrementing values.
1648              
1649             To standardize their use, this package defines an interface with several typical methods which may or may not be supported by individual subclasses. You may need to consult the documentation for the SQLEngine Driver subclass and DBMS platform you're using to confirm that the sequence functionality you need is available.
1650              
1651             Drivers which don't support native sequences may provide a degree of emulation; for one implementation of this, see L.
1652              
1653             Subclasses will probably want to call either the _seq_do_insert_preinc() method or the _seq_do_insert_postfetch() method, and define the appropriate other seq_* methods to support them. These two methods are not part of the public interface but instead provide a template for the two most common types of insert-with-sequence behavior. The _seq_do_insert_preinc() method first obtaines a new number from the sequence using seq_increment(), and then performs a normal do_insert(). The _seq_do_insert_postfetch() method performs a normal do_insert() and then fetches the resulting value that was automatically incremented using seq_fetch_current().
1654              
1655             =item seq_fetch_current()
1656              
1657             $sqldb->seq_fetch_current( $table, $field ) : $current_value
1658              
1659             Fetches the current sequence value.
1660              
1661             Fails with message "DBMS-Specific Function".
1662              
1663             =item seq_increment()
1664              
1665             $sqldb->seq_increment( $table, $field ) : $new_value
1666              
1667             Increments the sequence, and returns the newly allocated value.
1668              
1669             Fails with message "DBMS-Specific Function".
1670              
1671             =back
1672              
1673             =cut
1674              
1675             # $self->do_insert_with_sequence( $seq_name, %args );
1676             sub do_insert_with_sequence {
1677             confess("DBMS-Specific Function")
1678             }
1679              
1680             # $rows = $self->_seq_do_insert_preinc( $sequence, %clauses );
1681             sub _seq_do_insert_preinc {
1682             my ($self, $seq_name, %args) = @_;
1683            
1684             unless ( UNIVERSAL::isa($args{values}, 'HASH') ) {
1685             croak ref($self) . " insert with sequence requires values to be hash-ref"
1686             }
1687            
1688             $args{values}->{$seq_name} = $self->seq_increment( $args{table}, $seq_name );
1689            
1690             $self->do_insert( %args );
1691             }
1692              
1693             # $rows = $self->_seq_do_insert_postfetch( $sequence, %clauses );
1694             sub _seq_do_insert_postfetch {
1695             my ($self, $seq_name, %args) = @_;
1696            
1697             unless ( UNIVERSAL::isa($args{values}, 'HASH') ) {
1698             croak ref($self) . " insert with sequence requires values to be hash-ref"
1699             }
1700            
1701             my $rv = $self->do_insert( %args );
1702             $args{values}->{$seq_name} = $self->seq_fetch_current($args{table},$seq_name);
1703             return $rv;
1704             }
1705              
1706             # $current_id = $sqldb->seq_fetch_current( $table, $field );
1707             sub seq_fetch_current {
1708             confess("DBMS-Specific Function")
1709             }
1710              
1711             # $nextid = $sqldb->seq_increment( $table, $field );
1712             sub seq_increment {
1713             confess("DBMS-Specific Function")
1714             }
1715              
1716             ########################################################################
1717              
1718             =head2 Update to Change Data
1719              
1720             B You can perform database UPDATEs with these methods.
1721              
1722             =over 4
1723              
1724             =item do_update()
1725              
1726             $sqldb->do_update( %sql_clauses ) : $row_count
1727              
1728             Modify one or more rows in a table in the datasource.
1729              
1730             =back
1731              
1732             B These methods are called by the public update method.
1733              
1734             =over 4
1735              
1736             =item sql_update()
1737              
1738             $sqldb->sql_update ( %sql_clauses ) : $sql_stmt, @params
1739              
1740             Generate a SQL update statement and returns it as a query string and a list of values to be bound as parameters. Internally, this sql_ method is used by the do_ method above.
1741              
1742             =back
1743              
1744             B: The above update methods accept a hash describing the clauses of the SQL statement they are to generate, and require a value for one or more of the following keys:
1745              
1746             =over 4
1747              
1748             =item 'sql'
1749              
1750             Optional; conflicts with table, columns and values arguments. May contain a plain SQL statement to be executed, or a reference to an array of a SQL statement followed by parameters for embedded placeholders.
1751              
1752             =item 'named_query'
1753              
1754             Uses the named_query catalog to build the query. May contain a defined query name, or a reference to an array of a query name followed by parameters to be handled by interpret_named_query. See L for details.
1755              
1756             =item 'table'
1757              
1758             Required unless sql argument is used. The name of the table to update.
1759              
1760             =item 'columns'
1761              
1762             Optional unless sql argument is used. Defaults to '*'. May contain a comma-separated string of column names, or an reference to an array of column names, or a reference to a hash whose keys contain the column names, or a reference to an object with a "column_names" method.
1763              
1764             =item 'values'
1765              
1766             Required unless sql argument is used. May contain a string with one or more comma-separated quoted values or expressions in SQL format, or a reference to an array of values to insert in order, or a reference to a hash whose values are to be inserted. If an array or hash reference is used, each value may either be a scalar to be used as a literal value (passed via placeholder), or a reference to a scalar to be used directly (such as a sql function or other non-literal expression).
1767              
1768             =item 'where' I 'criteria'
1769              
1770             Optional, but remember that ommitting this will cause all of your rows to be updated! May contain a literal SQL where clause, an array ref with a SQL clause and parameter list, a hash of field => value pairs, or an object that supports a sql_where() method. See the sql_where() method for details.
1771              
1772             =back
1773              
1774             B These samples demonstrate use of the update feature.
1775              
1776             =over 2
1777              
1778             =item *
1779              
1780             Here's a basic update statement with a hash of columns-value pairs to change:
1781              
1782             $sqldb->do_update(
1783             table => 'students',
1784             where => 'age > 20',
1785             values => { 'status'=>'adult' }
1786             );
1787              
1788             =item *
1789              
1790             Here's an equivalent update statement using separate lists of columns and values:
1791              
1792             $sqldb->do_update(
1793             table => 'students',
1794             where => 'age > 20',
1795             columns => [ 'status' ],
1796             values => [ 'adult' ]
1797             );
1798              
1799             =item *
1800              
1801             You can also use your own arbitrary SQL statements and placeholders:
1802              
1803             $sqldb->do_update(
1804             sql=>['update students set status = ? where age > ?', 'adult', 20]
1805             );
1806              
1807             =item *
1808              
1809             And the named_query interface is supported as well:
1810              
1811             $sqldb->define_named_query(
1812             'update_minors' =>
1813             [ 'update students set status = ? where age > ?', 'adult', 20 ]
1814             );
1815             $hashes = $sqldb->do_update(
1816             named_query => 'update_minors'
1817             );
1818              
1819             =back
1820              
1821             =cut
1822              
1823             # $rows = $self->do_update( %clauses );
1824             sub do_update {
1825             my $self = shift;
1826             $self->do_sql( $self->sql_update( @_ ) );
1827             }
1828              
1829             sub sql_update {
1830             my ( $self, %clauses ) = @_;
1831            
1832             my $keyword = 'update';
1833             my ($sql, @params);
1834              
1835             if ( my $named = delete $clauses{'named_query'} ) {
1836             my %named = $self->interpret_named_query( ref($named) ? @$named : $named );
1837             %clauses = ( %named, %clauses );
1838             }
1839              
1840             if ( my $action = delete $clauses{'action'} ) {
1841             confess("Action mismatch: expecting $keyword, not $action query")
1842             unless ( $action eq $keyword );
1843             }
1844            
1845             if ( my $literal = delete $clauses{'sql'} ) {
1846             ($sql, @params) = ( ref($literal) eq 'ARRAY' ) ? @$literal : $literal;
1847             if ( my ( $conflict ) = grep $clauses{$_}, qw/ table columns values / ) {
1848             croak("Can't build a $keyword query using both sql and $conflict clauses")
1849             }
1850            
1851             } else {
1852            
1853             my $table = delete $clauses{'table'};
1854             if ( ! $table ) {
1855             confess("Table name is missing or empty");
1856             } elsif ( ! ref( $table ) and length( $table ) ) {
1857             # should be a single table name
1858             } else {
1859             confess("Unsupported table spec '$table'");
1860             }
1861             $sql = "update $table";
1862            
1863             my $columns = delete $clauses{'columns'};
1864             if ( ! $columns and UNIVERSAL::isa( $clauses{'values'}, 'HASH' ) ) {
1865             $columns = $clauses{'values'}
1866             }
1867             my @columns;
1868             if ( ! $columns or $columns eq '*' ) {
1869             croak("Column names are missing or empty");
1870             } elsif ( ! ref( $columns ) and length( $columns ) ) {
1871             # should be one or more comma-separated column names
1872             @columns = split /,\s?/, $columns;
1873             } elsif ( UNIVERSAL::can($columns, 'column_names') ) {
1874             @columns = $columns->column_names;
1875             } elsif ( ref($columns) eq 'HASH' ) {
1876             @columns = sort keys %$columns;
1877             } elsif ( ref($columns) eq 'ARRAY' ) {
1878             @columns = @$columns;
1879             } else {
1880             confess("Unsupported column spec '$columns'");
1881             }
1882            
1883             my $values = delete $clauses{'values'};
1884             my @value_args;
1885             if ( ! $values ) {
1886             croak("Values are missing or empty");
1887             } elsif ( ! ref( $values ) and length( $values ) ) {
1888             confess("Unsupported values clause!");
1889             } elsif ( UNIVERSAL::isa( $values, 'HASH' ) ) {
1890             @value_args = map $values->{$_}, @columns;
1891             } elsif ( ref($values) eq 'ARRAY' ) {
1892             @value_args = @$values;
1893             } else {
1894             confess("Unsupported values spec '$values'");
1895             }
1896             ( scalar @value_args ) or croak("Values are missing or empty");
1897             my @values;
1898             my @v_params;
1899             foreach my $v ( @value_args ) {
1900             if ( ! defined($v) ) {
1901             push @values, 'NULL';
1902             } elsif ( ! ref($v) ) {
1903             push @values, '?';
1904             push @v_params, $v;
1905             } elsif ( ref($v) eq 'SCALAR' ) {
1906             push @values, $$v;
1907             } else {
1908             Carp::confess( "Can't use '$v' as part of a sql values clause" );
1909             }
1910             }
1911             $sql .= " set " . join ', ', map "$columns[$_] = $values[$_]", 0 .. $#columns;
1912             push @params, @v_params;
1913             }
1914            
1915             if ( my $criteria = delete $clauses{'criteria'} || delete $clauses{'where'} ){
1916             ($sql, @params) = $self->sql_where($criteria, $sql, @params);
1917             }
1918            
1919             if ( scalar keys %clauses ) {
1920             confess("Unsupported $keyword clauses: " .
1921             join ', ', map "$_ ('$clauses{$_}')", keys %clauses);
1922             }
1923            
1924             $self->log_sql( $sql, @params );
1925            
1926             return( $sql, @params );
1927             }
1928              
1929             ########################################################################
1930              
1931             =head2 Delete to Remove Data
1932              
1933             B You can perform database DELETEs with these methods.
1934              
1935             =over 4
1936              
1937             =item do_delete()
1938              
1939             $sqldb->do_delete( %sql_clauses ) : $row_count
1940              
1941             Delete one or more rows in a table in the datasource.
1942              
1943             =back
1944              
1945             B These methods are called by the public delete methods.
1946              
1947             =over 4
1948              
1949             =item sql_delete()
1950              
1951             $sqldb->sql_delete ( %sql_clauses ) : $sql_stmt, @params
1952              
1953             Generate a SQL delete statement and returns it as a query string and a list of values to be bound as parameters. Internally, this sql_ method is used by the do_ method above.
1954              
1955             =back
1956              
1957             B: The above delete methods accept a hash describing the clauses of the SQL statement they are to generate, and require a value for one or more of the following keys:
1958              
1959             =over 4
1960              
1961             =item 'sql'
1962              
1963             Optional; conflicts with 'table' argument. May contain a plain SQL statement to be executed, or a reference to an array of a SQL statement followed by parameters for embedded placeholders.
1964              
1965             =item 'named_query'
1966              
1967             Uses the named_query catalog to build the query. May contain a defined query name, or a reference to an array of a query name followed by parameters to be handled by interpret_named_query. See L for details.
1968              
1969             =item 'table'
1970              
1971             Required unless explicit "sql => ..." is used. The name of the table to delete from.
1972              
1973             =item 'where' I 'criteria'
1974              
1975             Optional, but remember that ommitting this will cause all of your rows to be deleted! May contain a literal SQL where clause, an array ref with a SQL clause and parameter list, a hash of field => value pairs, or an object that supports a sql_where() method. See the sql_where() method for details.
1976              
1977             =back
1978              
1979             B These samples demonstrate use of the delete feature.
1980              
1981             =over 2
1982              
1983             =item *
1984              
1985             Here's a basic delete with a table name and criteria.
1986              
1987             $sqldb->do_delete(
1988             table => 'students', where => { 'name'=>'Dave' }
1989             );
1990              
1991             =item *
1992              
1993             You can use your own arbitrary SQL and placeholders:
1994              
1995             $sqldb->do_delete(
1996             sql => [ 'delete from students where name = ?', 'Dave' ]
1997             );
1998              
1999             =item *
2000              
2001             You can combine an explicit delete statement with dynamic criteria:
2002              
2003             $sqldb->do_delete(
2004             sql => 'delete from students', where => { 'name'=>'Dave' }
2005             );
2006              
2007             =item *
2008              
2009             And the named_query interface is supported as well:
2010              
2011             $sqldb->define_named_query(
2012             'delete_by_name' => 'delete from students where name = ?'
2013             );
2014             $hashes = $sqldb->do_delete(
2015             named_query => [ 'delete_by_name', 'Dave' ]
2016             );
2017              
2018             =back
2019              
2020             =cut
2021              
2022             # $rows = $self->do_delete( %clauses );
2023             sub do_delete {
2024             my $self = shift;
2025             $self->do_sql( $self->sql_delete( @_ ) );
2026             }
2027              
2028             sub sql_delete {
2029             my ( $self, %clauses ) = @_;
2030              
2031             my $keyword = 'delete';
2032             my ($sql, @params);
2033              
2034             if ( my $named = delete $clauses{'named_query'} ) {
2035             my %named = $self->interpret_named_query( ref($named) ? @$named : $named );
2036             %clauses = ( %named, %clauses );
2037             }
2038              
2039             if ( my $action = delete $clauses{'action'} ) {
2040             confess("Action mismatch: expecting $keyword, not $action query")
2041             unless ( $action eq $keyword );
2042             }
2043            
2044             if ( my $literal = delete $clauses{'sql'} ) {
2045             ($sql, @params) = ( ref($literal) eq 'ARRAY' ) ? @$literal : $literal;
2046             if ( my ( $conflict ) = grep $clauses{$_}, qw/ table / ) {
2047             croak("Can't build a $keyword query using both sql and $conflict clauses")
2048             }
2049            
2050             } else {
2051            
2052             my $table = delete $clauses{'table'};
2053             if ( ! $table ) {
2054             confess("Table name is missing or empty");
2055             } elsif ( ! ref( $table ) and length( $table ) ) {
2056             # should be a single table name
2057             } else {
2058             confess("Unsupported table spec '$table'");
2059             }
2060             $sql = "delete from $table";
2061             }
2062            
2063             if ( my $criteria = delete $clauses{'criteria'} || delete $clauses{'where'} ){
2064             ($sql, @params) = $self->sql_where($criteria, $sql, @params);
2065             }
2066            
2067             if ( scalar keys %clauses ) {
2068             confess("Unsupported $keyword clauses: " .
2069             join ', ', map "$_ ('$clauses{$_}')", keys %clauses);
2070             }
2071            
2072             $self->log_sql( $sql, @params );
2073            
2074             return( $sql, @params );
2075             }
2076              
2077             ########################################################################
2078              
2079             ########################################################################
2080              
2081             =head1 NAMED QUERY CATALOG
2082              
2083             The following methods manage a collection of named query definitions.
2084              
2085             =head2 Defining Named Queries
2086              
2087             B Call these methods to load your query definitions.
2088              
2089             =over 4
2090              
2091             =item define_named_queries()
2092              
2093             $sqldb->define_named_query( $query_name, $query_info )
2094             $sqldb->define_named_queries( $query_name, $query_info, ... )
2095             $sqldb->define_named_queries( %query_names_and_info )
2096              
2097             Defines one or more named queries using the names and definitions provided.
2098              
2099             The definition for each query is expected to be in one of the following formats:
2100              
2101             =over 4
2102              
2103             =item *
2104              
2105             A literal SQL string. May contain "?" placeholders whose values will be passed as arguments when the query is run.
2106              
2107             =item *
2108              
2109             A reference to an array of a SQL string and placeholder parameters. Parameters which should later be replaced by per-query arguments can be represented by references to the special Perl variables $1, $2, $3, and so forth, corresponding to the order and number of parameters to be supplied.
2110              
2111             =item *
2112              
2113             A reference to a hash of clauses supported by one of the SQL generation methods. Items which should later be replaced by per-query arguments can be represented by references to the special Perl variables $1, $2, $3, and so forth.
2114              
2115             =item *
2116              
2117             A reference to a subroutine or code block which will process the user-supplied arguments and return either a SQL statement, a reference to an array of a SQL statement and associated parameters, or a list of key-value pairs to be used as clauses by the SQL generation methods.
2118              
2119             =back
2120              
2121              
2122             =item define_named_queries_from_text()
2123              
2124             $sqldb->define_named_queries_from_text($query_name, $query_info_text)
2125             $sqldb->define_named_queries_from_text(%query_names_and_info_text)
2126              
2127             Defines one or more queries, using some special processing to facilitate storing dynamic query definitions in an external source such as a text file or database table.
2128              
2129             The interpretation of each definition is determined by its first non-whitespace character:
2130              
2131             =over 4
2132              
2133             =item *
2134              
2135             Definitions which begin with a [ or { character are presumed to contain an array or hash definition and are evaluated immediately.
2136              
2137             =item *
2138              
2139             Definitions which begin with a " or ; character are presumed to contain a code definition and evaluated as the contents of an anonymous subroutine.
2140              
2141             =item *
2142              
2143             Other definitions are assumed to contain a plain SQL statement.
2144              
2145             =back
2146              
2147             All evaluations are done via a Safe compartment, which is required when this function is first used, so the code is extremely limited and can not call most other functions.
2148              
2149             =back
2150              
2151             =cut
2152              
2153             # $sqldb->define_named_queries( $name, $string_hash_or_sub )
2154             sub define_named_queries {
2155             my $self = shift;
2156             while ( scalar @_ ) {
2157             $self->named_queries( splice( @_, 0, 2 ) )
2158             }
2159             }
2160             sub define_named_query { (shift)->define_named_queries(@_) }
2161              
2162             # $sqldb->define_named_queries_from_text( $name, $string )
2163             sub define_named_queries_from_text {
2164             my $self = shift;
2165             while ( scalar @_ ) {
2166             my ( $name, $text ) = splice( @_, 0, 2 );
2167             my $query_def = do {
2168             if ( $text =~ /^\s*[\[|\{]/ ) {
2169             safe_eval_with_parameters( $text );
2170             } elsif ( $text =~ /^\s*[\"|\;]/ ) {
2171             safe_eval_with_parameters( "sub { $text }" );
2172             } else {
2173             $text
2174             }
2175             };
2176             $self->define_named_queries( $name, $query_def );
2177             }
2178             }
2179              
2180             ########################################################################
2181              
2182             =head2 Interpreting Named Queries
2183              
2184             B These methods are called internally when named queries are used.
2185              
2186             =over 4
2187              
2188             =item named_queries()
2189              
2190             $sqldb->named_queries() : %query_names_and_info
2191             $sqldb->named_queries( $query_name ) : $query_info
2192             $sqldb->named_queries( \@query_names ) : @query_info
2193             $sqldb->named_queries( $query_name, $query_info, ... )
2194             $sqldb->named_queries( \%query_names_and_info )
2195              
2196             Accessor and mutator for a hash mappping query names to their definitions.
2197             Used internally by the other named_query methods. Created with
2198             Class::MakeMethods::Standard::Inheritable, so if called as a class method,
2199             uses class-wide values, and if called on an instance defaults to its class'
2200             value but may be overridden.
2201              
2202             =item named_query()
2203              
2204             $sqldb->named_query( $query_name ) : $query_info
2205              
2206             Retrieves the query definition matching the name provided. Croaks if no query has been defined for that name.
2207              
2208             =item interpret_named_query()
2209              
2210             $sqldb->interpret_named_query( $query_name, @params ) : %clauses
2211              
2212             Combines the query definition matching the name provided with the following arguments and returns the resulting hash of query clauses. Croaks if no query has been defined for that name.
2213              
2214             Depending on the definition associated with the name, it is combined with the provided parameters in one the following ways:
2215              
2216             =over 4
2217              
2218             =item *
2219              
2220             A string. Any user-supplied parameters are assumed to be values for embedded "?"-style placeholders. Any parameters passed to interpret_named_query() are collected with the SQL statement in an array reference and returned as the value of a C key pair for execution. There is no check that the number of parameters match the number of placeholders.
2221              
2222             =item *
2223              
2224             A reference to an array, possibly with embedded placeholders in the C<\$1> style described above. Uses clone_with_parameters() to make and return a copy of the array, substituting the connection parameters in place of the placeholder references. The array reference is returned as the value of a C key pair for execution. An exception is thrown if the number of parameters provided does not match the number of special variables referred to.
2225              
2226             =item *
2227              
2228             A reference to an hash, possibly with embedded placeholders in the C<\$1> style described above. Uses clone_with_parameters() to make and return a copy of the hash, substituting the connection parameters in place of the placeholder references. An exception is thrown if the number of parameters provided does not match the number of special variables referred to.
2229              
2230             =item *
2231              
2232             A reference to a subroutine. The parameters are passed
2233             along to the subroutine and its results returned for execution. The subroutine may return a SQL statement, a reference to an array of a SQL statement and associated parameters, or a list of key-value pairs to be used as clauses by the SQL generation methods.
2234              
2235             =back
2236              
2237             For more information about the parameter replacement and argument count checking, see the clone_with_parameters() function from L.
2238              
2239             =back
2240              
2241             See the Examples section below for illustrations of these various options.
2242              
2243             =cut
2244              
2245             use Class::MakeMethods ( 'Standard::Inheritable:hash' => 'named_queries' );
2246              
2247             # $query_def = $sqldb->named_query( $name )
2248             sub named_query {
2249             my ( $self, $name ) = @_;
2250             $self->named_queries( $name ) or croak("No query named '$name'");
2251             }
2252              
2253             # %clauses = $sqldb->interpret_named_query( $name, @args )
2254             sub interpret_named_query {
2255             my ( $self, $name, @query_args ) = @_;
2256             my $query_def = $self->named_query( $name );
2257             if ( ! $query_def ) {
2258             croak("No definition was provided for named query '$name': $query_def")
2259             } elsif ( ! ref $query_def ) {
2260             return ( sql => [ $query_def, @query_args ] );
2261             } elsif ( ref($query_def) eq 'ARRAY' ) {
2262             return ( sql => clone_with_parameters($query_def, @query_args) );
2263             } elsif ( ref($query_def) eq 'HASH' ) {
2264             return ( %{ clone_with_parameters($query_def, @query_args) } );
2265             } elsif ( ref($query_def) eq 'CODE' ) {
2266             my @results = $query_def->( @query_args );
2267             unshift @results, 'sql' if scalar(@results) == 1;
2268             return @results;
2269             } else {
2270             croak("Unable to interpret definition of named query '$name': $query_def")
2271             }
2272             }
2273              
2274             ########################################################################
2275              
2276             =head2 Executing Named Queries
2277              
2278             Typically, named queries are executed by passing a named_query argument to
2279             one of the primary interface methods such as fetch_select or do_insert, but
2280             there are also several convenience methods for use when you know you will
2281             only be using named queries.
2282              
2283             B These methods provide a simple way to use named queries.
2284              
2285             =over 4
2286              
2287             =item fetch_named_query()
2288              
2289             $sqldb->fetch_named_query( $query_name, @params ) : $rows
2290             $sqldb->fetch_named_query( $query_name, @params ) : ( $rows, $columns )
2291              
2292             Calls fetch_select using the named query and arguments provided.
2293              
2294             =item visit_named_query()
2295              
2296             $sqldb->visit_named_query($query_name, @params, $code) : @results
2297             $sqldb->visit_named_query($code, $query_name, @params) : @results
2298              
2299             Calls visit_select using the named query and arguments provided.
2300              
2301             =item do_named_query()
2302              
2303             $sqldb->do_named_query( $query_name, @params ) : $row_count
2304              
2305             Calls do_query using the named query and arguments provided.
2306              
2307             =back
2308              
2309             B These samples demonstrate use of the named_query feature.
2310              
2311             =over 2
2312              
2313             =item *
2314              
2315             A simple named query can be defined in SQL or as generator clauses:
2316              
2317             $sqldb->define_named_query('all_students', 'select * from students');
2318              
2319             $sqldb->define_named_query('all_students', { table => 'students' });
2320              
2321             The results of a named select query can be retrieved in several equivalent ways:
2322              
2323             $rows = $sqldb->fetch_named_query( 'all_students' );
2324              
2325             $rows = $sqldb->fetch_select( named_query => 'all_students' );
2326              
2327             @rows = $sqldb->visit_select( named_query => 'all_students', sub { $_[0] } );
2328              
2329             =item *
2330              
2331             There are numerous ways of defining a query which accepts parameters; any of the following are basically equivalent:
2332              
2333             $sqldb->define_named_query('student_by_id',
2334             'select * from students where id = ?' );
2335              
2336             $sqldb->define_named_query('student_by_id',
2337             { sql=>['select * from students where id = ?', \$1 ] } );
2338              
2339             $sqldb->define_named_query('student_by_id',
2340             { table=>'students', where=>[ 'id = ?', \$1 ] } );
2341              
2342             $sqldb->define_named_query('student_by_id',
2343             { table=>'students', where=>{ 'id' => \$1 } } );
2344              
2345             $sqldb->define_named_query('student_by_id',
2346             { action=>'select', table=>'students', where=>{ 'id'=>\$1 } } );
2347              
2348             Using a named query with parameters requires that the arguments be passed after the name:
2349              
2350             $rows = $sqldb->fetch_named_query( 'student_by_id', $my_id );
2351              
2352             $rows = $sqldb->fetch_select(named_query=>['student_by_id', $my_id]);
2353              
2354             If the query is defined using a plain string, as in the first line of the student_by_id example, no checking is done to ensure that the correct number of parameters have been passed; the result will depend on your database server, but will presumably be a fatal error. In contrast, the definitions that use the \$1 format will have their parameters counted and arranged before being executed.
2355              
2356             =item *
2357              
2358             Queries which insert, update, or delete can be defined in much the same way as select queries are; again, all of the following are roughly equivalent:
2359              
2360             $sqldb->define_named_query('delete_student',
2361             'delete from students where id = ?');
2362              
2363             $sqldb->define_named_query('delete_student',
2364             [ 'delete from students where id = ?', \$1 ]);
2365              
2366             $sqldb->define_named_query('delete_student',
2367             { action=>'delete', table=>'students', where=>{ id=>\$1 } });
2368              
2369             These modification queries can be invoked with one of the do_ methods:
2370              
2371             $sqldb->do_named_query( 'delete_student', 201 );
2372              
2373             $sqldb->do_query( named_query => [ 'delete_student', 201 ] );
2374              
2375             $sqldb->do_delete( named_query => [ 'delete_student', 201 ] );
2376              
2377             =item *
2378              
2379             Queries can be defined using subroutines:
2380              
2381             $sqldb->define_named_query('name_search', sub {
2382             my $name = lc( shift );
2383             return "select * from students where name like '%$name%'"
2384             });
2385              
2386             $rows = $sqldb->fetch_named_query( 'name_search', 'DAV' );
2387              
2388             =item *
2389              
2390             Query definitions can be stored in external text files or database tables and then evaluated into data structures or code references. The below code loads a simple text file of query definitions
2391              
2392             open( QUERIES, '/path/to/my/queries' );
2393             my %queries = map { split /\:\s*/, $_, 2 } grep { /^[^#]/ } ;
2394             close QUERIES;
2395              
2396             $sqldb->define_named_queries_from_text( %queries );
2397              
2398             Placing the following text in the target file will define all of the queries used above:
2399              
2400             # Simple query that doesn't take any parameters
2401             all_students: select * from students
2402            
2403             # Query with one required parameter
2404             student_by_id: [ 'select * from students where id = ?', \$1 ]
2405              
2406             # Generated query using hash format
2407             delete_student: { action=>'delete', table=>'students', where=>{ id=>\$1 } }
2408            
2409             # Perl expression to be turned into a query generating subroutine
2410             name_search: "select * from students where name like '%\L$_[0]\E%'"
2411              
2412             =back
2413              
2414             =cut
2415              
2416             # ( $row_hashes, $column_hashes ) = $sqldb->fetch_named_query( $name, @args )
2417             sub fetch_named_query {
2418             (shift)->fetch_select( named_query => [ @_ ] );
2419             }
2420              
2421             # @results = $sqldb->visit_named_query( $name, @args, $code_ref )
2422             sub visit_named_query {
2423             (shift)->visit_select( ( ref($_[0]) ? shift : pop ), named_query => [ @_ ] );
2424             }
2425              
2426             # $result = $sqldb->do_named_query( $name, @args )
2427             sub do_named_query {
2428             (shift)->do_query( named_query => [ @_ ] );
2429             }
2430              
2431             ########################################################################
2432              
2433             # $row_count = $sqldb->do_query( %clauses );
2434             sub do_query {
2435             my ( $self, %clauses ) = @_;
2436              
2437             if ( my $named = delete $clauses{'named_query'} ) {
2438             my %named = $self->interpret_named_query( ref($named) ? @$named : $named );
2439             %clauses = ( %named, %clauses );
2440             }
2441              
2442             my ($sql, @params);
2443             if ( my $action = delete $clauses{'action'} ) {
2444             my $method = "sql_$action";
2445             ($sql, @params) = $self->$method( %clauses );
2446              
2447             } elsif ( my $literal = delete $clauses{'sql'} ) {
2448             ($sql, @params) = ( ref($literal) eq 'ARRAY' ) ? @$literal : $literal;
2449            
2450             } else {
2451             croak( "Can't call do_query without either action or sql clauses" );
2452             }
2453              
2454             $self->do_sql( $sql, @params );
2455             }
2456              
2457             ########################################################################
2458              
2459             ########################################################################
2460              
2461             =head1 DEFINING STRUCTURES (SQL DDL)
2462              
2463             The schema of a DBI database is controlled through the Data Definition Language features of SQL.
2464              
2465             =head2 Detect Tables and Columns
2466              
2467             B These methods provide information about existing tables.
2468              
2469             =over 4
2470              
2471             =item detect_table_names()
2472              
2473             $sqldb->detect_table_names () : @table_names
2474              
2475             Attempts to collect a list of the available tables in the database we have connected to. Uses the DBI tables() method.
2476              
2477             =item detect_table()
2478              
2479             $sqldb->detect_table ( $tablename ) : @columns_or_empty
2480             $sqldb->detect_table ( $tablename, 1 ) : @columns_or_empty
2481              
2482             Attempts to query the given table without retrieving many (or any) rows. Uses a server-specific "trivial" or "guaranteed" query provided by sql_detect_any.
2483              
2484             If succssful, the columns contained in this table are returned as an array of hash references, as described in the Column Information section below.
2485              
2486             Catches any exceptions; if the query fails for any reason we return an empty list. The reason for the failure is logged via warn() unless an additional argument with a true value is passed to surpress those error messages.
2487              
2488             =back
2489              
2490             B These methods are called by the public detect methods.
2491              
2492             =over 4
2493              
2494             =item sql_detect_table()
2495              
2496             $sqldb->sql_detect_table ( $tablename ) : %sql_select_clauses
2497              
2498             Subclass hook. Retrieve something from the given table that is guaranteed to exist but does not return many rows, without knowning its table structure.
2499              
2500             Defaults to "select * from table where 1 = 0", which may not work on all platforms. Your subclass might prefer "select * from table limit 1" or a local equivalent.
2501              
2502             =back
2503              
2504             =cut
2505              
2506             sub detect_table_names {
2507             my $self = shift;
2508             $self->get_dbh()->tables();
2509             }
2510              
2511             sub detect_table {
2512             my $self = shift;
2513             my $tablename = shift;
2514             my $quietly = shift;
2515             my @sql;
2516             my $columns;
2517             eval {
2518             local $SIG{__DIE__};
2519             @sql = $self->sql_detect_table( $tablename );
2520             ( my($rows), $columns ) = $self->fetch_select( @sql );
2521             };
2522             if ( ! $@ ) {
2523             return @$columns;
2524             } else {
2525             warn "Unable to detect_table $tablename: $@" unless $quietly;
2526             return;
2527             }
2528             }
2529              
2530             sub sql_detect_table {
2531             my ($self, $tablename) = @_;
2532              
2533             # Your subclass might prefer one of these...
2534             # return ( sql => "select * from $tablename limit 1" )
2535             # return ( sql => "select * from $tablename where 1 = 0" )
2536            
2537             return (
2538             table => $tablename,
2539             where => '1 = 0',
2540             )
2541             }
2542              
2543             ########################################################################
2544              
2545             =head2 Create and Drop Tables
2546              
2547             B These methods attempt to create and drop tables.
2548              
2549             =over 4
2550              
2551             =item create_table()
2552              
2553             $sqldb->create_table( $tablename, $column_hash_ary )
2554              
2555             Create a table.
2556              
2557             The columns to be created in this table are defined as an array of hash references, as described in the Column Information section below.
2558              
2559             =item drop_table()
2560              
2561             $sqldb->drop_table( $tablename )
2562              
2563             Delete the named table.
2564              
2565             =back
2566              
2567             =cut
2568              
2569             # $rows = $self->create_table( $tablename, $columns );
2570             sub create_table {
2571             my $self = shift;
2572             $self->do_sql( $self->sql_create_table( @_ ) );
2573             }
2574             sub do_create_table { &create_table }
2575              
2576             # $rows = $self->drop_table( $tablename );
2577             sub drop_table {
2578             my $self = shift;
2579             $self->do_sql( $self->sql_drop_table( @_ ) );
2580             }
2581             sub do_drop_table { &drop_table }
2582              
2583             =pod
2584              
2585             B: The information about columns is presented as an array of hash references, each containing the following keys:
2586              
2587             =over 4
2588              
2589             =item *
2590              
2591             C $column_name_string>
2592              
2593             Defines the name of the column.
2594              
2595             B No case or length restrictions are imposed on column names, but for incresased compatibility, you may wish to stick with single-case strings of moderate length.
2596              
2597             =item *
2598              
2599             C $column_type_constant_string>
2600              
2601             Specifies the type of column to create. Discussed further below.
2602              
2603             =item *
2604              
2605             C $not_nullable_boolean>
2606              
2607             Indicates whether a value for this column is required; if not, unspecified or undefined values will be stored as NULL values. Defaults to false.
2608              
2609             =item *
2610              
2611             C $max_chars_integer>
2612              
2613             Only applicable to column of C 'text'>.
2614              
2615             Indicates the maximum number of ASCII characters that can be stored in this column.
2616              
2617             =back
2618              
2619             B The above public methods use the following sql_ methods to generate SQL DDL statements.
2620              
2621             =over 4
2622              
2623             =item sql_create_table()
2624              
2625             $sqldb->sql_create_table ($tablename, $columns) : $sql_stmt
2626              
2627             Generate a SQL create-table statement based on the column information. Text columns are checked with sql_create_column_text_length() to provide server-appropriate types.
2628              
2629             =item sql_create_columns()
2630              
2631             $sqldb->sql_create_columns( $column, $fragment_array_ref ) : $sql_fragment
2632              
2633             Generates the SQL fragment to define a column in a create table statement.
2634              
2635             =item sql_drop_table()
2636              
2637             $sqldb->sql_drop_table ($tablename) : $sql_stmt
2638              
2639             =back
2640              
2641             =cut
2642              
2643             sub sql_create_table {
2644             my($self, $table, $columns) = @_;
2645            
2646             my @sql_columns;
2647             foreach my $column ( @$columns ) {
2648             push @sql_columns, $self->sql_create_columns($table, $column, \@sql_columns)
2649             }
2650            
2651             my $sql = "create table $table ( \n" . join(",\n", @sql_columns) . "\n)\n";
2652            
2653             $self->log_sql( $sql );
2654             return $sql;
2655             }
2656              
2657             sub sql_create_columns {
2658             my($self, $table, $column, $columns) = @_;
2659             my $name = $column->{name};
2660             my $type = $self->sql_create_column_type( $table, $column, $columns ) ;
2661             if ( $type eq 'primary' ) {
2662             return "PRIMARY KEY ($name)";
2663             } else {
2664             return ' ' . $name .
2665             ' ' x ( ( length($name) > 31 ) ? 1 : ( 32 - length($name) ) ) .
2666             $type .
2667             ( $column->{required} ? " not null" : '' );
2668             }
2669             }
2670              
2671             sub sql_drop_table {
2672             my ($self, $table) = @_;
2673             my $sql = "drop table $table";
2674             $self->log_sql( $sql );
2675             return $sql;
2676             }
2677              
2678             ########################################################################
2679              
2680             =head2 Column Type Methods
2681              
2682             The following methods are used by sql_create_table to specify column information in a DBMS-specific fashion.
2683              
2684             B These methods are used to build create table statements.
2685              
2686             =over 4
2687              
2688             =item sql_create_column_type()
2689              
2690             $sqldb->sql_create_column_type ( $table, $column, $columns ) : $col_type_str
2691              
2692             Returns an appropriate
2693              
2694             =item dbms_create_column_types()
2695              
2696             $sqldb->dbms_create_column_types () : %column_type_codes
2697              
2698             Subclass hook. Defaults to empty. Should return a hash mapping column type codes to the specific strings used in a SQL create statement for such a column.
2699              
2700             Subclasses should provide at least two entries, for the symbolic types referenced elsewhere in this interface, "sequential" and "binary".
2701              
2702             =item sql_create_column_text_length()
2703              
2704             $sqldb->sql_create_column_text_length ( $length ) : $col_type_str
2705              
2706             Returns "varchar(length)" for values under 256, otherwise calls dbms_create_column_text_long_type.
2707              
2708             =item dbms_create_column_text_long_type()
2709              
2710             $sqldb->dbms_create_column_text_long_type () : $col_type_str
2711              
2712             Fails with message "DBMS-Specific Function".
2713              
2714             Subclasses should, based on the datasource's server_type, return the appropriate type of column for long text values, such as "BLOB", "TEXT", "LONGTEXT", or "MEMO".
2715              
2716             =back
2717              
2718             =cut
2719              
2720             sub sql_create_column_type {
2721             my($self, $table, $column, $columns) = @_;
2722             my $type = $column->{type};
2723            
2724             my %dbms_types = $self->dbms_create_column_types;
2725             if ( my $dbms_type = $dbms_types{ $type } ) {
2726             $type = $dbms_type;
2727             }
2728            
2729             if ( $type eq 'text' ) {
2730             $type = $self->sql_create_column_text_length( $column->{length} || 255 ) ;
2731             } elsif ( $type eq 'binary' ) {
2732             $type = $self->sql_create_column_text_length( $column->{length} || 65535 ) ;
2733             }
2734            
2735             return $type;
2736             }
2737              
2738             sub sql_create_column_text_length {
2739             my $self = shift;
2740             my $length = shift;
2741              
2742             return "varchar($length)" if ($length < 256);
2743             return $self->dbms_create_column_text_long_type;
2744             }
2745              
2746             sub dbms_create_column_text_long_type {
2747             confess("DBMS-Specific Function")
2748             }
2749              
2750             sub dbms_create_column_types {
2751             return ()
2752             }
2753              
2754             ########################################################################
2755              
2756             =head2 Generating Schema and Record Objects
2757              
2758             The object mapping layer provides classes for Record, Table and Column objects which fetch and store information from a SQLEngine Driver.
2759              
2760             Those objects relies on a Driver, typically passed to their constructor or initializer. The following convenience methods let you start this process from your current SQLEngine Driver object.
2761              
2762             B The following methods provide access to objects
2763             which represent tables, columns and records in a given Driver. They
2764             each ensure the necessary classes are loaded using require().
2765              
2766             =over 4
2767              
2768             =item tables()
2769              
2770             $sqldb->tables() : $tableset
2771              
2772             Returns a new DBIx::SQLEngine::Schema::TableSet object containing table objects with the names discovered by detect_table_names(). See L for more information on this object's interface.
2773              
2774             =item table()
2775              
2776             $sqldb->table( $tablename ) : $table
2777              
2778             Returns a new DBIx::SQLEngine::Schema::Table object with this SQLEngine Driver and the given table name. See L for more information on this object's interface.
2779              
2780             =item record_class()
2781              
2782             $sqldb->record_class( $tablename ) : $record_class
2783             $sqldb->record_class( $tablename, $classname ) : $record_class
2784             $sqldb->record_class( $tablename, $classname, @traits ) : $record_class
2785              
2786             Generates a Record::Class which corresponds to the given table name. Note that the record class is a class name, not an object. If no class name is provided, one is generated based on the table name. See L for more information on this object's interface.
2787              
2788             =back
2789              
2790             =cut
2791              
2792             sub tables {
2793             my $self = shift;
2794             require DBIx::SQLEngine::Schema::TableSet;
2795             DBIx::SQLEngine::Schema::TableSet->new(
2796             map { $self->table( $_ ) } $self->detect_table_names
2797             )
2798             }
2799              
2800             sub table {
2801             require DBIx::SQLEngine::Schema::Table;
2802             DBIx::SQLEngine::Schema::Table->new( sqlengine => (shift), name => (shift) )
2803             }
2804              
2805             sub record_class {
2806             (shift)->table( shift )->record_class( @_ )
2807             }
2808              
2809             ########################################################################
2810              
2811             ########################################################################
2812              
2813             =head1 ADVANCED CAPABILITIES
2814              
2815             Not all of the below capabilities will be available on all database servers.
2816              
2817             For application reliability, call the relevant *_unsupported methods to confirm that the database you've connected to has the capabilities you require, and either exit with a warning or use some type of fallback strategy if they are not.
2818              
2819             =head2 Database Capability Information
2820              
2821             Note: this feature has been added recently, and the interface is subject to change.
2822              
2823             The following methods all default to returning undef, but may be overridden by subclasses to return a true or false value, indicating whether their connection has this limitation.
2824              
2825             B These methods return driver class capability information.
2826              
2827             =over 4
2828              
2829             =item dbms_detect_tables_unsupported()
2830              
2831             Can the database driver return a list of tables that currently exist? (True for some simple drivers like CSV.)
2832              
2833             =item dbms_joins_unsupported()
2834              
2835             Does the database driver support select statements with joins across multiple tables? (True for some simple drivers like CSV.)
2836              
2837             =item dbms_union_unsupported()
2838              
2839             Does the database driver support select queries with unions to join the results of multiple select statements? (True for many simple databases.)
2840              
2841             =item dbms_drop_column_unsupported()
2842              
2843             Does the database driver have a problem removing a column from an existing table? (True for Postgres.)
2844              
2845             =item dbms_column_types_unsupported()
2846              
2847             Does the database driver store column type information, or are all columns the same type? (True for some simple drivers like CSV.)
2848              
2849             =item dbms_null_becomes_emptystring()
2850              
2851             Does the database driver automatically convert null values in insert and update statements to empty strings? (True for some simple drivers like CSV.)
2852              
2853             =item dbms_emptystring_becomes_null()
2854              
2855             Does the database driver automatically convert empty strings in insert and update statements to null values? (True for Oracle.)
2856              
2857             =item dbms_placeholders_unsupported()
2858              
2859             Does the database driver support having ? placehoders or not? (This is a problem for Linux users of DBD::Sybase connecting to MS SQL Servers on Windows.)
2860              
2861             =item dbms_transactions_unsupported()
2862              
2863             Does the database driver support real transactions with rollback and commit or not?
2864              
2865             =item dbms_multi_sth_unsupported()
2866              
2867             Does the database driver support having multiple statement handles active at once or not? (This is a problem for several types of drivers.)
2868              
2869             =item dbms_indexes_unsupported()
2870              
2871             Does the database driver support server-side indexes or not?
2872              
2873             =item dbms_storedprocs_unsupported()
2874              
2875             Does the database driver support server-side stored procedures or not?
2876              
2877             =back
2878              
2879             =cut
2880              
2881             sub dbms_select_table_as_unsupported { undef }
2882              
2883             sub dbms_joins_unsupported { undef }
2884             sub dbms_join_on_unsupported { undef }
2885             sub dbms_outer_join_unsupported { undef }
2886              
2887             sub dbms_union_unsupported { undef }
2888              
2889             sub dbms_detect_tables_unsupported { undef }
2890             sub dbms_drop_column_unsupported { undef }
2891              
2892             sub dbms_column_types_unsupported { undef }
2893             sub dbms_null_becomes_emptystring { undef }
2894             sub dbms_emptystring_becomes_null { undef }
2895              
2896             sub dbms_placeholders_unsupported { undef }
2897             sub dbms_multi_sth_unsupported { undef }
2898              
2899             sub dbms_transactions_unsupported { undef }
2900             sub dbms_indexes_unsupported { undef }
2901             sub dbms_storedprocs_unsupported { undef }
2902              
2903             ########################################################################
2904              
2905             =head2 Begin, Commit and Rollback Transactions
2906              
2907             Note: this feature has been added recently, and the interface is subject to change.
2908              
2909             DBIx::SQLEngine assumes auto-commit is on by default, so unless otherwise specified, each query is executed as a separate transaction. To execute multiple queries within a single transaction, use the as_one_transaction method.
2910              
2911             B These methods invoke transaction functionality.
2912              
2913             =over 4
2914              
2915             =item are_transactions_supported()
2916              
2917             $boolean = $sqldb->are_transactions_supported( );
2918              
2919             Checks to see if the database has transaction support.
2920              
2921             =item as_one_transaction()
2922              
2923             @results = $sqldb->as_one_transaction( $sub_ref, @args );
2924              
2925             Starts a transaction, calls the given subroutine with any arguments provided,
2926             and then commits the transaction; if an exception occurs, the transaction is
2927             rolled back instead. Will fail if we don't have transaction support.
2928              
2929             For example:
2930              
2931             my $sqldb = DBIx::SQLEngine->new( ... );
2932             $sqldb->as_one_transaction( sub {
2933             $sqldb->do_insert( ... );
2934             $sqldb->do_update( ... );
2935             $sqldb->do_delete( ... );
2936             } );
2937              
2938             Or using a reference to a predefined subroutine:
2939              
2940             sub do_stuff {
2941             my $sqldb = shift;
2942             $sqldb->do_insert( ... );
2943             $sqldb->do_update( ... );
2944             $sqldb->do_delete( ... );
2945             1;
2946             }
2947            
2948             my $sqldb = DBIx::SQLEngine->new( ... );
2949             $sqldb->as_one_transaction( \&do_stuff, $sqldb )
2950             or warn "Unable to complete transaction";
2951              
2952             =item as_one_transaction_if_supported()
2953              
2954             @results = $sqldb->as_one_transaction_if_supported($sub_ref, @args)
2955              
2956             If transaction support is available, this is equivalent to as_one_transaction.
2957             If transactions are not supported, simply performs the code in $sub_ref with
2958             no transaction protection.
2959              
2960             This is obviously not very reliable, but may be of use in some ad-hoc utilities or test scripts.
2961              
2962             =back
2963              
2964             =cut
2965              
2966             sub are_transactions_supported {
2967             my $self = shift;
2968             my $dbh = $self->get_dbh;
2969             eval {
2970             local $SIG{__DIE__};
2971             $dbh->begin_work;
2972             $dbh->rollback;
2973             };
2974             return ( $@ ) ? 0 : 1;
2975             }
2976              
2977             sub as_one_transaction {
2978             my $self = shift;
2979             my $code = shift;
2980              
2981             my $dbh = $self->get_dbh;
2982             my @results;
2983             $dbh->begin_work;
2984             my $wantarray = wantarray(); # Capture before eval which otherwise obscures it
2985             eval {
2986             local $SIG{__DIE__};
2987             @results = $wantarray ? &$code( @_ ) : scalar( &$code( @_ ) );
2988             $dbh->commit;
2989             };
2990             if ($@) {
2991             warn "DBIx::SQLEngine Transaction Aborted: $@";
2992             $dbh->rollback;
2993             }
2994             $wantarray ? @results : $results[0]
2995             }
2996              
2997             sub as_one_transaction_if_supported {
2998             my $self = shift;
2999             my $code = shift;
3000            
3001             my $dbh = $self->get_dbh;
3002             my @results;
3003             my $in_transaction;
3004             my $wantarray = wantarray(); # Capture before eval which otherwise obscures it
3005             eval {
3006             local $SIG{__DIE__};
3007             $dbh->begin_work;
3008             $in_transaction = 1;
3009             };
3010             eval {
3011             local $SIG{__DIE__};
3012             @results = $wantarray ? &$code( @_ ) : scalar( &$code( @_ ) );
3013             $dbh->commit if ( $in_transaction );
3014             };
3015             if ($@) {
3016             warn "DBIx::SQLEngine Transaction Aborted: $@";
3017             $dbh->rollback if ( $in_transaction );
3018             }
3019             $wantarray ? @results : $results[0]
3020             }
3021              
3022             ########################################################################
3023              
3024             =head2 Create and Drop Indexes
3025              
3026             Note: this feature has been added recently, and the interface is subject to change.
3027              
3028             B These methods create and drop indexes.
3029              
3030             =over 4
3031              
3032             =item create_index()
3033              
3034             $sqldb->create_index( %clauses )
3035              
3036             =item drop_index()
3037              
3038             $sqldb->drop_index( %clauses )
3039              
3040             =back
3041              
3042             B These methods are called by the public index methods.
3043              
3044             =over 4
3045              
3046             =item sql_create_index()
3047              
3048             $sqldb->sql_create_index( %clauses ) : $sql, @params
3049              
3050             =item sql_drop_index()
3051              
3052             $sqldb->sql_drop_index( %clauses ) : $sql, @params
3053              
3054             =back
3055              
3056             B These samples demonstrate use of the index feature.
3057              
3058             =over 2
3059              
3060             =item *
3061              
3062             $sqldb->create_index(
3063             table => $table_name, columns => @columns
3064             );
3065              
3066             $sqldb->drop_index(
3067             table => $table_name, columns => @columns
3068             );
3069              
3070             =item *
3071              
3072             $sqldb->create_index(
3073             name => $index_name, table => $table_name, columns => @columns
3074             );
3075              
3076             $sqldb->drop_index(
3077             name => $index_name
3078             );
3079              
3080             =back
3081              
3082             =cut
3083              
3084             sub create_index {
3085             my $self = shift;
3086             $self->do_sql( $self->sql_create_index( @_ ) );
3087             }
3088              
3089             sub drop_index {
3090             my $self = shift;
3091             $self->do_sql( $self->sql_drop_index( @_ ) );
3092             }
3093              
3094             sub sql_create_index {
3095             my ( $self, %clauses ) = @_;
3096              
3097             my $keyword = 'create';
3098             my $obj_type = 'index';
3099            
3100             my $table = delete $clauses{'table'};
3101             if ( ! $table ) {
3102             confess("Table name is missing or empty");
3103             } elsif ( ! ref( $table ) and length( $table ) ) {
3104             # should be a single table name
3105             } else {
3106             confess("Unsupported table spec '$table'");
3107             }
3108              
3109             my $columns = delete $clauses{'column'} || delete $clauses{'columns'};
3110             if ( ! $columns ) {
3111             confess("Column names is missing or empty");
3112             } elsif ( ! ref( $columns ) and length( $columns ) ) {
3113             # should be one or more comma-separated column names
3114             } elsif ( UNIVERSAL::can($columns, 'column_names') ) {
3115             $columns = join ', ', $columns->column_names;
3116             } elsif ( ref($columns) eq 'ARRAY' ) {
3117             $columns = join ', ', @$columns;
3118             } else {
3119             confess("Unsupported column spec '$columns'");
3120             }
3121            
3122             my $name = delete $clauses{'name'};
3123             if ( ! $name ) {
3124             $name = join('_', $table, split(/\,\s*/, $columns), 'idx');
3125             } elsif ( ! ref( $name ) and length( $name ) ) {
3126             # should be an index name
3127             } else {
3128             confess("Unsupported name spec '$name'");
3129             }
3130            
3131             if ( my $unique = delete $clauses{'unique'} ) {
3132             $obj_type = "unique index";
3133             }
3134            
3135             return "$keyword $obj_type $name on $table ( $columns )";
3136             }
3137              
3138             sub sql_drop_index {
3139             my ( $self, %clauses ) = @_;
3140              
3141             my $keyword = 'create';
3142             my $obj_type = 'index';
3143            
3144             my $name = delete $clauses{'name'};
3145             if ( ! $name ) {
3146             my $table = delete $clauses{'table'};
3147             if ( ! $table ) {
3148             confess("Table name is missing or empty");
3149             } elsif ( ! ref( $table ) and length( $table ) ) {
3150             # should be a single table name
3151             } else {
3152             confess("Unsupported table spec '$table'");
3153             }
3154            
3155             my $columns = delete $clauses{'column'} || delete $clauses{'columns'};
3156             if ( ! $columns ) {
3157             confess("Column names is missing or empty");
3158             } elsif ( ! ref( $columns ) and length( $columns ) ) {
3159             # should be one or more comma-separated column names
3160             } elsif ( UNIVERSAL::can($columns, 'column_names') ) {
3161             $columns = join ', ', $columns->column_names;
3162             } elsif ( ref($columns) eq 'ARRAY' ) {
3163             $columns = join ', ', @$columns;
3164             } else {
3165             confess("Unsupported column spec '$columns'");
3166             }
3167              
3168             $name = join('_', $table, split(/\,\s*/, $columns), 'idx');
3169             } elsif ( ! ref( $name ) and length( $name ) ) {
3170             # should be an index name
3171             } else {
3172             confess("Unsupported name spec '$name'");
3173             }
3174              
3175             return "$keyword $obj_type $name";
3176             }
3177              
3178             ########################################################################
3179              
3180             =head2 Call, Create and Drop Stored Procedures
3181              
3182             Note: this feature has been added recently, and the interface is subject to change.
3183              
3184             These methods are all subclass hooks. Fail with message "DBMS-Specific Function".
3185              
3186             B These methods create, drop, and use stored procedures.
3187              
3188             =over 4
3189              
3190             =item fetch_storedproc()
3191              
3192             $sqldb->fetch_storedproc( $proc_name, @arguments ) : $rows
3193              
3194             =item do_storedproc()
3195              
3196             $sqldb->do_storedproc( $proc_name, @arguments ) : $row_count
3197              
3198             =item create_storedproc()
3199              
3200             $sqldb->create_storedproc( $proc_name, $definition )
3201              
3202             =item drop_storedproc()
3203              
3204             $sqldb->drop_storedproc( $proc_name )
3205              
3206             =back
3207              
3208             =cut
3209              
3210             sub fetch_storedproc { confess("DBMS-Specific Function") }
3211             sub do_storedproc { confess("DBMS-Specific Function") }
3212             sub create_storedproc { confess("DBMS-Specific Function") }
3213             sub drop_storedproc { confess("DBMS-Specific Function") }
3214              
3215             ########################################################################
3216              
3217             =head2 Create and Drop Databases
3218              
3219             Note: this feature has been added recently, and the interface is subject to change.
3220              
3221             B These methods create and drop database partitions.
3222              
3223             =over 4
3224              
3225             =item create_database()
3226              
3227             $sqldb->create_database( $db_name )
3228              
3229             Fails with message "DBMS-Specific Function".
3230              
3231             =item drop_database()
3232              
3233             $sqldb->drop_database( $db_name )
3234              
3235             Fails with message "DBMS-Specific Function".
3236              
3237             =back
3238              
3239             =cut
3240              
3241             sub create_database { confess("DBMS-Specific Function") }
3242             sub drop_database { confess("DBMS-Specific Function") }
3243              
3244             sub sql_create_database {
3245             my ( $self, $name ) = @_;
3246             return "create database $name"
3247             }
3248              
3249             sub sql_drop_database {
3250             my ( $self, $name ) = @_;
3251             return "drop database $name"
3252             }
3253              
3254             ########################################################################
3255              
3256             ########################################################################
3257              
3258             =head1 CONNECTION METHODS (DBI DBH)
3259              
3260             The following methods manage the DBI database handle through which we communicate with the datasource.
3261              
3262             =head2 Accessing the DBH
3263              
3264             B You may use these methods to perform your own low-level DBI access.
3265              
3266             =over 4
3267              
3268             =item get_dbh()
3269              
3270             $sqldb->get_dbh () : $dbh
3271              
3272             Get the current DBH
3273              
3274             =item dbh_func()
3275              
3276             $sqldb->dbh_func ( $func_name, @args ) : @results
3277              
3278             Calls the DBI func() method on the database handle returned by get_dbh, passing the provided function name and arguments. See the documentation for your DBD driver to learn which functions it supports.
3279              
3280             =back
3281              
3282             =cut
3283              
3284             sub get_dbh {
3285             # maybe add code here to check connection status.
3286             # or maybe add check once every 10 get_dbh's...
3287             my $self = shift;
3288             ( ref $self ) or ( confess("Not a class method") );
3289             return $self->{dbh};
3290             }
3291              
3292             sub dbh_func {
3293             my $self = shift;
3294             my $dbh = $self->get_dbh;
3295             my $func = shift;
3296             $dbh->func( $func, @_ );
3297             }
3298              
3299             ########################################################################
3300              
3301             =head2 Initialization and Reconnection
3302              
3303             B These methods are invoked automatically.
3304              
3305             =over 4
3306              
3307             =item _init()
3308              
3309             $sqldb->_init ()
3310              
3311             Empty subclass hook. Called by DBIx::AnyDBD after connection is made and class hierarchy has been juggled.
3312              
3313             =item reconnect()
3314              
3315             $sqldb->reconnect ()
3316              
3317             Attempt to re-establish connection with original parameters
3318              
3319             =back
3320              
3321             =cut
3322              
3323             sub _init { }
3324              
3325             sub reconnect {
3326             my $self = shift;
3327             my $reconnector = $self->{'reconnector'}
3328             or croak("Can't reconnect; reconnector is missing");
3329             if ( $self->{'dbh'} ) {
3330             $self->{'dbh'}->disconnect;
3331             }
3332             $self->{'dbh'} = &$reconnector()
3333             or croak("Can't reconnect; reconnector returned nothing");
3334             $self->rebless;
3335             $self->_init if $self->can('_init');
3336             return $self;
3337             }
3338              
3339             ########################################################################
3340              
3341             =head2 Checking For Connection
3342              
3343             To determine if the connection is working.
3344              
3345             B These methods are invoked automatically.
3346              
3347             =over 4
3348              
3349             =item detect_any()
3350              
3351             $sqldb->detect_any () : $boolean
3352             $sqldb->detect_any ( 1 ) : $boolean
3353              
3354             Attempts to confirm that values can be retreived from the database,
3355             allowing us to determine if the connection is working, using a
3356             server-specific "trivial" or "guaranteed" query provided by
3357             sql_detect_any.
3358              
3359             Catches any exceptions; if the query fails for any reason we return
3360             a false value. The reason for the failure is logged via warn()
3361             unless an additional argument with a true value is passed to surpress
3362             those error messages.
3363              
3364             =item sql_detect_any()
3365              
3366             $sqldb->sql_detect_any : %sql_select_clauses
3367              
3368             Subclass hook. Retrieve something from the database that is guaranteed to exist.
3369             Defaults to SQL literal "select 1", which may not work on all platforms. Your database driver might prefer something else, like Oracle's "select 1 from dual".
3370              
3371             =item check_or_reconnect()
3372              
3373             $sqldb->check_or_reconnect () : $dbh
3374              
3375             Confirms the current DBH is available with detect_any() or calls reconnect().
3376              
3377             =back
3378              
3379             =cut
3380              
3381             sub detect_any {
3382             my $self = shift;
3383             my $quietly = shift;
3384             my $result = 0;
3385             eval {
3386             local $SIG{__DIE__};
3387             $self->fetch_one_value($self->sql_detect_any);
3388             $result = 1;
3389             };
3390             $result or warn "Unable to detect_any: $@" unless $quietly;
3391             return $result;
3392             }
3393              
3394             sub sql_detect_any {
3395             return ( sql => 'select 1' )
3396             }
3397              
3398             sub check_or_reconnect {
3399             my $self = shift;
3400             $self->detect_any or $self->reconnect;
3401             $self->get_dbh or confess("Failed to get_dbh after check_or_reconnect")
3402             }
3403              
3404             ########################################################################
3405              
3406             ########################################################################
3407              
3408             =head1 STATEMENT METHODS (DBI STH)
3409              
3410             The following methods manipulate DBI statement handles as part of processing queries and their results.
3411              
3412             B These methods allow arbitrary SQL statements to be executed.
3413             Note that no processing of the SQL query string is performed, so if you call
3414             these low-level functions it is up to you to ensure that the query is correct
3415             and will function as expected when passed to whichever data source the
3416             SQLEngine Driver is using.
3417              
3418             =cut
3419              
3420             ########################################################################
3421              
3422             =head2 Generic Query Execution
3423              
3424             $db->do_sql('insert into table values (?, ?)', 'A', 1);
3425             my $rows = $db->fetch_sql('select * from table where status = ?', 2);
3426              
3427             Execute and fetch some kind of result from a given SQL statement. Internally, these methods are used by the other do_, fetch_ and visit_ methods described above. Each one calls the try_query method with the provided query and parameters, and passes the name of a result method to be used in extracting values from the statement handle.
3428              
3429             B
3430              
3431             =over 4
3432              
3433             =item do_sql()
3434              
3435             $sqldb->do_sql ($sql, @params) : $rowcount
3436              
3437             Execute a SQL query by sending it to the DBI connection, and returns the number of rows modified, or -1 if unknown.
3438              
3439             =item fetch_sql()
3440              
3441             $sqldb->fetch_sql ($sql, @params) : $row_hash_ary
3442             $sqldb->fetch_sql ($sql, @params) : ( $row_hash_ary, $columnset )
3443              
3444             Execute a SQL query by sending it to the DBI connection, and returns any rows that were produced, as an array of hashrefs, with the values in each entry keyed by column name. If called in a list context, also returns a reference to an array of information about the columns returned by the query.
3445              
3446             =item fetch_sql_rows()
3447              
3448             $sqldb->fetch_sql_rows ($sql, @params) : $row_ary_ary
3449             $sqldb->fetch_sql_rows ($sql, @params) : ( $row_ary_ary, $columnset )
3450              
3451             Execute a SQL query by sending it to the DBI connection, and returns any rows that were produced, as an array of arrayrefs, with the values in each entry keyed by column order. If called in a list context, also returns a reference to an array of information about the columns returned by the query.
3452              
3453             =item visit_sql()
3454              
3455             $sqldb->visit_sql ($coderef, $sql, @params) : @results
3456             $sqldb->visit_sql ($sql, @params, $coderef) : @results
3457              
3458             Similar to fetch_sql, but calls your coderef on each row, passing it as a hashref, and returns the results of each of those calls. For your convenience, will accept a coderef as either the first or the last argument.
3459              
3460             =item visit_sql_rows()
3461              
3462             $sqldb->visit_sql ($coderef, $sql, @params) : @results
3463             $sqldb->visit_sql ($sql, @params, $coderef) : @results
3464              
3465             Similar to fetch_sql, but calls your coderef on each row, passing it as a list of values, and returns the results of each of those calls. For your convenience, will accept a coderef as either the first or the last argument.
3466              
3467             =item fetchsub_sql()
3468              
3469             $sqldb->fetchsub_sql ($sql, @params) : $coderef
3470              
3471             Execute a SQL query by sending it to the DBI connection, and returns a code reference that can be called repeatedly to invoke the fetchrow_hashref() method on the statement handle.
3472              
3473             =item fetchsub_sql_rows()
3474              
3475             $sqldb->fetchsub_sql_rows ($sql, @params) : $coderef
3476              
3477             Execute a SQL query by sending it to the DBI connection, and returns a code reference that can be called repeatedly to invoke the fetchrow_array() method on the statement handle.
3478              
3479              
3480             =back
3481              
3482             =cut
3483              
3484             # $rowcount = $self->do_sql($sql);
3485             # $rowcount = $self->do_sql($sql, @params);
3486             sub do_sql {
3487             (shift)->try_query( (shift), [ @_ ], 'get_execute_rowcount' )
3488             }
3489              
3490             # $array_of_hashes = $self->fetch_sql($sql);
3491             # $array_of_hashes = $self->fetch_sql($sql, @params);
3492             # ($array_of_hashes, $columns) = $self->fetch_sql($sql);
3493             sub fetch_sql {
3494             (shift)->try_query( (shift), [ @_ ], 'fetchall_hashref_columns' )
3495             }
3496              
3497             # $array_of_arrays = $self->fetch_sql_rows($sql);
3498             # $array_of_arrays = $self->fetch_sql_rows($sql, @params);
3499             # ($array_of_arrays, $columns) = $self->fetch_sql_rows($sql);
3500             sub fetch_sql_rows {
3501             (shift)->try_query( (shift), [ @_ ], 'fetchall_arrayref_columns' )
3502             }
3503              
3504             # @results = $self->visit_sql($coderef, $sql, @params);
3505             # @results = $self->visit_sql($sql, @params, $coderef);
3506             sub visit_sql {
3507             my $self = shift;
3508             my $coderef = ( ref($_[0]) ? shift : pop );
3509             $self->try_query( (shift), [ @_ ], 'visitall_hashref', $coderef )
3510             }
3511              
3512             # @results = $self->visit_sql_rows($coderef, $sql, @params);
3513             # @results = $self->visit_sql_rows($sql, @params, $coderef);
3514             sub visit_sql_rows {
3515             my $self = shift;
3516             my $coderef = ( ref($_[0]) ? shift : pop );
3517             $self->try_query( (shift), [ @_ ], 'visitall_array', $coderef )
3518             }
3519              
3520             # $coderef = $self->fetchsub_sql($sql, @params);
3521             sub fetchsub_sql {
3522             (shift)->try_query( (shift), [ @_ ], 'fetchsub_hashref' )
3523             }
3524              
3525             # $coderef = $self->fetchsub_sql_rows($sql, @params);
3526             sub fetchsub_sql_rows {
3527             (shift)->try_query( (shift), [ @_ ], 'fetchsub_array' )
3528             }
3529              
3530             ########################################################################
3531              
3532             =head2 Statement Error Handling
3533              
3534             B
3535              
3536             =over 4
3537              
3538             =item try_query()
3539              
3540             $sqldb->try_query ( $sql, \@params, $result_method, @result_args ) : @results
3541              
3542             Error handling wrapper around the internal execute_query method.
3543              
3544             The $result_method should be the name of a method supported by that
3545             Driver instance, typically one of those shown in the "Retrieving
3546             Rows from an Executed Statement" section below. The @result_args,
3547             if any, are passed to the named method along with the active
3548             statement handle.
3549              
3550             =item catch_query_exception()
3551              
3552             $sqldb->catch_query_exception ( $exception, $sql, \@params,
3553             $result_method, @result_args ) : $resolution
3554              
3555             Exceptions are passed to catch_query_exception; if it returns "REDO"
3556             the query will be retried up to five times. The superclass checks
3557             the error message against the recoverable_query_exceptions; subclasses
3558             may wish to override this to provide specialized handling.
3559              
3560             =item recoverable_query_exceptions()
3561              
3562             $sqldb->recoverable_query_exceptions() : @common_error_messages
3563              
3564             Subclass hook. Defaults to empty. Subclasses may provide a list of
3565             error messages which represent common communication failures or
3566             other incidental errors.
3567              
3568             =back
3569              
3570             =cut
3571              
3572             # $results = $self->try_query($sql, \@params, $result_method, @result_args);
3573             # @results = $self->try_query($sql, \@params, $result_method, @result_args);
3574             sub try_query {
3575             my $self = shift;
3576            
3577             my $attempts = 0;
3578             my @results;
3579             my $wantarray = wantarray(); # Capture before eval which otherwise obscures it
3580             ATTEMPT: {
3581             $attempts ++;
3582             eval {
3583             local $SIG{__DIE__};
3584              
3585             @results = $wantarray ? $self->execute_query(@_)
3586             : scalar $self->execute_query(@_);
3587             };
3588             if ( my $error = $@ ) {
3589             my $catch = $self->catch_query_exception($error, @_);
3590             if ( ! $catch ) {
3591             die "DBIx::SQLEngine Query failed: $_[0]\n$error\n";
3592             } elsif ( $catch eq 'OK' ) {
3593             return;
3594             } elsif ( $catch eq 'REDO' ) {
3595             if ( $attempts < 5 ) {
3596             warn "DBIx::SQLEngine Retrying query after failure: $_[0]\n$error";
3597             redo ATTEMPT;
3598             } else {
3599             confess("DBIx::SQLEngine Query failed on $attempts consecutive attempts: $_[0]\n$error\n");
3600             }
3601             } else {
3602             confess("DBIx::SQLEngine Query failed: $_[0]\n$error" .
3603             "Unknown return from exception handler '$catch'");
3604             }
3605             }
3606             $wantarray ? @results : $results[0]
3607             }
3608             }
3609              
3610             sub catch_query_exception {
3611             my $self = shift;
3612             my $error = shift;
3613            
3614             foreach my $pattern ( $self->recoverable_query_exceptions() ) {
3615             if ( $error =~ /$pattern/i ) {
3616             $self->reconnect() and return 'REDO';
3617             }
3618             }
3619            
3620             return;
3621             }
3622              
3623             sub recoverable_query_exceptions {
3624             return ()
3625             }
3626              
3627             ########################################################################
3628              
3629             =head2 Statement Handle Lifecycle
3630              
3631             These are internal methods for query operations
3632              
3633             B
3634              
3635             =over 4
3636              
3637             =item execute_query()
3638              
3639             $sqldb->execute_query($sql, \@params, $result_method, @result_args) : @results
3640              
3641             This overall lifecycle method calls prepare_execute(), runs the $result_method, and then calls done_with_query().
3642              
3643             The $result_method should be the name of a method supported by that Driver instance, typically one of those shown in the "Retrieving Rows from an Executed Statement" section below. The @result_args, if any, are passed to the named method along with the active statement handle.
3644              
3645             =item prepare_execute()
3646              
3647             $sqldb->prepare_execute ($sql, @params) : $sth
3648              
3649             Prepare, bind, and execute a SQL statement to create a DBI statement handle.
3650              
3651             Uses the DBI prepare_cached(), bind_param(), and execute() methods.
3652              
3653             If you need to pass type information with your parameters, pass a reference to an array of the parameter and the type information.
3654              
3655             =item done_with_query()
3656              
3657             $sqldb->done_with_query ($sth) : ()
3658              
3659             Called when we're done with the $sth.
3660              
3661             =back
3662              
3663             =cut
3664              
3665             # $results = $self->execute_query($sql, \@params, $result_method, @result_args);
3666             # @results = $self->execute_query($sql, \@params, $result_method, @result_args);
3667             sub execute_query {
3668             my $self = shift;
3669            
3670             my ($sql, $params) = (shift, shift);
3671             my @query = ( $sql, ( $params ? @$params : () ) );
3672              
3673             my ($method, @args) = @_;
3674             $method ||= 'do_nothing';
3675              
3676             my $timer = $self->log_start( @query ) if $self->DBILogging;
3677            
3678             my ( $sth, @results );
3679             my $wantarray = wantarray(); # Capture before eval which otherwise obscures it
3680             eval {
3681             local $SIG{__DIE__};
3682             $sth = $self->prepare_execute( @query );
3683             @results = $wantarray ? ( $self->$method( $sth, @args ) )
3684             : scalar ( $self->$method( $sth, @args ) );
3685             };
3686             if ( $@ ) {
3687             $self->done_with_query($sth) if $sth;
3688             $self->log_stop( $timer, "ERROR: $@" ) if $self->DBILogging;
3689             die $@;
3690             } else {
3691             $self->done_with_query($sth) if $sth;
3692            
3693             $self->log_stop( $timer, \@results ) if $self->DBILogging;
3694            
3695             return ( $wantarray ? @results : $results[0] )
3696             }
3697             }
3698              
3699             # $sth = $self->prepare_execute($sql);
3700             # $sth = $self->prepare_execute($sql, @params);
3701             sub prepare_execute {
3702             my ($self, $sql, @params) = @_;
3703            
3704             my $sth;
3705             $sth = $self->prepare_cached($sql);
3706             for my $param_no ( 0 .. $#params ) {
3707             my $param_v = $params[$param_no];
3708             my @param_v = ( ref($param_v) eq 'ARRAY' ) ? @$param_v : $param_v;
3709             $sth->bind_param( $param_no+1, @param_v );
3710             }
3711             $self->{_last_sth_execute} = $sth->execute();
3712            
3713             return $sth;
3714             }
3715              
3716             # $self->done_with_query( $sth );
3717             sub done_with_query {
3718             my ($self, $sth) = @_;
3719            
3720             $sth->finish;
3721             }
3722              
3723             ########################################################################
3724              
3725             =head2 Retrieving Rows from a Statement
3726              
3727             B
3728              
3729             =over 4
3730              
3731             =item do_nothing()
3732              
3733             $sqldb->do_nothing ($sth) : ()
3734              
3735             Does nothing.
3736              
3737             =item get_execute_rowcount()
3738              
3739             $sqldb->get_execute_rowcount ($sth) : $row_count
3740              
3741             Returns the row count reported by the last statement executed.
3742              
3743             =item fetchall_hashref()
3744              
3745             $sqldb->fetchall_hashref ($sth) : $array_of_hashes
3746              
3747             Calls the STH's fetchall_arrayref method with an empty hashref to retrieve all of the result rows into an array of hashrefs.
3748              
3749             =item fetchall_hashref_columns()
3750              
3751             $sqldb->fetchall_hashref ($sth) : $array_of_hashes
3752             $sqldb->fetchall_hashref ($sth) : ( $array_of_hashes, $column_info )
3753              
3754             Calls the STH's fetchall_arrayref method with an empty hashref, and if called in a list context, also retrieves information about the columns used in the query result set.
3755              
3756             =item fetchall_arrayref()
3757              
3758             $sqldb->fetchall_arrayref ($sth) : $array_of_arrays
3759              
3760             Calls the STH's fetchall_arrayref method to retrieve all of the result rows into an array of arrayrefs.
3761              
3762             =item fetchall_arrayref_columns()
3763              
3764             $sqldb->fetchall_hashref ($sth) : $array_of_arrays
3765             $sqldb->fetchall_hashref ($sth) : ( $array_of_arrays, $column_info )
3766              
3767             Calls the STH's fetchall_arrayref method, and if called in a list context, also retrieves information about the columns used in the query result set.
3768              
3769             =item visitall_hashref()
3770              
3771             $sqldb->visitall_hashref ($sth, $coderef) : ()
3772              
3773             Calls coderef on each row with values as hashref, and returns a list of results.
3774              
3775             =item visitall_array()
3776              
3777             $sqldb->visitall_array ($sth, $coderef) : ()
3778              
3779             Calls coderef on each row with values as list, and returns a list of results.
3780              
3781             =item fetchsub_hashref()
3782              
3783             $sqldb->fetchsub_hashref ($sth, $name_uc_or_lc) : $coderef
3784              
3785             Returns a code reference that can be called repeatedly to invoke the fetchrow_hashref() method on the statement handle.
3786              
3787             The code reference is blessed so that when it goes out of scope and is destroyed it can call the statement handle's finish() method.
3788              
3789             =item fetchsub_array()
3790              
3791             $sqldb->fetchsub_hashref ($sth) : $coderef
3792              
3793             Returns a code reference that can be called repeatedly to invoke the fetchrow_array() method on the statement handle.
3794              
3795             The code reference is blessed so that when it goes out of scope and is destroyed it can call the statement handle's finish() method.
3796              
3797             =back
3798              
3799             =cut
3800              
3801             sub do_nothing {
3802             return;
3803             }
3804              
3805             sub get_execute_rowcount {
3806             my $self = shift;
3807             return $self->{_last_sth_execute};
3808             }
3809              
3810             sub fetchall_arrayref {
3811             my ($self, $sth) = @_;
3812             $sth->fetchall_arrayref();
3813             }
3814              
3815             sub fetchall_arrayref_columns {
3816             my ($self, $sth) = @_;
3817             my $cols = wantarray() ? $self->retrieve_columns( $sth ) : undef;
3818             my $rows = $sth->fetchall_arrayref();
3819             wantarray ? ( $rows, $cols ) : $rows;
3820             }
3821              
3822             sub fetchall_hashref {
3823             my ($self, $sth) = @_;
3824             $sth->fetchall_arrayref( {} );
3825             }
3826              
3827             sub fetchall_hashref_columns {
3828             my ($self, $sth) = @_;
3829             my $cols = wantarray() ? $self->retrieve_columns( $sth ) : undef;
3830             my $rows = $sth->fetchall_arrayref( {} );
3831             wantarray ? ( $rows, $cols ) : $rows;
3832             }
3833              
3834             # $self->visitall_hashref( $sth, $coderef );
3835             # Calls a codref for each row returned by the statement handle
3836             sub visitall_hashref {
3837             my ($self, $sth, $coderef) = @_;
3838             my $rowhash;
3839             my @results;
3840             while ($rowhash = $sth->fetchrow_hashref) {
3841             push @results, &$coderef( $rowhash );
3842             }
3843             return @results;
3844             }
3845              
3846             # $self->visitall_array( $sth, $coderef );
3847             # Calls a codref for each row returned by the statement handle
3848             sub visitall_array {
3849             my ($self, $sth, $coderef) = @_;
3850             my @row;
3851             my @results;
3852             while (@row = $sth->fetchrow_array) {
3853             push @results, &$coderef( @row );
3854             }
3855             return @results;
3856             }
3857              
3858             # $fetchsub = $self->fetchsub_hashref( $sth )
3859             # $fetchsub = $self->fetchsub_hashref( $sth, $name_uc_or_lc )
3860             sub fetchsub_hashref {
3861             my ($self, $sth, @args) = @_;
3862             $_[1] = undef;
3863             DBIx::SQLEngine::Driver::fetchsub->new( $sth, 'fetchrow_hashref', @args );
3864             }
3865              
3866             # $fetchsub = $self->fetchsub_array( $sth )
3867             sub fetchsub_array {
3868             my ($self, $sth) = @_;
3869             $_[1] = undef;
3870             DBIx::SQLEngine::Driver::fetchsub->new( $sth, 'fetchrow_array' );
3871             }
3872              
3873             FETCHSUB_CLASS: {
3874             package DBIx::SQLEngine::Driver::fetchsub;
3875            
3876             my $Signal = \"Unique";
3877            
3878             sub new {
3879             my ( $package, $sth, $method, @args ) = @_;
3880             my $coderef = sub {
3881             unless ( $_[0] eq $Signal ) {
3882             $sth->$method( @args, @_ )
3883             } elsif ( $_[1] eq 'DESTROY' ) {
3884             $sth->finish() if $sth;
3885             warn "Fetchsub finish for $sth\n";
3886             $sth = undef;
3887             } elsif ( $_[1] eq 'handle' ) {
3888             return $sth;
3889             } else {
3890             Carp::croak( "Unsupported signal to fetchsub: '$_[1]'" );
3891             }
3892             };
3893             bless $coderef, $package;
3894             }
3895            
3896             sub handle {
3897             my $coderef = shift;
3898             &$coderef( $Signal => 'handle' )
3899             }
3900            
3901             sub DESTROY {
3902             my $coderef = shift;
3903             &$coderef( $Signal => 'DESTROY' )
3904             }
3905             }
3906              
3907             ########################################################################
3908              
3909             =head2 Retrieving Columns from a Statement
3910              
3911             B
3912              
3913             =over 4
3914              
3915             =item retrieve_columns()
3916              
3917             $sqldb->retrieve_columns ($sth) : $columnset
3918              
3919             Obtains information about the columns used in the result set.
3920              
3921             =item column_type_codes()
3922              
3923             $sqldb->column_type_codes - Standard::Global:hash
3924              
3925             Maps the ODBC numeric constants used by DBI to the names we want to use for simplified internal representation.
3926              
3927             =back
3928              
3929             To Do: this should probably be using DBI's type_info methods.
3930              
3931             =cut
3932              
3933             # %@$columns = $self->retrieve_columns($sth)
3934             #!# 'pri_key' => $sth->is_pri_key->[$i],
3935             # is_pri_key causes the driver to fail with the following fatal error:
3936             # relocation error: symbol not found: mysql_columnSeek
3937             # or at least that happens in the version we last tested it with. -S.
3938            
3939             sub retrieve_columns {
3940             my ($self, $sth) = @_;
3941            
3942             my $type_defs = $self->column_type_codes();
3943             my $names = $sth->{'NAME_lc'};
3944              
3945             my $types = eval { $sth->{'TYPE'} || [] };
3946             # warn "Types: " . join(', ', map "'$_'", @$types);
3947             my $type_codes = [ map {
3948             my $typeinfo = scalar $self->type_info($_);
3949             # warn "Type $typeinfo";
3950             ref($typeinfo) ? scalar $typeinfo->{'DATA_TYPE'} : $typeinfo;
3951             } @$types ];
3952             my $sizes = eval { $sth->{PRECISION} || [] };
3953             my $nullable = eval { $sth->{'NULLABLE'} || [] };
3954             [
3955             map {
3956             my $type = $type_defs->{ $type_codes->[$_] || 0 } || $type_codes->[$_];
3957             $type ||= 'text';
3958             # warn "New col: $names->[$_] ($type / $types->[$_] / $type_codes->[$_])";
3959            
3960             {
3961             'name' => $names->[$_],
3962             'type' => $type,
3963             'required' => ! $nullable->[$_],
3964             ( $type eq 'text' ? ( 'length' => $sizes->[$_] ) : () ),
3965            
3966             }
3967             } (0 .. $#$names)
3968             ];
3969             }
3970              
3971             use Class::MakeMethods ( 'Standard::Global:hash' => 'column_type_codes' );
3972             use DBI ':sql_types';
3973              
3974             # $code_to_name_hash = $self->determine_column_type_codes();
3975             __PACKAGE__->column_type_codes(
3976             DBI::SQL_CHAR() => 'text', # char
3977             DBI::SQL_VARCHAR() => 'text', # varchar
3978             DBI::SQL_LONGVARCHAR() => 'text', #
3979             253 => 'text', # MySQL varchar
3980             252 => 'text', # MySQL blob
3981            
3982             DBI::SQL_NUMERIC() => 'float', # numeric (?)
3983             DBI::SQL_DECIMAL() => 'float', # decimal
3984             DBI::SQL_FLOAT() => 'float', # float
3985             DBI::SQL_REAL() => 'float', # real
3986             DBI::SQL_DOUBLE() => 'float', # double
3987            
3988             DBI::SQL_INTEGER() => 'int', # integer
3989             DBI::SQL_SMALLINT() => 'int', # smallint
3990             -6 => 'int', # MySQL tinyint
3991            
3992             DBI::SQL_DATE() => 'time', # date
3993             DBI::SQL_TIME() => 'time', # time
3994             DBI::SQL_TIMESTAMP() => 'time', # datetime
3995             );
3996              
3997             ########################################################################
3998              
3999             ########################################################################
4000              
4001             =head1 LOGGING
4002              
4003             =head2 DBI Logging
4004              
4005             B
4006              
4007             =over 4
4008              
4009             =item DBILogging()
4010              
4011             $sqldb->DBILogging : $value
4012             $sqldb->DBILogging( $value )
4013              
4014             Set this to a true value to turn on logging of DBI interactions. Can be called on the class to set a shared default for all instances, or on any instance to set the value for it alone.
4015              
4016             =back
4017              
4018             B
4019              
4020             =over 4
4021              
4022             =item log_connect()
4023              
4024             $sqldb->log_connect ( $dsn )
4025              
4026             Writes out connection logging message.
4027              
4028             =item log_start()
4029              
4030             $sqldb->log_start( $sql ) : $timer
4031              
4032             Called at start of query execution.
4033              
4034             =item log_stop()
4035              
4036             $sqldb->log_stop( $timer ) : ()
4037              
4038             Called at end of query execution.
4039              
4040             =back
4041              
4042             =cut
4043              
4044             use Class::MakeMethods ( 'Standard::Inheritable:scalar' => 'DBILogging' );
4045              
4046             # $self->log_connect( $dsn );
4047             sub log_connect {
4048             my ($self, $dsn) = @_;
4049             my $class = ref($self) || $self;
4050             warn "DBI: Connecting to $dsn\n";
4051             }
4052              
4053             # $timer = $self->log_start( $sql );
4054             sub log_start {
4055             my ($self, $sql, @params) = @_;
4056             my $class = ref($self) || $self;
4057            
4058             my $start_time = time;
4059            
4060             my $params = join( ', ', map { defined $_ ? "'" . printable($_) . "'" : 'undef' } @params );
4061             warn "DBI: $sql; $params\n";
4062            
4063             return $start_time;
4064             }
4065              
4066             # $self->log_stop( $timer );
4067             # $self->log_stop( $timer, $error_message );
4068             # $self->log_stop( $timer, @$return_values );
4069             sub log_stop {
4070             my ($self, $start_time, $results) = @_;
4071             my $class = ref($self) || $self;
4072            
4073             my $message;
4074             if ( ! ref $results ) {
4075             $message = "returning an error: $results";
4076             } elsif ( ref($results) eq 'ARRAY' ) {
4077             # Successful return
4078             if ( ! ref( $results->[0] ) ) {
4079             if ( $results->[0] =~ /^\d+$/ ) {
4080             $message = "affecting $results->[0] rows";
4081             } elsif ( $results->[0] eq '0E0' ) {
4082             $message = "affecting 0 rows";
4083             } else {
4084             $message = "producing a value of '$results->[0]'";
4085             }
4086             } elsif ( ref( $results->[0] ) eq 'ARRAY' ) {
4087             $message = "returning " . scalar(@{ $results->[0] }) . " items";
4088             }
4089             }
4090             my $seconds = (time() - $start_time or 'less than one' );
4091            
4092             warn "DBI: Completed in $seconds seconds" .
4093             (defined $message ? ", $message" : '') . "\n";
4094            
4095             return;
4096             }
4097              
4098             ########################################################################
4099              
4100             use vars qw( %Printable );
4101             %Printable = ( ( map { chr($_), unpack('H2', chr($_)) } (0..255) ),
4102             "\\"=>'\\', "\r"=>'r', "\n"=>'n', "\t"=>'t', "\""=>'"' );
4103              
4104             # $special_characters_escaped = printable( $source_string );
4105             sub printable ($) {
4106             local $_ = ( defined $_[0] ? $_[0] : '' );
4107             s/([\r\n\t\"\\\x00-\x1f\x7F-\xFF])/\\$Printable{$1}/g;
4108             return $_;
4109             }
4110              
4111             ########################################################################
4112              
4113             =head2 SQL Logging
4114              
4115             B
4116              
4117             =over 4
4118              
4119             =item SQLLogging()
4120              
4121             $sqldb->SQLLogging () : $value
4122             $sqldb->SQLLogging( $value )
4123              
4124             Set this to a true value to turn on logging of internally-generated SQL statements (all queries except for those with complete SQL statements explicitly passed in by the caller). Can be called on the class to set a shared default for all instances, or on any instance to set the value for it alone.
4125              
4126             =back
4127              
4128             B
4129              
4130             =over 4
4131              
4132             =item log_sql()
4133              
4134             $sqldb->log_sql( $sql ) : ()
4135              
4136             Called when SQL is generated.
4137              
4138             =back
4139              
4140             =cut
4141              
4142             use Class::MakeMethods ( 'Standard::Inheritable:scalar' => 'SQLLogging' );
4143              
4144             # $self->log_sql( $sql );
4145             sub log_sql {
4146             my ($self, $sql, @params) = @_;
4147             return unless $self->SQLLogging;
4148             my $class = ref($self) || $self;
4149             my $params = join( ', ', map { defined $_ ? "'$_'" : 'undef' } @params );
4150             warn "SQL: $sql; $params\n";
4151             }
4152              
4153             ########################################################################
4154              
4155             ########################################################################
4156              
4157             =head2 About Driver Traits
4158              
4159             Some features that are shared by several Driver subclasses are implemented as a package in the Driver::Trait::* namespace.
4160              
4161             Because of the way DBIx::AnyDBD munges the inheritance tree,
4162             DBIx::SQLEngine::Driver subclasses can not reliably inherit from mixins.
4163             To work around this, we export all of the methods into their namespace using Exporter and @EXPORT.
4164              
4165             In addition we go through some effort to re-dispatch methods because we can't
4166             rely on SUPER and we don't want to require NEXT. This isn't too complicated,
4167             as we know the munged inheritance tree only uses single inheritance.
4168              
4169             Note: this mechanism has been added recently, and the implementation is subject to change.
4170              
4171             B
4172              
4173             =over 4
4174              
4175             =item NEXT()
4176              
4177             $sqldb->NEXT( $method, @args ) : @results
4178              
4179             Used by driver traits to redispatch to base-class implementations.
4180              
4181             =back
4182              
4183             =cut
4184              
4185             sub NEXT {
4186             my ( $self, $method, @args ) = @_;
4187            
4188             no strict 'refs';
4189             my $super = ${ ref($self) . '::ISA' }[0] . "::" . $method;
4190             # warn "_super_d: $super " . wantarray() . "\n";
4191             $self->$super( @args );
4192             }
4193              
4194             ########################################################################
4195              
4196             ########################################################################
4197              
4198             =head1 SEE ALSO
4199              
4200             See L for the overall interface and developer documentation.
4201              
4202             For distribution, installation, support, copyright and license
4203             information, see L.
4204              
4205             =cut
4206              
4207             ########################################################################
4208              
4209             1;