File Coverage

blib/lib/App/Framework/Feature/Sql.pm

Criterion	Covered	Total	%
statement	6	357	1.6
branch	0	146	0.0
condition	0	21	0.0
subroutine	2	32	6.2
pod	22	22	100.0
total	30	578	5.1

line

stmt

bran

cond

sub

pod

time

code

package App::Framework::Feature::Sql ;

=head1 NAME

Sql - MySql interface

=head1 SYNOPSIS

use App::Framework '+Sql' ;

=head1 DESCRIPTION

Provides a simplified interface to MySQL via DBI.

=cut

26987

use strict ;

our $VERSION = "2.016" ;

#============================================================================================

# USES

#============================================================================================

use App::Framework::Feature ;

5016

#============================================================================================

# OBJECT HIERARCHY

#============================================================================================

our @ISA = qw(App::Framework::Feature) ;

#============================================================================================

# GLOBALS

#============================================================================================

=head2 FIELDS

The following fields should be defined either in the call to 'new()', as part of a 'set()' call, or called by their accessor method

(which is the same name as the field):

=over 4

=item B - MySql host [default=localhost]

=item B - Database name (required)

=item B - Table name

54
55						=item B - User name
56
57						=item B - Password
58
59						=item B - Sql debug trace level [default=0]
60
61						=item B - If specified, output trace information to file (default=STDOUT)
62
63						=item B - Default HASH used to store 'prepare' values
64
65						=item B - Create one or more queries
66
67
68						=back
69
70						=cut
71
72						my %FIELDS = (
73						# Object Data
74						'dbh' => undef,
75						'host' => 'localhost',
76						'database' => undef,
77						'table' => undef,
78						'user' => undef,
79						'password' => undef,
80						'trace' => 0,
81						'trace_file' => undef,
82
83						'prepare' => undef, # Special 'parameter' used to create STHs
84						'sql_vars' => {},
85
86						'_sth' => {},
87						) ;
88
89						# ensure these fields are set before starting to process the 'prepare' values
90						my @PRIORITY_FIELDS = qw/database user password table sql_vars/ ;
91
92						# Default STH
93						my $DEFAULT_STH_NAME = "_current" ;
94
95						#* DELETE
96						#
97						#DELETE [LOW_PRIORITY] [QUICK] [IGNORE]
98						# FROM tbl_name
99						# [WHERE where_condition]
100						# [ORDER BY ...]
101						# [LIMIT row_count]
102						#
103						#"DELETE FROM `$table` WHERE `pid`=? AND `channel`=? LIMIT 1;"
104						#
105						#
106						#* INSERT / REPLACE
107						#
108						#INSERT [LOW_PRIORITY \| DELAYED \| HIGH_PRIORITY] [IGNORE]
109						# [INTO] tbl_name [(col_name,...)]
110						# VALUES ({expr \| DEFAULT},...),(...),...
111						# [ ON DUPLICATE KEY UPDATE
112						# col_name=expr
113						# [, col_name=expr] ... ]
114						#
115						#"INSERT INTO `$table` ( `pid`, `channel`, `title`, `date`, `start`, `duration`, `episode`, `num_episodes`, `repeat`, `text` ) ".
116						#'VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?);'
117						#
118						#Or:
119						#
120						#INSERT [LOW_PRIORITY \| DELAYED \| HIGH_PRIORITY] [IGNORE]
121						# [INTO] tbl_name
122						# SET col_name={expr \| DEFAULT}, ...
123						# [ ON DUPLICATE KEY UPDATE
124						# col_name=expr
125						# [, col_name=expr] ... ]
126						#
127						#"INSERT INTO `$table` SET `title`=?, `date`=?, `start`=?, `duration`=?, `text`=?, `episode`=?, `num_episodes`=?, `repeat`=? "
128						#
129						#
130						#
131						#* SELECT
132						#
133						#SELECT
134						# [ALL \| DISTINCT \| DISTINCTROW ]
135						# [HIGH_PRIORITY]
136						# [STRAIGHT_JOIN]
137						# [SQL_SMALL_RESULT] [SQL_BIG_RESULT] [SQL_BUFFER_RESULT]
138						# [SQL_CACHE \| SQL_NO_CACHE] [SQL_CALC_FOUND_ROWS]
139						# select_expr, ...
140						# [FROM table_references
141						# [WHERE where_condition]
142						# [GROUP BY {col_name \| expr \| position}
143						# [ASC \| DESC], ... [WITH ROLLUP]]
144						# [HAVING where_condition]
145						# [ORDER BY {col_name \| expr \| position}
146						# [ASC \| DESC], ...]
147						# [LIMIT {[offset,] row_count \| row_count OFFSET offset}]
148						# [PROCEDURE procedure_name(argument_list)]
149						# [INTO OUTFILE 'file_name' export_options
150						# \| INTO DUMPFILE 'file_name'
151						# \| INTO var_name [, var_name]]
152						# [FOR UPDATE \| LOCK IN SHARE MODE]]
153						#
154						#"SELECT `title` FROM `$table` WHERE `pid`=? AND `channel`=? LIMIT 1;"
155						#
156						#
157						#* UPDATE
158						#
159						#UPDATE [LOW_PRIORITY] [IGNORE]
160						# tbl_name
161						# SET col_name1=expr1 [, col_name2=expr2] ...
162						# [WHERE where_condition]
163						# [ORDER BY ... ASC\|DESC]
164						# [LIMIT row_count]
165						#
166						#"UPDATE `$table` SET `title`=?, `date`=?, `start`=?, `duration`=?, `text`=?, `episode`=?, `num_episodes`=?, `repeat`=? ".
167						#'WHERE `pid`=? AND `channel`=? LIMIT 1 ;'
168						#
169						# where order limit setlist
170						#delete Y Y Y -
171						#insert - - - Y
172						#replace - - - Y
173						#select Y Y Y -
174						#update Y Y Y Y
175						#
176						#setlist => [SET] `var`=?, `var`=? ..
177						#andlist => [WHERE] `var`=? AND `var`=? ..
178						#varlist => [SELECT\|ORDER BY] `var`, `var`
179						#
180
181						my %CMDS = (
182						'(sel\|check)' => 'select',
183						'(del\|rm)' => 'delete',
184						'ins' => 'insert',
185						'rep' => 'replace',
186						'upd' => 'update',
187						) ;
188
189
190						#=back
191						#
192						#=head2 %CMD_SQL - Parse control hash
193						#
194						#Variables get created with the name
195						#
196						# * $sqlvar_
197						#
198						#where is the hash key. This created variable contains the sql for this command or option.
199						#
200						#If the control hash entry contains a 'vals' entry, then the following variable is created:
201						#
202						# * @sqlvar_
203						#
204						#This will be a text string containing something like "@sqlvar_select_vals,@sqlvar_where_vals" i.e. a comma
205						#seperated list of references to other arrays. These values will be expanded into a real array before use in the
206						#sql prepare.
207						#
208						#Also, as each entry is processed, extra variables are created:
209						#
210						# * $sqlvar__prefix - Prefix string for this entry
211						# * $sqlvar__format - Just the same as sqlvar_
212						#
213						#
214						#=head2 Specification variables
215						#
216						#This control hash is used to direct processing of the SQL specification passed to sth_create(). If the spec
217						#contains a 'vars' field then these additional variables are created in the context:
218						#
219						# * $sqlvar__varlist - List of the 'vars' in the format `var`, `var` ..
220						# * $sqlvar__andlist - List of the 'vars' in the format `var` AND `var` ..
221						# * $sqlvar__varlist - List of the 'vars' in the format `var`=?, `var`=? ..
222						#
223						#If the spec has a 'vals' entry, then these are pushed on to an ARRAY ref and stored in:
224						#
225						# * @sqlvar__vals
226						#
227						#@sqlvar__vals = Real ARRAY ref (provided by the spec)
228						#@sqlvar_ = String in the format "@sqlvar_select_vals,@sqlvar_where_vals" (provided by parse control hash)
229						#
230						#
231						#=cut
232
233
234
235						my %CMD_SQL = (
236
237						## Overall query
238						'query' => {
239						'format' => '$sqlvar_select$sqlvar_delete$sqlvar_insert$sqlvar_replace$sqlvar_update',
240						'vals' => '@sqlvar_select,@sqlvar_delete,@sqlvar_insert,@sqlvar_replace,@sqlvar_update',
241						},
242
243
244						## Specific SQL commands
245						'select' => {
246						'prefix' => 'SELECT $sqlvar_select_varlist FROM `$sqlvar_table`',
247						'format' => 'SELECT $sqlvar_select_varlist FROM `$sqlvar_table` $sqlvar_where $sqlvar_group $sqlvar_order $sqlvar_limit',
248						'vals' => '@sqlvar_select_vals,@sqlvar_where_vals,@sqlvar_order_vals',
249						},
250						'delete' => {
251						'prefix' => 'DELETE FROM `$sqlvar_table`',
252						'format' => 'DELETE FROM `$sqlvar_table` $sqlvar_where $sqlvar_group $sqlvar_order $sqlvar_limit',
253						'vals' => '@sqlvar_where_vals,@sqlvar_order_vals',
254						},
255						'insert' => {
256						'prefix' => 'INSERT INTO `$sqlvar_table`',
257						'format' => 'INSERT INTO `$sqlvar_table` SET $sqlvar_insert_setlist',
258						'vals' => '@sqlvar_insert_vals',
259						},
260						'replace' => {
261						'prefix' => 'REPLACE INTO `$sqlvar_table`',
262						'format' => 'REPLACE INTO `$sqlvar_table` SET $sqlvar_replace_setlist',
263						'vals' => '@sqlvar_replace_vals',
264						},
265						'update' => {
266						'prefix' => 'UPDATE `$sqlvar_table`',
267						'format' => 'UPDATE `$sqlvar_table` SET $sqlvar_update_setlist $sqlvar_where $sqlvar_order $sqlvar_limit',
268						'vals' => '@sqlvar_update_vals,@sqlvar_where_vals,@sqlvar_order_vals',
269						},
270
271						## Command options
272						'where' => {
273						'prefix' => 'WHERE',
274						'format' => 'WHERE $sqlvar_where_andlist',
275						},
276
277						'order' => {
278						'prefix' => 'ORDER BY',
279						'format' => 'ORDER BY $sqlvar_order_varlist $sqlvar_asc',
280						},
281
282						'group' => {
283						'prefix' => 'GROUP BY',
284						'format' => 'GROUP BY $sqlvar_group_varlist $sqlvar_asc',
285						},
286
287						'limit' => {
288						'prefix' => 'LIMIT',
289						'format' => 'LIMIT $limit',
290						},
291
292						) ;
293
294
295						#============================================================================================
296
297						=head2 CONSTRUCTOR
298
299						=over 4
300
301						=cut
302
303						#============================================================================================
304
305						=item B
306
307						Create a new Sql object.
308
309						The %args are specified as they would be in the B method, for example:
310
311						'mmap_handler' => $mmap_handler
312
313						The full list of possible arguments are :
314
315						'fields' => Either ARRAY list of valid field names, or HASH of field names with default values
316
317						=cut
318
319						sub new
320						{
321	0			0	1	my ($obj, %args) = @_ ;
322
323	0		0			my $class = ref($obj) \|\| $obj ;
324
325						# Create object
326	0					my $this = $class->SUPER::new(%args,
327						'requires' => [qw/DBI DBD::mysql/],
328						) ;
329
330						## Postpone connection until we actually need it
331
332	0					return($this) ;
333						}
334
335
336
337						#============================================================================================
338
339						=back
340
341						=head2 CLASS METHODS
342
343						=over 4
344
345						=cut
346
347						#============================================================================================
348
349						#-----------------------------------------------------------------------------
350
351						=item B
352
353						Initialises the Sql object class variables.
354
355						=cut
356
357						sub init_class
358						{
359	0			0	1	my $class = shift ;
360	0					my (%args) = @_ ;
361
362						# Add extra fields
363	0					$class->add_fields(\%FIELDS, \%args) ;
364
365						# init class
366	0					$class->SUPER::init_class(%args) ;
367
368						}
369
370						#============================================================================================
371
372						=back
373
374						=head2 OBJECT DATA METHODS
375
376						=over 4
377
378						=cut
379
380						#============================================================================================
381
382						#----------------------------------------------------------------------------
383
384						=item B
385
386						Set one or more settable parameter.
387
388						The %args are specified as a hash, for example
389
390						set('mmap_handler' => $mmap_handler)
391
392						Sets field values. Field values are expressed as part of the HASH (i.e. normal
393						field => value pairs).
394
395						=cut
396
397						sub set
398						{
399	0			0	1	my $this = shift ;
400	0					my (%args) = @_ ;
401
402						# ensure priority args are handled first
403	0					my %priority ;
404	0					foreach my $arg (@PRIORITY_FIELDS)
405						{
406	0					my $val = delete $args{$arg} ;
407	0	0				$priority{$arg} = $val if $val ;
408						}
409	0	0				if (keys %priority)
410						{
411	0					$this->SUPER::set(%priority) ;
412
413						# Connect if we can
414	0	0	0			if ($this->database && $this->host)
415						{
416	0					$this->connect() ;
417						}
418						}
419
420						# handle the rest
421	0	0				$this->SUPER::set(%args) if keys %args ;
422
423						}
424
425						#============================================================================================
426
427						=back
428
429						=head2 OBJECT METHODS
430
431						=over 4
432
433						=cut
434
435						#============================================================================================
436
437						#----------------------------------------------------------------------------
438
439						=item B< sql([%args]) >
440
441						Returns the sql object. If %args are specified they are used to set the L
442
443						=cut
444
445						sub sql
446						{
447	0			0	1	my $this = shift ;
448	0					my (%args) = @_ ;
449
450	0	0				$this->set(%args) if %args ;
451	0					return $this ;
452						}
453
454						#----------------------------------------------------------------------------
455
456						=item B< Sql([%args]) >
457
458						Alias to L
459
460						=cut
461
462						*Sql = \&sql ;
463
464
465
466
467						#----------------------------------------------------------------------------
468
469						=item B
470
471						Use HASH ref to create 1 or more STHs
472
473						=cut
474
475						sub prepare
476						{
477	0			0	1	my $this = shift ;
478	0					my ($prepare_href) = @_ ;
479
480	0	0				if (ref($prepare_href) eq 'HASH')
481						{
482	0					foreach my $name (keys %$prepare_href)
483						{
484						# Just create each one
485	0					$this->sth_create($name, $prepare_href->{$name});
486						}
487						}
488
489	0					return undef ;
490						}
491
492						#----------------------------------------------------------------------------
493
494						=item B
495
496						Change trace level
497
498						=cut
499
500						sub trace
501						{
502	0			0	1	my $this = shift ;
503	0					my (@args) = @_ ;
504
505						# Update value
506						## my $trace = $this->SUPER::trace(@args) ;
507	0					my $trace = $this->field_access('trace', @args) ;
508
509	0	0				if (@args)
510						{
511	0					my $dbh = $this->dbh() ;
512	0					my $trace_file = $this->trace_file() ;
513
514						# Update trace level
515	0					$this->_set_trace($dbh, $trace, $trace_file) ;
516						}
517
518	0					return $trace ;
519						}
520
521						#----------------------------------------------------------------------------
522
523						=item B
524
525						Change trace file
526
527						=cut
528
529						sub trace_file
530						{
531	0			0	1	my $this = shift ;
532	0					my (@args) = @_ ;
533
534						# Update value
535						## my $trace_file = $this->SUPER::trace_file(@args) ;
536	0					my $trace_file = $this->field_access('trace_file', @args) ;
537
538	0	0				if (@args)
539						{
540	0					my $dbh = $this->dbh() ;
541	0					my $trace = $this->trace() ;
542
543						# Update trace level
544	0					$this->_set_trace($dbh, $trace, $trace_file) ;
545						}
546
547	0					return $trace_file ;
548						}
549
550
551
552
553						#----------------------------------------------------------------------------
554
555						=item B
556
557						Connects to database. Either uses pre-set values for user/password/database,
558						or can use optionally specified args
559
560						=cut
561
562						sub connect
563						{
564	0			0	1	my $this = shift ;
565	0					my (%args) = @_ ;
566
567	0					$this->set(%args) ;
568
569	0					$this->_dbg_prt(["Sql::connect() => ",$this->database(),"\n"]) ;
570
571	0	0				$this->throw_fatal("SQL connect error: no database specified") unless $this->database() ;
572	0	0				$this->throw_fatal("SQL connect error: no host specified") unless $this->host() ;
573
574	0					my $dbh ;
575						eval
576	0					{
577						# Disconnect if already connected
578	0					$this->disconnect() ;
579
580						# Connect
581	0	0				$dbh = DBI->connect("DBI:mysql:database=".$this->database().
582						";host=".$this->host(),
583						$this->user(), $this->password(),
584						{'RaiseError' => 1}) or $this->throw_fatal( $DBI::errstr ) ;
585	0					$this->dbh($dbh) ;
586
587						};
588	0	0				if ($@)
589						{
590	0					$this->throw_fatal("SQL connect error: $@", 1000) ;
591						}
592
593	0		0			my $dbh_dbg = $dbh \|\| "" ;
594	0					$this->_dbg_prt([" + connected dbh=$dbh_dbg : db=",$this->database()," user=",$this->user()," pass=",$this->password(),"\n"]) ;
595
596	0					return $dbh ;
597						}
598
599						#----------------------------------------------------------------------------
600
601						=item B
602
603						Disconnect from database (if connected)
604
605						=cut
606
607						sub disconnect
608						{
609	0			0	1	my $this = shift ;
610
611	0					my $dbh = $this->dbh() ;
612
613	0		0			my $dbh_dbg = $dbh \|\| "" ;
614	0					$this->_dbg_prt(["Sql::disconnect() => dbh=$dbh_dbg\n"]) ;
615
616						eval
617	0					{
618	0	0				if ($dbh)
619						{
620	0					$this->dbh(0) ;
621						}
622						};
623	0	0				if ($@)
624						{
625	0					$this->throw_fatal("SQL disconnect error: $@", 1000) ;
626						}
627
628	0					$this->_dbg_prt([" + disconnected\n"]) ;
629						}
630
631
632						#----------------------------------------------------------------------------
633
634						=item B
635
636						Prepare a named SQL query & store it for later execution by query_sth()
637
638						Name is saved as $name. Certain names are 'special':
639
640						ins* - Create an 'insert' type command
641						upd* - Create an 'update' type command
642						sel* - Create a 'select' type command
643						check* - Create a 'select' type command
644
645						The $spec is either a SCALAR or HASH ref
646
647						If $spec is a SCALAR then it is in the form of sql. Note, when the query is executed the values
648						(if required) must be specified.
649
650						If $spec is a HASH ref then it can contain the following fields:
651
652						'cmd' => Command type: 'insert', 'update', 'select'
653						'vars' => ARRAY ref list of variable names (used for 'insert', 'update')
654						'vals' => Provides values to be used in the query (no extra values need to be specified). HASH ref or ARRAY ref.
655						HASH ref - the hash is used to look up the values using the 'vars' names
656						ARRAY ref - list of values (or refs to values)
657						NOTE: If insufficient values are provided for the query, then the remaining values must be specified in the query call
658						'sql' => Sql string.
659						NOTE: Depending on the command type, if the command is not specified then a default will be prepended to this string.
660						'table' => Overrides the object table setting for this query
661						'limit' => Sets the limit on the number of results
662						'group' => Specify group by string
663						'where' => Where clause. String or HASH ref.
664						String - specify sql for where clause (can omit 'WHERE' prefix)
665						HASH ref - specify where clause as HASH:
666						'sql' => Used to specify more complicated where clauses (e.g. '`pid`=? AND `channel`=?')
667						'vars' => ARRAY ref list of variable names (used for 'where'). If no 'sql' is specified, then the where clause
668						is created by ANDing the vars together (e.g. [qw/pid channel/] gives '`pid`=? AND `channel`=?')
669						'vals' => Provides values to be used in the query (no extra values need to be specified). HASH ref or ARRAY ref.
670
671						EXAMPLES
672
673						The following are all (almost) equivalent:
674
675						$sql->sth_create('check', {
676						'table' => '$table',
677						'limit' => 1,
678						'where' => {
679						'sql' => '`pid`=? AND `channel`=?',
680						'vars' => [qw/pid channel/],
681						'vals' => \%sql_vars
682						}) ;
683
684						$sql->sth_create('check2', {
685						'table' => '$table',
686						'limit' => 1,
687						'where' => '`pid`=? AND `channel`=?',# need to pass in extra params to query method
688						}}) ;
689
690						$sql->sth_create('check3', "SELECT * FROM `$table` WHERE `pid`=? AND `channel`=? LIMIT 1") ;
691
692						$sql->sth_create('select', "WHERE `pid`=? AND `channel`=? LIMIT 1") ;
693
694						They are then used as:
695
696						$sql->sth_query('check') ; # already given it's parameters
697						$sql->sth_query('check2', $pid, $channel) ;
698						$sql->sth_query('check3', $pid, $channel) ;
699						$sql->sth_query('select', $pid, $channel) ;
700
701
702						=cut
703
704						sub sth_create
705						{
706	0			0	1	my $this = shift ;
707	0					my ($name, $spec) = @_ ;
708
709	0					my @vals ;
710
711						## Set up vars
712	0					my %vars = $this->vars() ;
713
714	0					$vars{'sqlvar_select_varlist'} = '*' ;
715	0					$vars{'sqlvar_query'} = $CMD_SQL{'query'}{'format'} ;
716	0					$vars{'@sqlvar_query'} = $CMD_SQL{'query'}{'vals'} ;
717
718						# Default table name
719	0					$vars{'sqlvar_table'} = $vars{'table'} ;
720
721	0					$this->_dbg_prt(["sth_create($name)\n"], 2) ;
722
723						## Guess command based on name
724	0					my $cmd = $this->_sql_cmd($name) ;
725
726	0					$this->_dbg_prt([" + cmd=$cmd\n"], 2) ;
727
728						## Handle hash
729	0	0				if (ref($spec) eq 'HASH')
		0
730						{
731	0					my %spec = (%{$spec}) ;
	0
732
733						# Set table if specified
734	0	0				$vars{'sqlvar_table'} = delete $spec{'table'} if (exists($spec{'table'})) ;
735
736						# see if command specified
737	0	0				$cmd = delete $spec{'cmd'} if (exists($spec{'cmd'})) ;
738	0					$cmd = lc $cmd ;
739
740						# error check
741	0	0				$this->throw_fatal("No valid sql command") unless $cmd ;
742
743						# Process spec - set vars
744	0					$this->_sql_setvars($cmd, \%spec, \%vars) ;
745						}
746						elsif (!ref($spec))
747						{
748						# Process spec - set vars
749	0		0			$this->_sql_setvars($cmd \|\| 'query', $spec, \%vars) ;
750						}
751
752	0					$this->_dbg_prt(["Vars=", \%vars], 2) ;
753
754	0					$this->_dbg_prt(["+ expand vars\n"], 2) ;
755
756						## Run through all vars and expand them
757	0					$this->_sql_expand_vars(\%vars) ;
758
759						## Run through all vars and expand arrays them
760	0					$this->_sql_expand_arrays(\%vars) ;
761
762
763						# query should now be in variable 'sqlvar_query'
764	0					my $sql = $vars{'sqlvar_query'} ;
765
766						# values should now be in variable '@sqlvar_query'
767	0					my $values_aref = $vars{'@sqlvar_query'} ;
768
769	0	0				if ($this->debug())
770						{
771	0					print "\n------------------------------------\n" ;
772	0					print "PREPARE SQL($name): $sql\n----------\n" ;
773	0					$this->prt_data("Values=", $values_aref) ;
774						}
775
776						#$this->prt_data("Values=", $values_aref, "\n--------------------\nVars=", \%vars) ;
777
778						## Use given/created command sql
779	0					my $dbh = $this->connect() ;
780	0	0				$this->throw_fatal("No database created", 1) unless $dbh ;
781
782	0					my $sth ;
783						eval
784	0					{
785	0					$sth = $dbh->prepare($sql) ;
786						};
787	0	0				$this->throw_fatal("STH prepare error $@\nQuery=$sql", 1) if $@ ;
788
789	0					my $sth_href = $this->_sth() ;
790	0					$sth_href->{$name} = {
791						'sth' => $sth,
792						'vals' => $values_aref,
793						'query' => $sql, # For debug
794						} ;
795
796						}
797
798
799
800
801						#----------------------------------------------------------------------------
802
803						=item B
804
805						Use a pre-prepared named sql query to return results. If the query has already been
806						given a set of values, then use them; otherwise use the values specified in this call
807						(or append the values to an insufficient list of values given when the sth was created)
808
809						=cut
810
811						sub sth_query
812						{
813	0			0	1	my $this = shift ;
814	0					my ($name, @vals) = @_ ;
815
816	0					my $sth_href = $this->_sth_record($name) ;
817	0	0				if ($sth_href)
818						{
819	0					my ($sth, $vals_aref, $query) = @$sth_href{qw/sth vals query/} ;
820
821						# TODO: expand vars?
822	0					my @args ;
823	0					foreach my $arg (@$vals_aref)
824						{
825						## process each value
826	0	0				if (ref($arg) eq 'SCALAR')
		0
		0
827						{
828						## Ref to scalar
829	0					push @args, $$arg ;
830						}
831						elsif (ref($arg) eq 'HASH')
832						{
833						## Special case handling where STH was created with an ARRAY ref or HASH ref
834	0	0				if ($arg->{'type'} eq 'HASH')
		0
835						{
836						## get latest value from hash ref
837	0					push @args, $arg->{'hash'}{$arg->{'var'}} ;
838						}
839						elsif ($arg->{'type'} eq 'ARRAY')
840						{
841						## get latest value from array ref
842	0					push @args, $arg->{'array'}[$arg->{'index'}] ;
843						}
844						}
845						elsif (!ref($arg))
846						{
847						## Standard scalar
848	0					push @args, $arg ;
849						}
850						}
851
852
853
854	0					$this->_dbg_prt(["Sql::sth_query($query) : args=", \@args, "vals=", \@vals], 2) ;
855
856						# execute
857						eval
858	0					{
859	0					$sth->execute(@args, @vals) ;
860						};
861	0	0				if ($@)
862						{
863	0					my $vals = join(', ', @args, @vals) ;
864	0	0				$this->throw_fatal("STH \"$name\"execute error $@\nQuery=$query\nValues=$vals", 1) if $@ ;
865						}
866						}
867
868	0					return $this ;
869						}
870
871						#----------------------------------------------------------------------------
872
873						=item B
874
875						Use a pre-prepared named sql query to return results. Return all results in array.
876
877						=cut
878
879						sub sth_query_all
880						{
881	0			0	1	my $this = shift ;
882	0					my ($name, @vals) = @_ ;
883
884	0					my @results ;
885
886	0					$this->sth_query($name, @vals) ;
887	0					while(my $href = $this->next($name))
888						{
889	0					push @results, $href ;
890						}
891
892	0					return @results ;
893						}
894
895
896
897						#----------------------------------------------------------------------------
898
899						=item B
900
901						Query database
902
903						=cut
904
905						sub query
906						{
907	0			0	1	my $this = shift ;
908	0					my ($query, @vals) = @_ ;
909
910	0					$this->sth_create($DEFAULT_STH_NAME, $query) ;
911	0					$this->sth_query($DEFAULT_STH_NAME, @vals) ;
912
913	0					return $this ;
914						}
915
916						#----------------------------------------------------------------------------
917
918						=item B
919
920						Query database - return array of complete results, each entry is a hash ref
921
922						=cut
923
924						sub query_all
925						{
926	0			0	1	my $this = shift ;
927	0					my ($query, @vals) = @_ ;
928
929	0					my @results ;
930
931	0					$this->query($query, @vals) ;
932	0					while(my $href = $this->next())
933						{
934	0					push @results, $href ;
935						}
936
937	0					return @results ;
938						}
939
940						#----------------------------------------------------------------------------
941
942						=item B
943
944						Do sql command
945
946						=cut
947
948						sub do
949						{
950	0			0	1	my $this = shift ;
951	0					my ($sql) = @_ ;
952
953	0					my $dbh = $this->connect() ;
954
955						# Do query
956						eval
957	0					{
958	0					$dbh->do($sql) ;
959						};
960	0	0				if ($@)
961						{
962	0	0				$this->throw_fatal("SQL do error $@\nSql=$sql", 1) if $@ ;
963						}
964
965	0					return $this ;
966						}
967
968						#----------------------------------------------------------------------------
969
970						=item B
971
972						Process the SQL text, split it into one or more SQL command, then execute each of them
973
974						=cut
975
976						sub do_sql_text
977						{
978	0			0	1	my $this = shift ;
979	0					my ($sql_text) = @_ ;
980
981	0					while ($sql_text =~ /([^;]*);/gm)
982						{
983	0					$this->do($1) ;
984						}
985
986	0					return $this ;
987						}
988
989						#----------------------------------------------------------------------------
990
991						=item B
992
993						Returns hash ref to next row (as a result of query). Uses prepared STH name $name
994						(as created by sth_create method), or default name (as created by query method)
995
996						=cut
997
998						sub next
999						{
1000	0			0	1	my $this = shift ;
1001	0					my ($name) = @_ ;
1002
1003						# Get STH and get next row
1004	0		0			$name \|\|= $DEFAULT_STH_NAME ;
1005	0					my $sth = $this->_sth_record_sth($name) ;
1006	0					my $href = $sth->fetchrow_hashref() ;
1007
1008	0					$this->_dbg_prt(["Sql::next() => sth=",$sth, " : record=",$href,"\n"]) ;
1009
1010	0					return $href ;
1011						}
1012
1013						#----------------------------------------------------------------------------
1014
1015						=item B
1016
1017						Returns list of tables for this database
1018
1019						=cut
1020
1021						sub tables
1022						{
1023	0			0	1	my $this = shift ;
1024
1025						# return result
1026	0					return $this->connect()->tables() ;
1027						}
1028
1029
1030						#----------------------------------------------------------------------------
1031
1032						=item B
1033
1034						Convert standard date string (d-MMM-YYYY) or (d/M/YY) to SQL based date (YYYY-MM-DD)
1035
1036						=cut
1037
1038						sub datestr_to_sqldate
1039						{
1040	0			0	1	my $this = shift ;
1041	0					my ($datestr) = @_ ;
1042
1043	0					my $sqldate ;
1044
1045						#print "datestr_to_sqldate($datestr)\n" ;
1046
1047	0	0				if ($datestr =~ m/(\d{2})\-(\d{2})\-(\d{4})/)
1048						{
1049	0					$sqldate = "$3-$2-$1" ;
1050						#print " + simple : date=$sqldate\n" ;
1051						}
1052						else
1053						{
1054						# Handle d-MMM-YYYY (already copes with d/M/YY)
1055	0					$datestr =~ s%-%/%g ;
1056	0					my $date = ParseDate($datestr) ;
1057	0					$sqldate = UnixDate($date, "%Y-%m-%d") ;
1058						#print " + UnixDate : date=$sqldate\n" ;
1059						}
1060
1061	0					return $sqldate ;
1062						}
1063
1064
1065						#----------------------------------------------------------------------------
1066
1067						=item B
1068
1069						Convert SQL based date (YYYY-MM-DD) to standard date string (d-MMM-YYYY)
1070
1071						=cut
1072
1073						sub sqldate_to_date
1074						{
1075	0			0	1	my $this = shift ;
1076	0					my ($sqldate) = @_ ;
1077
1078	0					my $datestr ;
1079
1080	0	0				if ($sqldate =~ m/(\d{4})\-(\d{2})\-(\d{2})/)
1081						{
1082	0					$datestr = "$3-$2-$1" ;
1083						}
1084						else
1085						{
1086	0					$sqldate =~ s%-%/%g ;
1087	0					my $date = ParseDate($sqldate) ;
1088
1089	0					$datestr = UnixDate($date, "%d-%m-%Y") ;
1090
1091						}
1092
1093	0					return $datestr ;
1094						}
1095
1096
1097						#----------------------------------------------------------------------------
1098
1099						=item B
1100
1101						Convert SQL based date (YYYY-MM-DD) to a date string suitable for Date::Manip (d/M/YYYY)
1102
1103						=cut
1104
1105						sub sqldate_to_datemanip
1106						{
1107	0			0	1	my $this = shift ;
1108	0					my ($sqldate) = @_ ;
1109
1110	0					my $datestr ;
1111
1112	0	0				if ($sqldate =~ m/(\d{4})\-(\d{2})\-(\d{2})/)
1113						{
1114	0					$datestr = "$3/$2/$1" ;
1115						}
1116						else
1117						{
1118	0					$sqldate =~ s%-%/%g ;
1119	0					my $date = ParseDate($sqldate) ;
1120
1121	0					$datestr = UnixDate($date, "%d/%m/%Y") ;
1122
1123						}
1124
1125	0					return $datestr ;
1126						}
1127
1128
1129						#----------------------------------------------------------------------------
1130
1131						=item B
1132
1133						NOTE: Only works when feature is registered with an application
1134
1135						Execute the (possible sequence of) command(s) stored in a named __DATA__ area in the application.
1136
1137						=cut
1138
1139						sub sql_from_data
1140						{
1141	0			0	1	my $this = shift ;
1142	0					my ($name) = @_ ;
1143
1144	0					my $app = $this->app() ;
1145	0	0				$this->throw_error("Unable to find DATA section since not associated with an application") unless $app ;
1146
1147						# Get named data
1148	0					my $sql_text = $app->data($name) ;
1149
1150	0	0				if ($sql_text)
1151						{
1152						## process the data
1153	0					$this->do_sql_text($sql_text) ;
1154						}
1155						else
1156						{
1157	0					$this->throw_error("Data section $name contains no SQL") ;
1158						}
1159
1160	0					return $this ;
1161						}
1162
1163
1164
1165
1166						# ============================================================================================
1167						# PRIVATE METHODS
1168						# ============================================================================================
1169
1170
1171						#----------------------------------------------------------------------------
1172
1173						=item B<_sql_cmd($name)>
1174
1175						Convert $name into a sql command if possible
1176
1177						=cut
1178
1179						sub _sql_cmd
1180						{
1181	0			0		my $this = shift ;
1182	0					my ($name) = @_ ;
1183
1184	0					my $cmd ;
1185	0					foreach my $match (keys %CMDS)
1186						{
1187	0	0				if ($name =~ m/^$match/i)
1188						{
1189	0					$cmd = $CMDS{$match} ;
1190	0					last ;
1191						}
1192						}
1193
1194	0					return $cmd ;
1195						}
1196
1197						#----------------------------------------------------------------------------
1198
1199						=item B<_sql_setvars($context, $spec, $vars_href)>
1200
1201						Set/add variables into the $vars_href HASH driven by the specification $spec (which may
1202						be a sql string or a HASH specification). Creates the variables in the namespace defined by
1203						the $context string (which is usually the lookup string into the %CMD_SQL table)
1204
1205						=cut
1206
1207						sub _sql_setvars
1208						{
1209	0			0		my $this = shift ;
1210	0					my ($context, $spec, $vars_href) = @_ ;
1211
1212	0					$this->_dbg_prt([" > _sql_setvars($context)\n"], 2) ;
1213
1214
1215						## Start by getting control info from %CMD_SQL if possible
1216	0					my $var = "sqlvar_${context}" ;
1217	0					my ($format, $prefix) ;
1218	0	0				if (exists($CMD_SQL{$context}))
1219						{
1220						## Get default sql string
1221	0					$format = $CMD_SQL{$context}{'format'} ;
1222
1223						## Set variables
1224	0	0				$prefix = $CMD_SQL{$context}{'prefix'} if exists($CMD_SQL{$context}{'prefix'}) ;
1225	0					foreach my $name (qw/format prefix/)
1226						{
1227	0	0				$vars_href->{"${var}_$name"} = $CMD_SQL{$context}{$name} if exists($CMD_SQL{$context}{$name}) ;
1228						}
1229
1230						## Array
1231	0	0				$vars_href->{"\@${var}"} = $CMD_SQL{$context}{'vals'} if exists($CMD_SQL{$context}{'vals'}) ;
1232						}
1233
1234	0					$this->_dbg_prt([" > + var=$var format=$format\n"], 2) ;
1235
1236						## Handle hash
1237	0	0				if (ref($spec) eq 'HASH')
		0
1238						{
1239						## HASH
1240	0					my %spec = (%{$spec}) ;
	0
1241
1242						# Handle any vars
1243	0					my $vars_aref = [] ;
1244	0	0				if (exists($spec{'vars'}))
1245						{
1246						# create set of lists within this context namespace
1247	0					$vars_aref = delete $spec{'vars'} ;
1248
1249						# TODO: error report
1250
1251	0	0				if (ref($vars_aref) eq 'ARRAY')
1252						{
1253						# Supported lists:
1254						#setlist => [SET] `var`=?, `var`=? ..
1255						#andlist => [WHERE] `var`=? AND `var`=? ..
1256						#varlist => [SELECT\|ORDER BY] `var`, `var`
1257	0					my ($setlist, $andlist, $varlist) ;
1258	0					foreach my $var (@$vars_aref)
1259						{
1260	0	0				$setlist .= ', ' if $setlist ;
1261	0					$setlist .= "`$var`=?" ;
1262
1263	0	0				$andlist .= ' AND ' if $andlist ;
1264	0					$andlist .= "`$var`=?" ;
1265
1266	0	0				$varlist .= ', ' if $varlist ;
1267	0					$varlist .= "`$var`" ;
1268						}
1269
1270						# Set vars
1271	0					$vars_href->{"${var}_setlist"} = $setlist ;
1272	0					$vars_href->{"${var}_andlist"} = $andlist ;
1273	0					$vars_href->{"${var}_varlist"} = $varlist ;
1274						}
1275						}
1276
1277						## Handle any vals
1278
1279						# default to object field
1280	0					my $vals_ref = $this->sql_vars ;
1281
1282						# see if user specified any
1283	0	0				if (exists($spec{'vals'}))
1284						{
1285						# create set of lists within this context namespace
1286	0					$vals_ref = delete $spec{'vals'} ;
1287						}
1288
1289	0					$this->_dbg_prt([" > VALS : vals_ref=",$vals_ref," internal=", $this->sql_vars,"\n"], 2) ;
1290
1291						# handle vals reference
1292	0	0				if ($vals_ref)
1293						{
1294						# TODO: error report
1295
1296						## Array
1297	0					my $array_name = "\@${var}_vals" ;
1298	0					$vars_href->{$array_name} = [] ;
1299
1300	0					$this->_dbg_prt([" > + + VALS : array=$array_name, vals_ref=$vals_ref\n"], 2) ;
1301
1302
1303	0	0				if (ref($vals_ref) eq 'ARRAY')
		0
1304						{
1305	0					$this->_dbg_prt([" > + + + adding array\n"], 2) ;
1306	0					foreach (my $idx=0; $idx < scalar(@$vals_ref); ++$idx)
1307						{
1308						## Store the HASH ref for ALL variables. Then, when we access the values, they will be the latest
1309	0					push @{$vars_href->{$array_name}}, {
	0
1310						'type' => 'ARRAY',
1311						'array' => $vals_ref,
1312						'index' => $idx,
1313						} ;
1314						}
1315						}
1316						elsif (ref($vals_ref) eq 'HASH')
1317						{
1318	0					$this->_dbg_prt([" > + + + adding hash\n"], 2) ;
1319	0					foreach my $var (@$vars_aref)
1320						{
1321	0					$this->_dbg_prt([" > + + + + $var=", $vars_href->{$var}, "\n"], 2) ;
1322						# $vals_ref->{$var} \|\|= '' ;
1323						# push @{$vars_href->{$array_name}}, \$vals_ref->{$var} ;
1324
1325						## Store the HASH ref for ALL variables. Then, when we access the values, they will be the latest
1326	0					push @{$vars_href->{$array_name}}, {
	0
1327						'type' => 'HASH',
1328						'hash' => $vals_ref,
1329						'var' => $var,
1330						} ;
1331						}
1332						}
1333						}
1334
1335						## If sql specified, use it
1336	0	0				if (exists($spec{'sql'}))
1337						{
1338						# create set of lists within this context namespace
1339	0					$format = delete $spec{'sql'} ;
1340						}
1341
1342	0					$this->_dbg_prt([" > + processing hash ...\n"], 2) ;
1343						#$this->prt_data("spec=", \%spec) ;
1344
1345						## cycle through the other hash keys to produce other variables
1346	0					foreach my $var (keys %spec)
1347						{
1348	0					$this->_dbg_prt([" > + + $var = $spec{$var}\n"], 2) ;
1349
1350	0					$this->_sql_setvars($var, $spec{$var}, $vars_href) ;
1351						}
1352
1353						#$this->prt_data("done hash : spec=", \%spec) ;
1354
1355						}
1356						elsif (!ref($spec))
1357						{
1358						## String
1359	0					$format = $spec ;
1360
1361	0					$this->_dbg_prt([" > + spec is string : format=$format\n"], 2) ;
1362
1363
1364						}
1365
1366	0					$this->_dbg_prt([" > Now: prefix=$prefix , format=$format\n"], 2) ;
1367
1368
1369						## Ensure prefix is present
1370	0	0	0			if ($format && $prefix)
1371						{
1372						# Use prefix if necessary
1373	0	0				unless ($format =~ m/^\s*$context/i)
1374						{
1375	0					$this->_dbg_prt([" > + + Adding prefix=$prefix to format=$format\n"], 2) ;
1376	0					$format = "$prefix $format" ;
1377						}
1378						}
1379
1380						# Set var
1381	0					$vars_href->{$var} = $format ;
1382
1383	0					$this->_dbg_prt([" > _sql_setvars($context) - END [format=$format]\n"], 2) ;
1384
1385						}
1386
1387						#----------------------------------------------------------------------------
1388
1389						=item B<_sql_expand_vars($vars_href)>
1390
1391						Expand all the variables in the HASH ref
1392
1393						=cut
1394
1395						sub _sql_expand_vars
1396						{
1397	0			0		my $this = shift ;
1398	0					my ($vars_href) = @_ ;
1399
1400	0					$this->_dbg_prt(["_sql_expand_vars()\n"], 2) ;
1401	0					$this->_dbg_prt(["vars", \$vars_href], 2) ;
1402
1403
1404						# do all vars in HASH
1405	0					foreach my $var (keys %$vars_href)
1406						{
1407						# skip non SCALAR
1408	0	0				next if ref($vars_href->{$var}) ;
1409
1410						# skip if empty
1411	0	0				next unless $vars_href->{$var} ;
1412
1413	0					$this->_dbg_prt([" + $var\n"], 2) ;
1414
1415						# Keep replacing until all variables have been expanded
1416	0					my $ix = index $vars_href->{$var}, '$' ;
1417	0					while ($ix >= 0)
1418						{
1419	0					$this->_dbg_prt([" + + ix=$ix : $var = $vars_href->{$var}\n"], 2) ;
1420
1421
1422						# At least 1 more variable to replace, so replace it
1423	0					$vars_href->{$var} =~ s{
1424						\$ # find a literal dollar sign
1425						\{{0,1} # optional brace
1426						(\w+) # find a "word" and store it in $1
1427						\}{0,1} # optional brace
1428						}{
1429	0	0				if (defined $vars_href->{$1}) {
1430	0					$vars_href->{$1}; # expand
1431						} else {
1432	0					""; # remove
1433						}
1434						}egx;
1435
1436	0					$ix = index $vars_href->{$var}, '$' ;
1437
1438	0					$this->_dbg_prt([" + + + $var = $vars_href->{$var}\n"], 2) ;
1439
1440						}
1441						}
1442
1443	0					$this->_dbg_prt(["_sql_expand_vars - END\n"], 2) ;
1444
1445						}
1446
1447						#----------------------------------------------------------------------------
1448
1449						=item B<_sql_expand_arrays($vars_href)>
1450
1451						Expand all the array variables in the HASH ref
1452
1453						=cut
1454
1455						sub _sql_expand_arrays
1456						{
1457	0			0		my $this = shift ;
1458	0					my ($vars_href) = @_ ;
1459
1460	0					$this->_dbg_prt(["_sql_expand_arrays()\n"], 2) ;
1461	0					$this->_dbg_prt(["vars", \$vars_href], 2) ;
1462
1463						# do all vars in HASH
1464	0					foreach my $var (keys %$vars_href)
1465						{
1466	0					$this->_dbg_prt([" + $var=", $vars_href->{$var}, "\n"], 2) ;
1467
1468						# skip variables that aren't named @....
1469	0	0				next unless $var =~ /^\@/ ;
1470
1471						# skip if already an array
1472	0	0				next if ref($vars_href->{$var}) eq 'ARRAY' ;
1473
1474						# Expand it
1475	0					$this->_sql_expand_array($var, $vars_href) ;
1476						}
1477
1478	0					$this->_dbg_prt(["_sql_expand_arrays() - END\n"], 2) ;
1479
1480						}
1481
1482						#----------------------------------------------------------------------------
1483
1484						=item B<_sql_expand_array($arr, $vars_href)>
1485
1486						Expand the named array
1487
1488						=cut
1489
1490						sub _sql_expand_array
1491						{
1492	0			0		my $this = shift ;
1493	0					my ($array, $vars_href) = @_ ;
1494
1495	0					$this->_dbg_prt(["_sql_expand_array($array)\n"], 2) ;
1496
1497						# skip if already an array
1498	0	0				unless (ref($vars_href->{$array}) eq 'ARRAY')
1499						{
1500	0	0				if ($vars_href->{$array})
1501						{
1502						# split on commas
1503	0					my @arr_list = split(/[,\s+]/, $vars_href->{$array}) ;
1504
1505						# start array off
1506	0					$vars_href->{$array} = [] ;
1507
1508	0					$this->_dbg_prt([" -- setting array\n"], 2) ;
1509
1510						# process them
1511	0					foreach my $arr (@arr_list)
1512						{
1513	0					$this->_dbg_prt([" -- -- get $arr\n"], 2) ;
1514
1515						# if reference to another array, evaluate it
1516	0	0				if ($arr =~ /^\@/)
1517						{
1518	0					$this->_dbg_prt([" -- -- -- expand $arr\n"], 2) ;
1519	0					my $arr_aref = $this->_sql_expand_array($arr, $vars_href) ;
1520
1521	0					$this->_dbg_prt([" -- -- -- push array $arr=", $arr_aref, "\n"], 2) ;
1522
1523						# Add to list
1524	0	0				push @{$vars_href->{$array}}, @$arr_aref if $arr_aref ;
	0
1525						}
1526						else
1527						{
1528	0					$this->_dbg_prt([" -- -- -- push value ", $arr, "\n"], 2) ;
1529						# Add to list
1530	0					push @{$vars_href->{$array}}, $arr ;
	0
1531						}
1532						}
1533						}
1534						}
1535
1536	0					$this->_dbg_prt(["ARRAY $array=", $vars_href->{$array}], 2) ;
1537	0					$this->_dbg_prt(["_sql_expand_array($array) - END\n"], 2) ;
1538
1539	0					return ($vars_href->{$array}) ;
1540						}
1541
1542
1543						#----------------------------------------------------------------------------
1544
1545						=item B<_sth_record($name)>
1546
1547						Returns the saved sth information looked up from $name; returns undef otherwise
1548
1549						=cut
1550
1551						sub _sth_record
1552						{
1553	0			0		my $this = shift ;
1554	0					my ($name) = @_ ;
1555
1556						# error check
1557	0	0				if (!$name)
1558						{
1559	0	0				$this->dump_callstack() if $this->debug() ;
1560	0	0				$this->throw_fatal("Attempting to find prepared statement but no name has been specified") unless $name ;
1561						}
1562
1563	0					my $sth_href = $this->_sth() ;
1564	0	0				if (exists($sth_href->{$name}))
1565						{
1566	0					$sth_href = $sth_href->{$name} ;
1567
1568						# error check
1569	0	0				$this->throw_fatal("sth $name not created") unless $sth_href ;
1570
1571						}
1572						else
1573						{
1574						# error
1575	0					$this->throw_fatal("sth $name not created") ;
1576						}
1577
1578	0					return $sth_href ;
1579						}
1580
1581						#----------------------------------------------------------------------------
1582
1583						=item B<_sth_record_sth($name)>
1584
1585						Returns the saved sth looked up from $name; returns undef otherwise
1586
1587						=cut
1588
1589						sub _sth_record_sth
1590						{
1591	0			0		my $this = shift ;
1592	0					my ($name) = @_ ;
1593
1594	0					my $sth ;
1595	0					my $sth_href = $this->_sth_record($name) ;
1596
1597	0	0	0			if ($sth_href && exists($sth_href->{'sth'}))
1598						{
1599	0					$sth = $sth_href->{'sth'} ;
1600
1601	0	0				$this->throw_fatal("sth $name not created" ) unless $sth ;
1602
1603						}
1604						else
1605						{
1606	0					$this->throw_fatal("sth $name not created" ) ;
1607						}
1608
1609	0					return $sth ;
1610						}
1611
1612						#----------------------------------------------------------------------------
1613
1614						=item B<_set_trace($dbh, $trace, $trace_file)>
1615
1616						Update trace level
1617
1618						=cut
1619
1620						sub _set_trace
1621						{
1622	0			0		my $this = shift ;
1623	0					my ($dbh, $trace, $trace_file) = @_ ;
1624
1625	0	0				if ($dbh)
1626						{
1627	0					$dbh->trace($trace, $trace_file)
1628						}
1629						}
1630
1631						# ============================================================================================
1632						# END OF PACKAGE
1633
1634						=back
1635
1636						=head1 DIAGNOSTICS
1637
1638						Setting the debug flag to level 1 prints out (to STDOUT) some debug messages, setting it to level 2 prints out more verbose messages.
1639
1640						=head1 AUTHOR
1641
1642						Steve Price C<< >>
1643
1644						=head1 BUGS
1645
1646						None that I know of!
1647
1648						NOTE: To avoid the common "Mysql server gone away" problem, everywhere that I get the database connection handle, I actually call
1649						the connect() method to ensure the connection is working.
1650
1651						=cut
1652
1653						1;
1654
1655						__END__