File Coverage

blib/lib/SQL/Exec.pm
Criterion Covered Total %
statement 28 30 93.3
branch n/a
condition n/a
subroutine 10 10 100.0
pod n/a
total 38 40 95.0


line stmt bran cond sub pod time code
1             package SQL::Exec;
2             our $VERSION = '0.10';
3 16     16   87 use strict;
  16         24  
  16         638  
4 16     16   72 use warnings;
  16         26  
  16         387  
5 16     16   87 use feature 'switch';
  16         22  
  16         1933  
6 16     16   87 use Carp;
  16         26  
  16         1730  
7 16     16   89 use Exporter 'import';
  16         28  
  16         872  
8 16     16   105 use Scalar::Util 'blessed', 'reftype', 'openhandle';
  16         40  
  16         2423  
9 16     16   241129 use List::MoreUtils 'any';
  16         25017  
  16         1443  
10 16     16   47866 use DBI;
  16         420985  
  16         1244  
11 16     16   22317 use DBI::Const::GetInfoType;
  16         148926  
  16         2667  
12 16     16   26564 use DBIx::Connector;
  0            
  0            
13             use SQL::SplitStatement;
14             use SQL::Exec::Statement;
15              
16             # Note: This file contains both a POD documentation which describes the public
17             # API of this package and a technical documentation (on the internal methods and
18             # how to subclasse this package) in standard Perl comments.
19              
20             =encoding utf-8
21              
22             =head1 NAME
23              
24             SQL::Exec - Simple thread and fork safe database access with functionnal and OO interface
25              
26             =head1 SYNOPSIS
27              
28             use SQL::Exec ':all';
29            
30             connect('dbi:SQLite:dbname=db_file');
31            
32             execute(SQL);
33            
34             my $val = query_one_value(SQL);
35            
36             my @line = query_one_line(SQL);
37            
38             my @table = query_all_line(SQL);
39              
40             =head2 Main functionnalities
41              
42             SQL::Exec is (another) interface to the DBI which strive for simplicity. Its main
43             functionalities are:
44              
45             =over 4
46              
47             =item * DBMS independent. The module offers specific support for some DB server
48             but can work with any DBD driver;
49              
50             =item * Extremely simple, a query is always only one function or method call;
51              
52             =item * Everything is as efficient: you choose the function to call based
53             only on the data that you want to get back, not on some supposed performance
54             benefit;
55              
56             =item * Supports both OO and functional paradigm with the same interface and
57             functionalities;
58              
59             =item * Hides away all DBIism, you do not need to set any options, they are
60             handled by the library with nice defaults;
61              
62             =item * Safe: SQL::Exec verify that what happens is what you meant;
63              
64             =item * Not an ORM, nor a query generator: you are controling your SQL;
65              
66             =item * Easy to extends to offer functionalities specific to one DB server;
67              
68             =item * Handles transparently network failure, fork, thread, etc;
69              
70             =item * Safely handle multi statement query and automatic transaction;
71              
72             =item * Handles prepared statements and bound parameters.
73              
74             =back
75              
76             All this means that SQL::Exec is extremely beginners friendly, it can be used
77             with no advanced knowledge of Perl and code using it can be easily read by people
78             with no knowledge of Perl at all, which is interesting in a mixed environment.
79              
80             Also, the fact that SQL::Exec does not try to write SQL for the programmer (this
81             is a feature, not a bug), ease the migration to other tools or languages if a big
82             part of the application logic is written in SQL.
83              
84             Thus SQL::Exec is optimal for fast prototyping, for small applications which do
85             not need a full fledged ORM, for migrating SQL code from/to an other environment,
86             etc. It is usable (thanks to C) in a CGI scripts, in a mod_perl
87             program or in any web framework as the database access layer.
88              
89             =head1 DESCRIPTION
90              
91             =cut
92              
93             #dire un peu ce qu'est DBI et ce que sont les DBD.
94              
95             =head2 Support of specific DB
96              
97             The C library is mostly database agnostic. However there is some
98             support (limited at the moment) for specific database which will extends the
99             functionnalities of the library for those database.
100              
101             If there is a sub-classe of C for your prefered RDBMS you should
102             use it (for both the OO and the functionnal interface of the library) rather than
103             using directly C. These sub-classes will provide tuned functions
104             and method for your RDBMS, additionnal functionnalities, will set specific
105             database parameters correctly and will assist you to connect to your desired
106             database.
107              
108             You will find in L a list of the supported RDBMS and a link to
109             the documentation of their specific modules. If your prefered database is not
110             listed there, you can still use C directly and get most of its benefits.
111              
112             Do not hesitate to ask for (or propose) a module for your database of choice.
113              
114             =head2 Exported symbols
115              
116             Each function of this library (that is everything described below except C
117             and C which are only package method) may be exported on request.
118              
119             There is also a C<':all'> tag to get everything at once. Just do :
120              
121             use SQL::Exec ':all';
122              
123             at the beginning of your file to get all the power of C with an overhead
124             as small as possible.
125              
126             =cut
127              
128              
129              
130             ################################################################################
131             ################################################################################
132             ## ##
133             ## HELPER FUNCTIONS ##
134             ##                                                                            ##
135             ################################################################################
136             ################################################################################
137             # The functions in this section are for internal use only by this package
138             # or by subclasses. The functions here are NOT method.
139              
140              
141              
142             # functions are 'push-ed' below in this array.
143             our @EXPORT_OK = ();
144             # every thing is put in ':all' at the end of the file.
145             our %EXPORT_TAGS = ();
146              
147             our @CARP_NOT = ('DBIx::Connector');
148              
149              
150              
151             # The structure of a SQL::Exec object, this hash is never made an object but
152             # it is copied by get_empty whenever a new object must be created.
153             # N.B.: The get_empty function must be adapted if new references are added
154             # inside this object (like e.g. options and restore_options), to ensure that
155             # they are properly copied.
156             #
157             # Warning : an SQL::Exec::Statement object shares the sames structure but with
158             # an added 'parent' pointer.
159             my %empty_handle;
160             BEGIN {
161             %empty_handle = (
162             options => {
163             die_on_error => 1, # utilise croak
164             print_error => 1, # utilise carp pour les erreurs
165             print_warning => 1, # utilise toujours carp
166             print_query => 0, # spécifie un channel à utiliser
167             strict => 1,
168             replace => undef,
169             connect_options => undef,
170             auto_transaction => 1,
171             auto_split => 1,
172             use_connector => 1,
173             stop_on_error => 1,
174             line_separator => "\n", # pour query_to_file
175             value_separator => ';', # pour query_to_file
176             },
177              
178             restore_options => {},
179              
180             db_con => undef,
181             is_connected => 0,
182             last_req_str => "",
183             last_req => undef,
184             last_stmt => undef,
185             req_over => 1,
186             auto_handle => 0,
187             #last_msg => undef,
188             );
189             }
190              
191             # This variable stores the default instance of this class. It is set up in a
192             # BEGIN block.
193             my $default_handle;
194              
195             # Return a reference of a new copy of the empty_handle hash, used by the
196             # constructors of the class.
197             sub get_empty {
198             my %new_empty = %empty_handle;
199             $new_empty{options} = { %{$empty_handle{options}} };
200             $new_empty{restore_options} = { %{$empty_handle{restore_options}} };
201             return \%new_empty;
202             }
203              
204             # One of the three function below (just_get_handle, get_handle and
205             # check_options) must be called at each entry-point of the library with the
206             # syntax: '&function;' which allow the current @_ array to be passed to the
207             # function without being copied.
208             # Their purpose is to check if the method was invoqued as a method or as a
209             # function in which case the default class instance is used.
210             #
211             # This function is called by the very few entry point of the library which are
212             # not supposed to clear the errstr field of the instance.
213             sub just_get_handle {
214             return (scalar(@_) && blessed $_[0] && $_[0]->isa(__PACKAGE__)) ? shift @_ : $default_handle;
215             }
216              
217             # See above for the purpose and usage of this function.
218             #
219             # This function is called by the entry points which must not restore the saved
220             # options or which are not expected to receive any function.
221             sub get_handle {
222             my $c = &just_get_handle;
223             delete $c->{errstr};
224             delete $c->{warnstr};
225             return $c;
226             }
227              
228             # See above for the purpose and usage of this function.
229             #
230             # This function is called by most of the entry points of the library which are
231             # generally expected to work both as package function and as instance method.
232             # Also, this function check if the last argument it receives is a hash-ref and,
233             # if so, assume that it is option to be applied for the duration of the current
234             # call.
235             sub check_options {
236             my $c = &get_handle;
237              
238             my $h = {};
239             if (@_ && ref($_[-1]) && ref($_[-1]) eq 'HASH') {
240             $h = pop @_;
241             }
242            
243             my $ro = $c->set_options($h);
244            
245             if ($ro) {
246             $c->{restore_options} = $ro;
247             } else {
248             $c->strict_error('The options were not correctly applied due to errors') and return;
249             }
250              
251             return $c;
252             }
253              
254             # Just a small helper function for the sub-classes to check if a given DBD
255             # driver is installed.
256             sub test_driver {
257             my ($driver) = @_;
258              
259             return any { $_ eq $driver } DBI->available_drivers();
260             }
261              
262             # function used to sanitize the input to the option set/get methods.
263             sub __boolean {
264             if (defined $_[0]) {
265             return $_[0] ? 1 : 0;
266             } else {
267             return undef;
268             }
269             }
270              
271             sub __set_boolean_opt {
272             my ($c, $o, @v) = @_;
273              
274             $c->__restore_options();
275             my $r = $c->{options}{$o};
276             $c->{options}{$o} = __boolean($v[0]) if @v;
277             return $r;
278             }
279              
280             sub __set_opt {
281             my ($c, $o, @v) = @_;
282              
283             $c->__restore_options();
284             my $r = $c->{options}{$o};
285             $c->{options}{$o} = $v[0];
286             return $r;
287             }
288              
289             ################################################################################
290             ################################################################################
291             ## ##
292             ## CONSTRUCTORS/DESTRUCTORS ##
293             ##                                                                            ##
294             ################################################################################
295             ################################################################################
296              
297              
298              
299             =head1 CONSTRUCTORS/DESTRUCTORS
300              
301             If you want to use this library in an object oriented way (or if you want to use
302             multiple database connection at once) you will need to create C
303             object using the constructors described here. If you want to use this library in
304             a purely functionnal way then you will want to take a look at the L
305             function described below which will allow you to connect the library without using
306             a single object.
307              
308             =head2 new
309              
310             my $h = SQL::Exec->new($dsn, $user, $password, %opts);
311              
312             Create a new C object and connect-it to the database defined by
313             the C<$dsn> argument, with the supplied C<$user> and C<$password> if necessary.
314              
315             The syntax of the C<$dsn> argument is described in the manual of your C
316             driver. However, you will probably want to use one of the existing sub-classes of
317             this module to assist you in connecting to some specific database.
318              
319             The C<%opts> argument is optionnal and may be given as a hash or as a hash
320             reference. If the argument is given it set accordingly the option of the object
321             being created. See the L method for a description of the available
322             options.
323              
324             If your DB has a specific support in a L you must
325             use its specific constructor to get the additionnal benefits it will offer.
326              
327             =head2 new_no_connect
328              
329             my $h = SQL::Exec->new_no_connect(%opts);
330              
331             This constructor creates a C object without connecting it to any
332             database. You will need to call the L option on the handle to connect
333             it to a database.
334              
335             The C<%opts> argument is optionnal and is the same as for the C constructor.
336              
337             =head2 destructor
338              
339             Whenever you have finished working with a database connection you may close it
340             (see the L function) or you may just let go of the database handle.
341             There is a C method in this package which will take care of closing the
342             database connection correctly whenever your handle is garbage collected.
343              
344             =cut
345              
346             # Les options que l'on donne à new, sont valable pour l'objet, pas juste
347             # pour l'appel de fonctions/méthode, comme les autres fonctions.
348             # Les options sont a fixer à chaque création d'objet (indépendamment de l'objet
349             # par défaut).
350             # A constructor which will not connect
351             sub new_no_connect {
352             my ($class, @opt) = @_;
353              
354             my $c = get_empty();
355             bless $c, $class;
356             $c->set_options(@opt);
357             return $c;
358             }
359              
360             # dans le cas ou la connection échoue, l'objet est quand même créée et renvoyé
361             # si jamais on ignore les erreurs.
362             sub new {
363             my ($class, @args) = @_;
364            
365             my ($con_str, $user, $pwd, @opt) = $class->build_connect_args(@args);
366             my $c = new_no_connect($class, @opt);
367             $c->__connect($con_str, $user, $pwd);
368             return $c;
369             }
370              
371             # This bless the default handle. The handle is blessed again if it is
372             # connected in a sub classe.
373             UNITCHECK {
374             $default_handle = __PACKAGE__->new_no_connect();
375             }
376              
377              
378             sub DESTROY {
379             my $c = shift;
380             $c->__disconnect() if $c->{is_connected};
381             }
382              
383              
384              
385             ################################################################################
386             ################################################################################
387             ## ##
388             ## INTERNAL METHODS ##
389             ##                                                                            ##
390             ################################################################################
391             ################################################################################
392             # The methods in this section are for internal use only by this package
393             # or by subclasses. The functions here ARE methods and must be called explicitely
394             # on an instance of this class (or of one of its sub-classes).
395              
396              
397             # The purpose of this function is to be overidden in sub-classes which would
398             # take a different set of argument for their constructors without having to
399             # redefine the constructor itself.
400             sub build_connect_args {
401             my ($class, $con_str, $user, $pwd, @opt) = @_;
402              
403             return ($con_str, $user, $pwd, @opt);
404             }
405              
406             # This method must be called when an error condition happen. It croaks, carps or
407             # does nothing depending on the current option. It also set the errstr variable.
408             sub error {
409             my ($c, $msg, @args) = @_;
410              
411             $c->{errstr} = sprintf $msg, @args;
412             $c->{parent}{errstr} = $c->{errstr} if $c->{parent};
413              
414             if ($c->{options}{die_on_error}) {
415             croak $c->{errstr};
416             } elsif ($c->{options}{print_error}) {
417             carp $c->{errstr};
418             }
419              
420             return;
421             }
422              
423             # Same thing but for warning which may only be printed.
424             sub warning {
425             my ($c, $msg, @args) = @_;
426              
427             $c->{warnstr} = sprintf $msg, @args;
428             $c->{parent}{warnstr} = $c->{warnstr} if $c->{parent};
429              
430             if ($c->{options}{print_warning}) {
431             carp $c->{warnstr};
432             }
433              
434             return;
435             }
436              
437             # Same thing but for violation of strictness, test if the currant instance is in
438             # strict mode and, if so, convert strictness violations into errors.
439             #
440             # if the condition which trigger a strict_error is costly then it must be tested
441             # only when strict_error is defined (true or false). Otherwise, the strict_error
442             # method may be called without testing the strict_error option.
443             # You must not return when a strict error is detected, as the processing is able to
444             # continue after it. You must check for the return value of the function and return
445             # if it is true C<$c->strict_error(...) and return;
446             sub strict_error {
447             my ($c, $msg, @args) = @_;
448              
449             if (defined $c->{options}{strict}) {
450             if ($c->{options}{strict}) {
451             $c->error($msg, @args);
452             return 1;
453             } else {
454             $c->warning($msg, @args);
455             return;
456             }
457             } else {
458             return;
459             }
460             }
461              
462             sub format_dbi_error {
463             my ($c, $msg, @args) = @_;
464            
465             #$c = $c->{parent} if $c->{parent};
466            
467             # TODO: corriger ça si on n'utilise pas DBIx::Connector
468             my ($errstr, $err, $state);
469             # TODO: ici on utilise le fait que dbh() renvoie un hashref (toujours), il faudrait
470             # voir si on peut tester la connection plus proprement sans dépendre de la
471             # représentation qu'en fait DBIx::Connector.
472             # le test de dbh est inutile mais plus sûr si la représentation change.
473             if ($c->{db_con} && blessed $c->{db_con}->dbh()) {
474             my $dbh = $c->{db_con}->dbh();
475             $errstr = $dbh->errstr // $dbh->func('plsql_errstr') // '';
476             $err = $dbh->err // '0';
477             $state = $dbh->state // '0'; # // pour la coloration syntaxique de Gedit
478             } else {
479             $errstr = $DBI::errstr // '';
480             $err = $DBI::err // '0';
481             $state = $DBI::state // '0'; # // pour la coloration syntaxique de Gedit
482             }
483             my $err_msg = "Error during the execution of the following request:\n\t".$c->{last_req_str}."\n";
484             $err_msg .= "Error: $msg\n\t Error Code: $err\n\t Error Message: $errstr\n\t State: $state\n";
485              
486             return $err_msg;
487             }
488             # This function is called in case of error in a call to the DBI in order to
489             # format an error message
490             sub dbi_error {
491             my ($c, $msg, @args) = @_;
492              
493             $c->error($c->format_dbi_error($msg.' ',@args));
494              
495             return;
496             }
497              
498             sub __replace {
499             my ($c, $str) = @_;
500              
501             my $r = $c->{options}{replace};
502             if ($r && reftype($r) eq 'CODE') {
503             local $_ = $str;
504             $str = eval { $r->(); $_ };
505             return $c->error("A call to the replace procedure has failed with: $@") if $@;
506             } elsif ($r and blessed($_[0]) and $_[0]->can('replace')) {
507             $str = eval { $r->replace($str) };
508             return $c->error("A call to the replace method of the object given procedure has failed with: $@") if $@;
509             } elsif ($r) {
510             confess "should not happen";
511             }
512              
513             return $str;
514             }
515              
516             # This function is called each time an SQL statement is sent to the database
517             # it possibly apply the replace procedure of a String::Replace object on the
518             # SQL query string and save the query.
519             sub query {
520             my ($c, $query) = @_;
521              
522             $query = $c->__replace($query) or return;
523              
524             if ($c->{options}{print_query}) {
525             chomp (my $r = $query);
526             print { $c->{options}{print_query} } $r."\n";
527             }
528            
529             $c->{last_req_str} = $query;
530              
531             return $query;
532             }
533              
534              
535             # This function must be called by the library entry-points (user called
536             # functions) if they need a connection to the database.
537             sub check_conn {
538             my ($c) = @_;
539              
540             my $rc = $c->{parent} ? $c->{parent} : $c;
541            
542             if (!$rc->{is_connected}) {
543             $c->error("The library is not connected");
544             return;
545             }
546             return 1;
547             }
548              
549              
550             # This internal version of the disconnect function may be called from the
551             # connect function.
552             sub __disconnect {
553             my ($c) = @_;
554             if ($c->{is_connected}) {
555             $c->{last_req}->finish() if defined $c->{last_req} && !$c->{req_over};
556             $c->query("logout");
557             $c->{db_con}->disconnect if defined $c->{db_con};
558             $c->{is_connected} = 0;
559             return 1;
560             } else {
561             $c->strict_error("The library is not connected");
562             return;
563             }
564             }
565              
566             # This function is also expected to be extended in sub-classes and is used by
567             # the default constructors.
568             sub get_default_connect_option {
569             return (
570             PrintError => 0, # les erreurs sont récupéré par le code qui les affiches
571             RaiseError => 0, # lui même.
572             Warn => 1, # des warning généré par DBI
573             PrintWarn => 1, # les warning renvoyé par le drivers lui même
574             AutoCommit => 1,
575             AutoInactiveDestroy => 1, # pour DBIx::Connector
576             ChopBlanks => 0,
577             LongReadLen => 4096, # TODO: Il faut une fonction pour le modifier, Cf la doc de ce paramètre
578             #TODO: il faudrait aussi ajouter du support pour les options Taint...
579             FetchHashKeyName => 'NAME_lc'
580             # cette constante apparait aussi dans low_level_fetchrow_hashref, dans
581             # __get_columns_dummy et dans get_columns (juste lc);
582             );
583             }
584              
585             # Internal connect method, called by the constructors and by the connect function
586             # and by the sub-classses.
587             sub __connect {
588             my ($c, $con_str, $user, $pwd) = @_;
589            
590             if ($c->{is_connected}) {
591             if (not $c->{auto_handle}) {
592             $c->strict_error("The object is already connected") and return;
593             }
594             $c->__disconnect();
595             }
596            
597             my $usr = $user // ''; # //
598             $c->query("login to '${con_str}' with user '${usr}'");
599            
600             my @l = DBI->parse_dsn($con_str);
601             if (not @l or not $l[1]) {
602             $c->error("Cannot connect with an invalid connection string");
603             return;
604             }
605            
606             my $con_opt = $c->{options}{connect_options} // { $c->get_default_connect_option() }; # //
607            
608             if ($c->{options}{use_connector}) {
609             $c->{db_con} = DBIx::Connector->new($con_str, $user, $pwd, $con_opt);
610             # TODO: ici on utilise le fait que dbh() renvoie un hashref (toujours), il faudrait
611             # voir si on peut tester la connection plus proprement sans dépendre de la
612             # représentation qu'en fait DBIx::Connector.
613             # le test de dbh est inutile mais plus sûr si la représentation change.
614             # (idem que pour errstr).
615             if (!$c->{db_con} || ! blessed $c->{db_con}->dbh()) {
616             $c->dbi_error("Cannot connect to the database");
617             return;
618             }
619             $c->{db_con}->disconnect_on_destroy(1);
620             $c->{db_con}->mode('fixup');
621             } else {
622             $c->{db_con} = DBI->connect($con_str, $user, $pwd, $con_opt);
623             if (!$c->{db_con}) {
624             $c->dbi_error("Cannot connect to the database");
625             return;
626             }
627             }
628              
629             $c->{is_connected} = 1;
630             return 1;
631             }
632              
633             sub __restore_options {
634             my ($c) = @_;
635              
636             foreach my $k (keys %{$c->{restore_options}}) {
637             $c->{options}{$k} = $c->{restore_options}{$k};
638             }
639              
640             $c->{restore_options} = {};
641              
642             return;
643             }
644              
645             my %splitstatement_opt = (
646             keep_terminator => 0,
647             keep_extra_spaces => 0,
648             keep_comments => 1,
649             keep_empty_statements => 0,
650             );
651             my %splitstatement_opt_grep = (
652             keep_comments => 0,
653             keep_empty_statements => 0,
654             );
655              
656             my $sql_splitter = SQL::SplitStatement->new(%splitstatement_opt);
657             my $sql_split_grepper = SQL::SplitStatement->new(%splitstatement_opt_grep);
658              
659             # split a string containing multiple query separated by ';' characters.
660             sub __split_query {
661             my ($c, $str) = @_;
662             return $str if not $c->{options}{auto_split};
663             return grep { $sql_split_grepper->split($_) } $sql_splitter->split($str);
664             }
665              
666             sub get_one_query {
667             my ($c, $str) = @_;
668              
669             my @l = $c->__split_query($str);
670              
671             if (@l > 1) {
672             return $c->error("The supplied query contains more than one statement");
673             } elsif (@l == 0) {
674             return $c->error("The supplied query does not contain any statements");
675             } else {
676             return $l[0]; # is always true
677             }
678             }
679              
680             ################################################################################
681             #!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!#
682             #! !#
683             #! WARNINGS !#
684             #! !#
685             #!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!#
686             ################################################################################
687              
688             # All the functions below this points may be called by the users either in OO
689             # or in functionnal mode. So they must all fetch the correct handle to work with.
690             #
691             # This function may also all accept temporary option which will apply only for
692             # the duration of the function call. As these arguments are deactivated when the
693             # same handle is used next, none of this functions may be called by another
694             # function of the library (or else, the option handling would be wrong). Only
695             # function above this point may be called by other functions of this package.
696              
697             ################################################################################
698             ################################################################################
699             ## ##
700             ## GETTER/SETTER AND OPTIONS ##
701             ##                                                                            ##
702             ################################################################################
703             ################################################################################
704              
705             =head1 GETTER/SETTER AND OPTIONS
706              
707             The functions and method described below are related to knowing and manipulating
708             the state of a database connection and of its options. The main function to set
709             the options of a database connection is the L|/"set_options">
710             functions. However, you can pass a hash reference as the I argument to any
711             function of this library with the same syntax as for the C function
712             and the options that it describes will be in effect for the duration of the
713             function or method call.
714              
715             Any invalid option given in this way to a function/method will result in a
716             C<'no such option'> error. If you do not die on error but are in strict mode, then
717             the called function will not be executed.
718              
719             =head2 connect
720              
721             connect($dsn, $user, $password, %opts);
722             $h->connect($dsn, $user, $password, %opts);
723              
724             This function/method permits to connect a handle which is not currently connected
725             to a database (either because it was created with C or because
726             C has been called on it). It also enable to connect to library to
727             a database in a purely functionnal way (without using objects). In that case
728             you can maintain only a single connection to a database. This is the connection
729             that will be used by all the function of this library when not called as an
730             object method. This connection will be refered to as the I in this
731             documentation. Its the handle that all other function will use when not applied
732             to an object.
733              
734             You can perfectly mix together the two styles (OO and functionnal): that is, have
735             the library connected in a functionnal style to a database and have multiple
736             other connections openned through the OO interface (with C).
737              
738             As stated above, this function accepts an optional hash reference as its last
739             argument. Note, however, that the option in this hash will be in effect only for
740             the duration of the C call, while options passed as the last argument of
741             the constructors (C and C) remain in effect until they are
742             modified. This is true even if C is called to create a default connection
743             for the library. You should use C to set options permanently for the
744             default database handle (or any other handle after its creation).
745              
746             This function will return a I value if the connection succeed and will die
747             or return C otherwise (depending on the C option). Not that
748             in strict mode it is an error to try to connect a handle which is already connected
749             to a database.
750              
751             =head2 disconnect
752              
753             disconnect();
754              
755             This function disconnect the default handle of the library from its current
756             connection. You can later on reconnect the library to an other database (or to
757             the same) with the C function.
758              
759             $h->disconnect();
760              
761             This function disconnect the handle it is applied on from its database. Note that
762             the handle itself is not destroyed and can be reused later on with the C
763             method.
764              
765             =head2 is_connected
766              
767             my $v = is_connected();
768             my $v = $h->is_connected();
769              
770             This call returns whether the default handle of the library and/or a given handle
771             is currently connected to a database.
772              
773             This function does not actually check the connection to the database. So it is
774             possible that this call returns I but that a later call to a function
775             which does access the database will fail if, e.g., you have lost your network
776             connection.
777              
778             =head2 get_default_handle
779              
780             my $h = get_default_handle();
781              
782             Return the default handle of the library (the one used by all function when not
783             applied on an object). The returned handle is an C object and may
784             then be used as any other handles through the OO interface, but it will still be
785             used by the functionnal interface of this library.
786              
787             =head2 get_dbh
788              
789             my $dbh = get_dbh();
790             my $dbh = $h->get_dbh();
791              
792             Returns the internal C> handle to your database. This handle may be used
793             in conjonction with other libraries which can accept a connected handle.
794              
795             Note that, because of the use of C, this handle may change
796             during the life of your program. If possible, you should rather use the
797             C method (see below) to get a persistant handle.
798              
799             =head2 get_conn
800              
801             my $conn = get_conn();
802             my $conn = $h->get_conn();
803              
804             Returns the internal C> handle to your database. This handle
805             may be used in conjonction with other libraries which can accept such a handle
806             (e.g. C>). This handle will not change while you do not close your
807             connection to your database.
808              
809             =head2 errstr
810              
811             my $e = errstr();
812             my $e = $c->errstr;
813              
814             This function returns an error string associated with the last call to the library
815             made with a given handle (or with the default handle). This function will return
816             C if the last call did not raise an error.
817              
818             =head2 warnstr
819              
820             my $e = warnstr();
821             my $e = $c->warnstr;
822              
823             This function returns a warning string associated with the last call to the library
824             made with a given handle (or with the default handle). This function will return
825             C if the last call did not raise a warning.
826              
827             Note that a single call way raise multiple warning. In that case, only the last
828             one will we stored in this variable.
829              
830             =head2 set_options
831              
832             set_options(HASH);
833             $c->set_options(HASH);
834              
835             This function sets the option of the given connection handle (or of the default
836             handle). The C describing the option may be given as a list of C<
837             or as a reference to a hash.
838              
839             The function returns a hash with the previous value of all modified
840             options. As a special case, if the function is called without argument, it will
841             returns a hash with the value of all the options. In both cases, this hash is
842             returned as a list in list context and as a hash reference in scalar context.
843              
844             If an error happen (e.g. use of an invalid value for an option) the function
845             returns undef or an empty list and nothing is modified. In C mode it is
846             also an error to try to set an nonexistant option.
847              
848             If the options that you are setting include the C option, the value of
849             the C mode is not defined during the execution of this function (that is,
850             it may either be I or I).
851              
852             See below for a list of the available options.
853              
854             =head2 Options
855              
856             You will find below a list of the currently available options. Each of these options
857             may be accessed through its dedicated function or with either of the C/C
858             functions.
859              
860             =head3 die_on_error
861              
862             set_options(die_on_error => val);
863             die_on_error(val);
864              
865             This option (which default to I) specify if an error condition abort the
866             execution of your program or not. If so, the C function will be called
867             (and you may trap the error with C). If not, the function call will still
868             abort and return C or an empty list (depending on the context). When this
869             may be a valid result for the function, you may call the C> function/method
870             to get the last error message or C if the last call was succesful.
871              
872             =head3 print_error
873              
874             set_options(print_error => val);
875             print_error(val);
876              
877             This option (which default to I) control whether the errors are printed or
878             not (this does not depend on the setting of the C option). If the
879             supplied value is I the errors are printed to C, otherwise nothing
880             is printed.
881              
882             =head3 print_warning
883              
884             set_options(print_warning => val);
885             print_warning(val);
886              
887             This option (which default to I) control whether the warning are printed
888             or not. If the supplied value is I the warnings are printed to C,
889             otherwise nothing is printed.
890              
891             =head3 print_query
892              
893             set_options(print_query => FH);
894             print_query(FH);
895              
896             This option (which default to C) control whether the queries are printed
897             before being executed. Unless the previous option, to set it, you must pass it
898             an open I. The queries will then be printed to this handle.
899              
900             =head3 strict
901              
902             set_options(strict => val);
903             strict(val);
904              
905             This option (which default to I) control the so-called C mode of
906             the library. It has 3 possible settings. If set to a I value, some condition
907             are checked to ensure that the operations of the library are as safe as possible
908             (the exact condition are described in the documentation of the function to which
909             they apply). When the condition are not met, an error is thrown (what happens
910             exactly depends on the C and C options).
911              
912             If this option is set to a I I value (such as C<'0'>), then the
913             strict conditions are still tested, but only result in a warning when they are
914             not met.
915              
916             Finally, if this option is set to C then the nothing happens when a strict
917             condition is not met (and the tests will altogether be omitted if they are
918             potentially costly).
919              
920             =head3 replace
921              
922             set_option(replace => \&code);
923             replace(\&code);
924             replace($obj);
925             replace(HASH);
926             replace(undef);
927              
928             This option allows to set up a procedure which get the possibility to modify
929             an SQL query before it is executed (e.g. to replace generic parameter by specific
930             name). The default (when the option is C) is that nothing is done.
931              
932             If this option is a I reference (or an anonymous sub-function), then this
933             function is called each time you supply an SQL query to this library with the
934             query in the C<$_> variable. The function may modify this variable and the
935             resulting value of C<$_> is executed. The call to this function takes place before
936             the spliting of the SQL query (if C is I).
937              
938             You may also pass to this option a I reference. In that case, the hash
939             describes a series of replacement to be performed on the SQL query (see the
940             example below). Internally, this requires the C> library.
941             The function will croak if you call it with a I and you do not have this
942             library installed. When using the C function (rather than the
943             C function) you may give a list descibing a I, rather than a
944             I reference.
945              
946             Finally, you may also give to this function any object which have a C
947             method (e.g. an already built C object). This method will then
948             be called with your SQL queries (using arguments and return values, and not the
949             C<$_> variable).
950              
951             Here is an example (which will work with an SQLite database):
952              
953             replace(String::Replace->new(table_name => 't'));
954             execute('create table table_name (a)');
955             replace(table_name => 't');
956             execute('insert into table_name values (1)');
957             query_one_value('select * from table_name', { replace => sub { s/table_name/t/g } }) == 1
958              
959             =head3 connect_options
960              
961             Do not use this option...
962              
963             =head3 auto_split
964              
965             This option (which default to I) controls whether the queries are split in
966             atomic statement before being sent to the database. If it is not set, your
967             queries will be sent I to the database, with their ending terminator (if
968             any), this may result in error with some database driver which do not allow for
969             multi-statement queries. You should not set this option to a I value
970             unless you know what you are doing.
971              
972             The spliting facility is provided by the C package.
973              
974             =head3 auto_transaction
975              
976             set_options(auto_transaction => val);
977             auto_transaction(val);
978              
979             This option (which default to I) controls whether the C and
980             C functions automatically start a transaction whenever they
981             execute more than one statement.
982              
983             =head3 use_connector
984              
985             Do not use this option...
986              
987             =head3 stop_on_error
988              
989             set_options(stop_on_error => val);
990             stop_on_error(val);
991              
992             This option is only usefull when the C and C options
993             are false and will control if the execution is interupted when an error occurs
994             during a multi-statement query. Its default value is I.
995              
996             =head3 line_separator
997              
998             set_options(line_separator => val);
999             line_separator(val);
1000              
1001             This option is used only by the C function. It specifies the
1002             line separator used between different records. The default value is C<"\n">.
1003              
1004             =head3 value_separator
1005              
1006             set_options(value_separator => val);
1007             line_separator(val);
1008              
1009             This option is used only by the C function. It specifies the
1010             value separator used between different value of a records. The default value is
1011             C<';'>.
1012              
1013             =cut
1014              
1015             push @EXPORT_OK, ('connect', 'disconnect', 'is_connected', 'get_default_handle',
1016             'get_dbh', 'get_conn',
1017             'errstr', 'set_options', 'set_option', 'die_on_error', 'print_error',
1018             'print_warning', 'print_query', 'strict', 'replace', 'connect_options',
1019             'auto_transaction', 'auto_split', 'use_connector', 'stop_on_error',
1020             'line_separator', 'value_separator');
1021              
1022             # contrairement à new, connect met des options temporaire. bien ?
1023             sub connect {
1024             my $c = &check_options or return;
1025             return $c->__connect(@_);
1026             }
1027              
1028             sub disconnect {
1029             my $c = &check_options or return;
1030             return $c->__disconnect(@_);
1031             }
1032              
1033             sub is_connected {
1034             my $c = &check_options or return;
1035             return $c->{is_connected};
1036             }
1037              
1038             sub get_default_handle {
1039             return just_get_handle();
1040             }
1041              
1042             sub get_dbh {
1043             my $c = &just_get_handle;
1044             return $c->{db_con}->dbh();
1045             }
1046              
1047             sub get_conn {
1048             my $c = &just_get_handle;
1049             return $c->{db_con};
1050             }
1051              
1052             # renvoie la dernière erreur et undef si le dernier appel a réussi.
1053             sub errstr {
1054             my $c = &just_get_handle;
1055             return $c->{errstr};
1056             }
1057              
1058             sub die_on_error {
1059             my $c = &get_handle;
1060             return $c->__set_boolean_opt('die_on_error', @_);
1061             }
1062              
1063             sub print_error {
1064             my $c = &get_handle;
1065             return $c->__set_boolean_opt('print_error', @_);
1066             }
1067              
1068             sub print_warning {
1069             my $c = &get_handle;
1070             return $c->__set_boolean_opt('print_warning', @_);
1071             }
1072              
1073              
1074              
1075             # undef si l'argument est invalide, 0 sinon (pour les autres fonctions, il n'y a pas d'argument invalide).
1076             sub print_query {
1077             my $c = &get_handle;
1078              
1079             $c->__restore_options();
1080             my $r = $c->{options}{print_query};
1081              
1082             if (@_) {
1083             if (not $_[0]) {
1084             $c->{options}{print_query} = 0;
1085             } elsif (openhandle($_[0])) {
1086             $c->{options}{print_query} = $_[0];
1087             } else {
1088             return $c->error('Invalid file handle as argument to print_query');
1089             }
1090             }
1091              
1092             return $r;
1093             }
1094              
1095             sub strict {
1096             my $c = &get_handle;
1097             return $c->__set_boolean_opt('strict', @_);
1098             }
1099              
1100             sub replace {
1101             my $c = &get_handle;
1102              
1103             $c->__restore_options();
1104             my $r = $c->{options}{replace};
1105              
1106             if (@_) {
1107             if (not $_[0]) {
1108             $c->{options}{replace} = undef;
1109             } elsif ((reftype($_[0]) // '') eq 'CODE') {
1110             $c->{options}{replace} = $_[0];
1111             } elsif (blessed($_[0]) and $_[0]->can('replace')) {
1112             $c->{options}{replace} = $_[0];
1113             } elsif ((reftype($_[0]) // '') eq 'HASH') {
1114             if (eval { require String::Replace }) {
1115             my $v = eval { String::Replace->new($_[0]) };
1116             return $c->error("Creating a String::Replace object has failed: $@") if $@;
1117             $c->{options}{replace} = $v;
1118             } else {
1119             return $c->error('The String::Replace module is needed to handle HASH ref as argument to replace');
1120             }
1121             } elsif (not ref $_[0] and not @_ & 1) {
1122             if (eval { require String::Replace }) {
1123             my $v = eval { String::Replace->new(@_) };
1124             return $c->error("Creating a String::Replace object has failed: $@") if $@;
1125             $c->{options}{replace} = $v;
1126             } else {
1127             return $c->error('The String::Replace module is needed to handle HASH ref as argument to replace');
1128             }
1129             } else {
1130             return $c->error('Invalid argument to replace, expexted an object or HASH or CODE ref');
1131             }
1132             }
1133              
1134             return $r // 0; # //
1135             }
1136              
1137             # idem que print_query
1138             sub connect_options {
1139             my $c = &get_handle;
1140              
1141             $c->__restore_options();
1142             my $r = $c->{options}{connect_options};
1143              
1144             if (@_) {
1145             if (not $_[0]) {
1146             $c->{options}{connect_options} = undef;
1147             } elsif ((reftype($_[0]) // '') eq 'HASH') { # //
1148             $c->{options}{connect_options} = $_[0];
1149             } else {
1150             return $c->error('Invalid argument to connect_options, expexted a HASH ref');
1151             }
1152             }
1153              
1154             return $r // 0; #//
1155             }
1156              
1157             sub auto_transaction {
1158             my $c = &get_handle;
1159             return $c->__set_boolean_opt('auto_transaction', @_);
1160             }
1161              
1162             sub auto_split {
1163             my $c = &get_handle;
1164             return $c->__set_boolean_opt('auto_split', @_);
1165             }
1166              
1167             sub use_connector {
1168             my $c = &get_handle;
1169             return $c->error('The use_connector option cannot be changed when connected to a DB') if @_ && $c->{is_connected};
1170             return $c->__set_boolean_opt('use_connector', @_);
1171             }
1172              
1173             sub stop_on_error {
1174             my $c = &get_handle;
1175             return $c->__set_boolean_opt('stop_on_error', @_);
1176             }
1177              
1178             sub line_separator {
1179             my $c = &get_handle;
1180             return $c->__set_opt('line_separator', @_);
1181             }
1182              
1183             sub value_separator {
1184             my $c = &get_handle;
1185             return $c->__set_opt('value_separator', @_);
1186             }
1187              
1188             # Il faut que si on recoit \{} en argument alors on renvoie
1189             # un restore option vide (mais pas toutes les options) car
1190             # c'est ce qu'attend check_option.
1191             #
1192             # le hash restore_options est rempli dans check_options, important, sinon
1193             # on le vide dans chaque appel aux petites fonctions d'option.
1194             #
1195             # la gestion en cas d'erreur est un peu complexe...
1196             sub set_options {
1197             my $c = &get_handle;
1198              
1199             $c->__restore_options();
1200              
1201             if (not @_) {
1202             return wantarray ? %{$c->{options}} : { %{$c->{options}} };
1203             }
1204             my %h;
1205             if (ref $_[0] && ref $_[0] ne "HASH") {
1206             return error("Invalid argument in %s::set_options", ref $c);
1207             } elsif (ref $_[0]) {
1208             %h = %{$_[0]};
1209             } else {
1210             %h = @_;
1211             }
1212             my %old = ();
1213            
1214             #TODO: test this
1215             $c->{restore_options} = { %{$c->{options}} };
1216              
1217             while (my ($k, $v) = each %h) {
1218             given($k) {
1219             when('die_on_error') { $old{$k} = $c->die_on_error($v) }
1220             when('print_error') { $old{$k} = $c->print_error($v) }
1221             when('print_warning') { $old{$k} = $c->print_warning($v) }
1222             when('print_query') {
1223             my $r = $c->print_query($v);
1224             $c->strict_error('Some option has not been set due to ignored errors') and return if not defined $r;
1225             $old{$k} = $r
1226             }
1227             when('strict') { $old{$k} = $c->strict($v) }
1228             when('replace') {
1229             my $r = $c->replace($v);
1230             $c->strict_error('Some option has not been set due to ignored errors') and return if not defined $r;
1231             $old{$k} = $r
1232             }
1233             when('connect_options') {
1234             my $r = $c->connect_options($v);
1235             $c->strict_error('Some option has not been set due to ignored errors') and return if not defined $r;
1236             $old{$k} = $r
1237             }
1238             when('auto_transaction') { $old{$k} = $c->auto_transaction($v) }
1239             when('auto_split') { $old{$k} = $c->auto_split($v) }
1240             when('use_connector') { $old{$k} = $c->use_connector($v) }
1241             when('stop_on_error') { $old{$k} = $c->stop_on_error($v) }
1242             when('line_separator') { $old{$k} = $c->line_separator($v) }
1243             when('value_separator') { $old{$k} = $c->value_separator($v) }
1244             default { $c->strict_error("No such option: $k") and return }
1245             }
1246             }
1247              
1248             $c->{restore_options} = { };
1249              
1250             return wantarray ? %old : \%old;
1251             }
1252              
1253              
1254             =for comment
1255              
1256             sub set_option {
1257             my $c = &get_handle;
1258              
1259             return $c->set_options({$_[0] => $_[1]}) if @_ == 2;
1260            
1261             $c->error("Bad number of arguments in %s::set_option", ref $c);
1262             return;
1263             }
1264              
1265             =cut
1266              
1267              
1268              
1269              
1270             ################################################################################
1271             ################################################################################
1272             ## ##
1273             ## STANDARD QUERY FUNCTIONS ##
1274             ##                                                                            ##
1275             ################################################################################
1276             ################################################################################
1277              
1278              
1279             =head1 STANDARD QUERY FUNCTIONS
1280              
1281             =head2 execute
1282              
1283             execute(SQL);
1284             $c->execute(SQL);
1285              
1286             This function execute the SQL code contained in its argument. The SQL is first
1287             split at the boundary of each statement that it contains (except if the C
1288             option is false) and is then executed statement by statement in a single transaction
1289             (meaning that if one of the statement fails, nothing is changed in your database).
1290             If the C option is false, each of your statement will be executed
1291             atomically and all modification will be recorded immediately.
1292              
1293             Optionnaly, you may also provide a reference to an array of SQL queries instead
1294             of a single SQL query. In that case, each query will be split independently (if
1295             C is true) and all the resulting queries will be executed in order
1296             inside one single transaction (if C is true). Note that you
1297             may not pass a list of SQL query, but only a reference to such a list (for
1298             compatibility with a future version of the library).
1299              
1300             The function will return a C value if everything succeeded, and C
1301             if an error happen (and it is ignored, otherwise, the function will C).
1302              
1303             The returned value may or may not be the total number of lines modified by your
1304             query.
1305              
1306             Here are examples of valid call to the C function:
1307              
1308             execute('insert into t values (1)');
1309             execute('insert into t values (1);insert into t values (1)');
1310             execute(['insert into t values (1)', 'insert into t values (1)']);
1311              
1312             =head2 execute_multiple
1313              
1314             execute_multiple(SQL, PARAM_LIST);
1315             $c->execute_multiple(SQL, PARAM_LIST);
1316              
1317             This function executes one or multiple time an SQL query with the provided
1318             parameters. The SQL query may be only a single statement (although this
1319             condition is not tested if C is false, but then there is no
1320             garantee on what will happen).
1321              
1322             The SQL query can contain placeholder (C<'?'> characters) in place of SQL values.
1323             These placeholder will be replaced during the execution by the parameters that
1324             you provide. You should provide a list of parameters with the same number of
1325             parameters than the number of placeholder in the statement. You may provide this
1326             list as an array or an array reference.
1327              
1328             You may also provide a list of array reference or a reference to an array of
1329             array reference. In that case, the query will be executed once for each element
1330             of this array (the external one), with the placeholders taking the values given
1331             in the sub-arrays.
1332              
1333             As a special case, if there is only a single placeholder in your query, you may
1334             provide a simple list of parameters to execute the query multiple time (each
1335             with one of the parameter).
1336              
1337             If the C option is true, then all the executions of your query
1338             will be performed atomically inside a single transaction. This is usefull for
1339             example to performs many insertions in a table in an efficient manner.
1340              
1341             Here are three pairs of equivalent call to C:
1342              
1343             execute_multiple('insert into t values (?, ?)', 1, 2);
1344             execute_multiple('insert into t values (?, ?)', [1, 2]);
1345            
1346             execute_multiple('insert into t values (?, ?)', [1, 2], [3, 4]);
1347             execute_multiple('insert into t values (?, ?)', [[1, 2], [3, 4]]);
1348            
1349             execute_multiple('insert into t values (?)', 1, 2, 3);
1350             execute_multiple('insert into t values (?)', [[1], [2], [3]]);
1351              
1352             =head2 query_one_value
1353              
1354             my $v = query_one_value(SQL, LIST);
1355             my $v = $h->query_one_value(SQL, LIST);
1356              
1357             This function return one scalar value corresponding to the result of the SQL query
1358             provided. This query must be a data returning query (e.g. C
1359              
1360             If C is activated, the SQL query provided to this function may
1361             not contains more than one statement (otherwise an error is thrown). If the
1362             option is not set, this condition will not be tested and there is no guarantee
1363             on what will happens if you try to execute more than one statement with this function.
1364              
1365             If the SQL statement has parameter placeholders, they should be provided in the
1366             arguments list of the call. As this function expects a single statement, the parameters
1367             should be passed directly as a list and not in an array-ref.
1368              
1369             query_one_value('select a, b from table where a = ?', 42);
1370              
1371             The function will raise an error if nothing is returned by your query (even if
1372             the SQL code itself is valid) and, if in C mode, the function will also
1373             fail if your query returns more than one line or one column (but note that the
1374             query is still executed).
1375              
1376             In case of an error (and if C is not set) the function will return
1377             C. You must not that this value may also be returned if your query returns
1378             a C value. In that case to check if an error happened you must check the
1379             C function which will return C if there was no errors.
1380              
1381             =head2 query_one_line
1382              
1383             my @l = query_one_line(SQL,LIST);
1384             my @l = $h->query_one_line(SQL,LIST);
1385             my $l = query_one_line(SQL,LIST);
1386             my $l = $h->query_one_line(SQL,LIST);
1387              
1388             This function returns a list corresponding to one line of result of the provided
1389             SQL query. If called in scalar context, the function will return a reference to an
1390             array rather than a list. You may safely store this array which will not be reused
1391             by the library.
1392              
1393             In list context, the function will return an empty list in case of an error. You
1394             may distinguish this from a query returning no columns with the C function.
1395             In scalar context, the function will return C in case of error or a reference
1396             to an empty array for query returning no columns.
1397              
1398             An error will happen if the query returns no rows at all and, if you are in
1399             C mode, an error will also happen if the query returns more than one rows.
1400              
1401             The same limitation applies to this function as for the C about
1402             the number of statement in your query and the parameter for the statement placeholders.
1403              
1404             =head2 query_all_lines
1405              
1406             my @a = query_all_lines(SQL,LIST);
1407             my @a = $h->query_all_lines(SQL,LIST);
1408             my $a = query_all_lines(SQL,LIST);
1409             my $a = $h->query_all_lines(SQL,LIST);
1410              
1411             This function executes the given SQL and returns all the returned data from this
1412             query. In list context, the fonction returns a list of all the lines. Each lines
1413             is a reference to an array, even if there is only one column per lines (use the
1414             query_one_column function for that). In scalar context, the function returns a
1415             reference to an array containing each of the array reference for each lines.
1416              
1417             In case of errors, if C is not set, the function will return C
1418             in scalar context and an empty list in list context. This could also be the correct
1419             result of a query returning no rows, use the C function to distinguish
1420             between these two cases.
1421              
1422             If there is an error during the fetching of the data and that C is
1423             not set and you are not in C mode, then all the data already fetched will
1424             be returned but no tentatives will be done to try to fetch any more data.
1425              
1426             The same limitation applies to this function as for the C about
1427             the number of statement in your query and the parameter for the statement placeholders.
1428              
1429             =head2 query_one_column
1430              
1431             my @l = query_one_column(SQL,LIST);
1432             my @l = $h->query_one_column(SQL,LIST);
1433             my $l = query_one_column(SQL,LIST);
1434             my $l = $h->query_one_column(SQL,LIST);
1435              
1436             This function returns a list corresponding to one column of result of the provided
1437             SQL query. If called in scalar context, the function will return a reference to an
1438             array rather than a list. You may safely store this array which will not be reused
1439             by the library.
1440              
1441             In list context, the function will return an empty list in case of an error. You
1442             may distinguish this from a query returning no lines with the C function.
1443             In scalar context, the function will return C in case of error or a reference
1444             to an empty array for query returning no lines.
1445              
1446             An error will happen if the query returns no columns at all and, if you are in
1447             C mode, an error will also happen if the query returns more than one columns.
1448              
1449             The same limitation applies to this function as for the C about
1450             the number of statement in your query and the parameter for the statement placeholders.
1451              
1452             =head2 query_to_file
1453              
1454             query_to_file(SQL, file_name, LIST);
1455             my $v = $h->query_one_value(SQL, file_name, LIST);
1456             query_to_file(SQL, FH, LIST);
1457              
1458             This function execute an SQL query and send its output to a file or file handle.
1459              
1460             The first argument is the query to execute (which may contain only a single
1461             statement).
1462              
1463             The second argument is the destination of the data. You may pass either a file name
1464             or a reference to an I or I. If it is omitted or C the data will
1465             go to C. If you pass a filename, you may prefix it with C<<<'>>'>>> to append
1466             to the file (rather that to erase it).
1467              
1468             B The data are written with each value of a raw separated by the value of the
1469             C option (which defaults to C<';'>) and each row separated by
1470             the value of the C option (which defaults to C<"\n">).
1471              
1472             The same limitation applies to this function as for the C about
1473             the number of statement in your query and the parameter for the statement placeholders.
1474              
1475             =head2 query_one_hash
1476              
1477             my %h = query_one_hash(SQL,LIST);
1478             my %h = $h->query_one_hash(SQL,LIST);
1479             my $h = query_one_hash(SQL,LIST);
1480             my $h = $h->query_one_hash(SQL,LIST);
1481              
1482              
1483             =head2 query_all_hashes
1484              
1485             my @h = query_all_hashes(SQL,LIST);
1486             my @h = $h->query_all_hashes(SQL,LIST);
1487             my $h = query_all_hashes(SQL,LIST);
1488             my $h = $h->query_all_hashes(SQL,LIST);
1489              
1490             =cut
1491              
1492             push @EXPORT_OK, ('execute', 'query_one_value', 'query_one_line', 'query_all_lines',
1493             'query_one_column', 'query_to_file', 'execute_multiple',
1494             'query_one_hash', 'query_all_hashes');
1495              
1496             # Cette fonction ci est la seule que l'on ne passe pas à Statement car elle
1497             # manipule plusieurs statements qui doivent être exécuté au sein d'une seule
1498             # transaction.
1499             # On pourrait la réécrire en créant plein de Statement mais ça semble non optimale.
1500             sub execute {
1501             my $c = &check_options or return;
1502              
1503             $c->check_conn() or return;
1504             my @queries;
1505             if ($_[0] and ref $_[0] and reftype $_[0] eq 'ARRAY') {
1506             @queries = map { $c->__split_query($_) } @{$_[0]};
1507             } else {
1508             @queries = $c->__split_query($_[0]);
1509             }
1510            
1511             my $proc = sub {
1512             my $a = 0;
1513              
1514             for my $r (@queries) {
1515             # TODO: lever l'erreur strict seulement dans le mode stop_on_error
1516             # et s'il reste des requête à exécuter.
1517             if (!$c->SQL::Exec::Statement::low_level_prepare($r)) {
1518             $c->strict_error("Some queries have not been executed due to an error") and die "EINT\n";
1519             die "ESTOP:$a\n" if $c->{options}{stop_on_error};
1520             next;
1521             }
1522             my $v = $c->SQL::Exec::Statement::low_level_execute();
1523             $c->SQL::Exec::Statement::low_level_finish();
1524             if (not defined $v) {
1525             $c->strict_error("Some queries have not been executed due to an error") and die "EINT\n";
1526             die "ESTOP:$a\n" if $c->{options}{stop_on_error};
1527             next;
1528             }
1529             $a += $v;
1530             }
1531             return $a;
1532             };
1533              
1534             my $v;
1535             if ($c->{options}{auto_transaction} && @queries > 1) {
1536             $v = eval { $c->{db_con}->txn($proc) };
1537             } else {
1538             $v = eval { $proc->() };
1539             }
1540             if ($@ =~ m/^EINT$/) {
1541             return;
1542             } elsif ($@ =~ m/^ESTOP:(\d+)$/) {
1543             return $c->{options}{auto_transaction} && @queries > 1 ? 0 : $1;
1544             } elsif ($@) {
1545             die $@;
1546             } else {
1547             return $v;
1548             }
1549             }
1550              
1551             sub __execute_multiple {
1552             my ($c, $req, @params) = @_;
1553             $c->{last_stmt} = $c->__prepare($req) or return;
1554             return $c->{last_stmt}->__execute(@params);
1555             }
1556              
1557             sub execute_multiple {
1558             my $c = &check_options or return;
1559             return $c->__execute_multiple(@_);
1560             }
1561              
1562             sub __query_one_value {
1563             my ($c, $req, @params) = @_;
1564             $c->{last_stmt} = $c->__prepare($req) or return;
1565             return $c->{last_stmt}->__query_one_value(@params);
1566             }
1567              
1568             sub query_one_value {
1569             my $c = &check_options or return;
1570             return $c->__query_one_value(@_);
1571             }
1572              
1573             sub __query_one_line {
1574             my ($c, $req, @params) = @_;
1575             $c->{last_stmt} = $c->__prepare($req);
1576             return $c->{last_stmt}->__query_one_line(@params);
1577             }
1578              
1579             sub query_one_line {
1580             my $c = &check_options or return;
1581             return $c->__query_one_line(@_);
1582             }
1583              
1584             sub __query_all_lines {
1585             my ($c, $req, @params) = @_;
1586             $c->{last_stmt} = $c->__prepare($req);
1587             return $c->{last_stmt}->__query_all_lines(@params);
1588             }
1589              
1590             sub query_all_lines {
1591             my $c = &check_options or return;
1592             return $c->__query_all_lines(@_);
1593             }
1594              
1595             sub __query_one_column {
1596             my ($c, $req, @params) = @_;
1597             $c->{last_stmt} = $c->__prepare($req);
1598             return $c->{last_stmt}->__query_one_column(@params);
1599             }
1600              
1601             sub query_one_column {
1602             my $c = &check_options or return;
1603             return $c->__query_one_column(@_);
1604             }
1605              
1606             sub __query_to_file {
1607             my ($c, $req, $fh, @params) = @_;
1608             $c->{last_stmt} = $c->__prepare($req);
1609             return $c->{last_stmt}->__query_to_file($fh, @params);
1610             }
1611              
1612             sub query_to_file {
1613             my $c = &check_options or return;
1614             return $c->__query_to_file(@_);
1615             }
1616              
1617             sub __query_one_hash {
1618             my ($c, $req, @params) = @_;
1619             $c->{last_stmt} = $c->__prepare($req);
1620             return $c->{last_stmt}->__query_one_hash(@params);
1621             }
1622              
1623             sub query_one_hash {
1624             my $c = &check_options or return;
1625             return $c->__query_one_hash(@_);
1626             }
1627              
1628             sub __query_all_hashes {
1629             my ($c, $req, @params) = @_;
1630             $c->{last_stmt} = $c->__prepare($req);
1631             return $c->{last_stmt}->__query_all_hashes(@params);
1632             }
1633              
1634             sub query_all_hashes {
1635             my $c = &check_options or return;
1636             return $c->__query_all_hashes(@_);
1637             }
1638              
1639              
1640              
1641             ################################################################################
1642             ################################################################################
1643             ## ##
1644             ## PREPARED STATEMENTS FUNCTIONS ##
1645             ##                                                                            ##
1646             ################################################################################
1647             ################################################################################
1648              
1649             =head1 PREPARED STATEMENTS
1650              
1651             The library offers full support for prepared statements which can be executed
1652             multiple times with different parameters.
1653              
1654             =head2 prepare
1655              
1656             $st = prepare(SQL);
1657             $st = $h->prepare(SQL);
1658              
1659             All L are accessible through
1660             prepared statements, except that the C function behave exactly like the
1661             C function. Users are encouraged to use the C name when
1662             manipulating prepared statement.
1663              
1664              
1665             =head2 Using a prepared statement
1666              
1667             $st->execute(LIST);
1668             $st->query_one_value(LIST);
1669             $st->query_one_line(LIST);
1670             $st->query_all_lines(LIST);
1671             $st->query_one_column(LIST);
1672             $st->query_to_file(FH, LIST);
1673             $st->query_to_file(filename, LIST);
1674             $st->query_one_hash(LIST);
1675             $st->query_all_hashes(LIST);
1676              
1677              
1678             =cut
1679              
1680             push @EXPORT_OK, ('prepare');
1681              
1682             sub __prepare {
1683             my ($c, @p) = @_ or return;
1684             return SQL::Exec::Statement->new($c, @p);
1685             }
1686              
1687             sub prepare {
1688             my $c = &check_options or return;
1689             return SQL::Exec::Statement->new($c, @_);
1690             }
1691              
1692             ################################################################################
1693             ################################################################################
1694             ## ##
1695             ## HIGH LEVEL QUERY FUNCTIONS ##
1696             ##                                                                            ##
1697             ################################################################################
1698             ################################################################################
1699              
1700              
1701             =head1 HIGH LEVEL QUERY FUNCTIONS
1702              
1703             These functions (or method) provide higher level interface to the database. The implemetations
1704             provided here try to be generic and portable but they may not work with any database
1705             driver. If necessary, these functions will be overidden in the database specific
1706             sub-classes. Be sure to check the documentation for the sub-classe that you are
1707             using (if any) because the arguments of these function may differ from their base
1708             version.
1709              
1710             =head2 count_lines
1711              
1712             my $n = count_lines(SQL);
1713             my $n = $c->count_lines(SQL);
1714              
1715             This function takes an SQL query (C
1716             number of lines that the query would have returned (with, e.g., the C
1717             functions).
1718              
1719             =head2 table_exists
1720              
1721             my $b = table_exists(table_name);
1722             my $b = $c->table_exists(table_name);
1723              
1724             This function returns a boolean value indicating if there is a table with name
1725             C. The default implementation may erroneously returns I if the
1726             table exists but you do not have enough rights to access it.
1727              
1728             This function might also returns I when there is an object with the correct
1729             name looking I a table (e.g. a view) in the database.
1730              
1731             =head2 get_columns
1732              
1733             my @c = get_columns(table_name);
1734             my $c = $c->get_columns(table_name);
1735              
1736             =head2 get_primary_key
1737              
1738             my @c = get_primary_key(table_name);
1739             my $c = $c->get_primary_key(table_name);
1740              
1741              
1742             =cut
1743              
1744             push @EXPORT_OK, ('count_lines', 'table_exists', 'get_columns', 'get_primary_key');
1745              
1746              
1747             sub __count_lines {
1748             my ($c, $req) = @_;
1749              
1750             $req = $c->get_one_query($req) or return;
1751              
1752             # return $c->__query_one_value("SELECT count(*) from (${req}) T_ANY_NAME");
1753            
1754             my $proc = sub {
1755             my $c = $c->__query_one_value("SELECT count(*) from (${req}) T_ANY_NAME");
1756             if (defined $c) {
1757             die "EGET:$c\n";
1758             } else {
1759             die "EINT\n";
1760             }
1761             };
1762              
1763             # my $v = eval { $c->{db_con}->txn($proc) };
1764             my $v = eval { $proc->() }; # la "transaction" est ouverte dans __query_one_value
1765              
1766             if ($@ =~ m/^EINT$/) {
1767             return;
1768             } elsif ($@ =~ m/^EGET:(\d+)$/) {
1769             return $1;
1770             } elsif ($@) {
1771             die $@;
1772             } else {
1773             confess 'Should not happen';
1774             }
1775             }
1776              
1777             sub count_lines {
1778             my $c = &check_options;
1779             $c->check_conn() or return;
1780              
1781             return $c->__count_lines(@_);
1782             }
1783              
1784             sub __quote_identifier {
1785             my ($c, @args) = @_;
1786             # les '' deviennent undef c'est ce qu'on veut ?
1787             @args = map { $_ ? split /\./, $_ : undef } @args;
1788             unshift @args, ((undef) x (3 - @args));
1789             my $table = eval { $c->get_dbh()->quote_identifier(@args) };
1790             if ($table) {
1791             return $table;
1792             } else {
1793             return join '.', grep { $_ } @args;
1794             }
1795             }
1796              
1797             # test aussi le droit en lecture, très mauvaise implémentation...
1798             sub __table_exists_dummy {
1799             my ($c, @args) = @_;
1800              
1801             my $table = $c->__quote_identifier(@args);
1802              
1803             eval {
1804             $c->__prepare("select * from $table") or die "FAIL\n";
1805             1;
1806             };
1807              
1808             if ($@) { # pas que dans le cas FAIL, mais aussi les autres erreurs de la bibliothèque
1809             return 0;
1810             } else {
1811             return 1;
1812             }
1813             }
1814              
1815             # If a subclasses knows that the default implementation won't work, it can
1816             # redefine the table_exists function to directly alias to __table_exists_dummy
1817             # Beware that in this case, the check_options, check_conn and replace will need
1818             # to be performed by the proxy function.
1819             sub table_exists {
1820             my $c = &check_options;
1821             $c->check_conn() or return;
1822              
1823             my (@args) = @_;
1824              
1825             my $esc = eval {
1826             $c->get_dbh()->get_info($GetInfoType{SQL_SEARCH_PATTERN_ESCAPE})
1827             } // '\\'; # /
1828              
1829             for (@args) {
1830             if ($_) {
1831             $_ = $c->__replace($_);
1832             # See Caveat in http://search.cpan.org/dist/DBI/DBI.pm#Catalog_Methods
1833             $_ =~ s/([_%])/$esc$1/g;
1834             }
1835             }
1836              
1837             @args = map { $_ ? split /\./, $_ : $_ } @args; # à faire après le __replace
1838              
1839             $c->query("[SQL::Exec] Table Exists: ".(join '.', grep { $_ } @args));
1840              
1841             $c->error('Too many arguments') if @args > 3;
1842             $c->error('Not enough arguments') if @args < 1;
1843             unshift @args, ((undef) x (3 - @args));
1844            
1845             my @t = eval {
1846             $c->get_dbh()->tables(@args, 'TABLE,VIEW');
1847             };
1848              
1849             if ($@) {
1850             $c->warning("Operation not supported by your driver");
1851             return $c->__table_exists_dummy(@args);
1852             } elsif (@t == 1) {
1853             return 1;
1854             } else {
1855             return 0;
1856             }
1857             }
1858              
1859             sub __get_columns_dummy {
1860             my ($c, @args) = @_;
1861              
1862             my $table = $c->__quote_identifier(@args);
1863              
1864             my $st = eval {
1865             $c->__prepare("select * from $table") or die "FAIL\n";
1866             };
1867              
1868             if ($@) {
1869             $c->error("unknown error, are you sure that the table '$table' exists ?");
1870             return;
1871             } else {
1872             my @c = @{$st->{last_req}->{NAME_lc}};
1873             return wantarray ? @c : \@c;
1874             }
1875             }
1876              
1877             # If a subclasses knows that the default implementation won't work, it can
1878             # redefine the table_exists function to directly alias to __get_columns_dummy
1879             sub get_columns {
1880             my $c = &check_options;
1881             $c->check_conn() or return;
1882              
1883             my (@args) = @_;
1884              
1885             my $esc = eval {
1886             $c->get_dbh()->get_info($GetInfoType{SQL_SEARCH_PATTERN_ESCAPE})
1887             } // '\\'; # /
1888              
1889             for (@args) {
1890             if ($_) {
1891             $_ = $c->__replace($_);
1892             # See Caveat in http://search.cpan.org/dist/DBI/DBI.pm#Catalog_Methods
1893             $_ =~ s/([_%])/$esc$1/g;
1894             }
1895             }
1896              
1897             @args = map { $_ ? split /\./, $_ : $_ } @args; # à faire après le __replace
1898              
1899             $c->query("[SQL::Exec] Get Columns: ".(join '.', grep { $_ } @args));
1900              
1901             $c->error('Too many arguments') if @args > 3;
1902             $c->error('Not enough arguments') if @args < 1;
1903             unshift @args, ((undef) x (3 - @args));
1904            
1905             my @c = eval {
1906             my $sth = $c->get_dbh()->column_info(@args, undef);
1907             my $ref = $sth->fetchall_arrayref();
1908             map { lc $_->[3] } @{$ref};
1909             };
1910              
1911             if ($@) {
1912             $c->warning("Operation not supported by your driver");
1913             return $c->__table_exists_dummy(@args);
1914             } elsif (@c) {
1915             return wantarray ? @c : \@c;
1916             } else {
1917             my $table = join '.', grep { defined $_ } @args;
1918             $c->error("unknown error, are you sure that the table '$table' exists ?");
1919             return;
1920             }
1921             }
1922              
1923              
1924             sub get_primary_key {
1925             my $c = &check_options;
1926             $c->check_conn() or return;
1927              
1928             my (@args) = @_;
1929              
1930             my $esc = eval {
1931             $c->get_dbh()->get_info($GetInfoType{SQL_SEARCH_PATTERN_ESCAPE})
1932             } // '\\'; # /
1933              
1934             for (@args) {
1935             if ($_) {
1936             $_ = $c->__replace($_);
1937             # See Caveat in http://search.cpan.org/dist/DBI/DBI.pm#Catalog_Methods
1938             $_ =~ s/([_%])/$esc$1/g;
1939             }
1940             }
1941              
1942             @args = map { $_ ? split /\./, $_ : $_ } @args; # à faire après le __replace
1943              
1944             $c->query("[SQL::Exec] Get Primary Key: ".(join '.', grep { $_ } @args));
1945              
1946             $c->error('Too many arguments') if @args > 3;
1947             $c->error('Not enough arguments') if @args < 1;
1948             unshift @args, ((undef) x (3 - @args));
1949            
1950             my @pk = eval {
1951             map { lc } $c->get_dbh()->primary_key(@args);
1952             };
1953              
1954             if ($@) {
1955             $c->error("Operation not supported by your driver");
1956             } else {
1957             if (defined $c->{options}{strict} and not @pk) {
1958             if (not $c->table_exists(@_)) {
1959             $c->strict_error("Table does not exist") and return;
1960             }
1961             }
1962             return wantarray ? @pk : \@pk;
1963             }
1964             }
1965              
1966             ################################################################################
1967             ################################################################################
1968             ## ##
1969             ## STATEMENTS INFORMATION FUNCTIONS ##
1970             ##                                                                            ##
1971             ################################################################################
1972             ################################################################################
1973              
1974              
1975             =head1 STATEMENTS INFORMATION FUNCTIONS
1976              
1977             All the functions (or methods) below can be applied either to an SQL::Exec object
1978             (or to the default object) in which case they will return informations about the
1979             previous query that was executed, or they can be applied to a prepared statement
1980             in which case they will return information about the statement currently prepared.
1981              
1982             The only exception is that queries executed through the C function/method
1983             will not count as the last query for these functions. This does not apply to the
1984             C method of a prepared statement nor to the C
1985             function/method.
1986              
1987             =head2 num_of_params
1988              
1989             my $n = num_of_params();
1990             my $n = $c->num_of_params();
1991             my $n = $st->num_of_params();
1992              
1993             Returns the number of
1994              
1995             =head2 num_of_fields
1996              
1997             my $n = num_of_fields();
1998             my $n = $c->num_of_fields();
1999             my $n = $st->num_of_fields();
2000              
2001             =head2 get_fields
2002              
2003             my @f = get_fields();
2004             my $f = get_fields();
2005             my @f = $st->get_fields();
2006             my @f = $st->get_fields();
2007              
2008             =cut
2009              
2010             push @EXPORT_OK, ('num_of_params', 'num_of_fields', 'get_fields');
2011              
2012             sub __get_statement {
2013             my ($c) = @_;
2014              
2015             if ($c->{is_statement}) {
2016             return $c->{last_req};
2017             } else {
2018             $c->error('No query have ever been prepared with this object') if not $c->{last_stmt};
2019             return $c->{last_stmt}->{last_req};
2020             }
2021             }
2022              
2023             sub num_of_params {
2024             my $c = &SQL::Exec::check_options or return;
2025             $c->check_conn() or return;
2026              
2027             my $stmt = $c->__get_statement();
2028              
2029             return $stmt->{NUM_OF_PARAMS};
2030             }
2031              
2032             sub num_of_fields {
2033             my $c = &SQL::Exec::check_options or return;
2034             $c->check_conn() or return;
2035              
2036             my $stmt = $c->__get_statement();
2037              
2038             return $stmt->{NUM_OF_FIELDS} // 0; # / some driver returns undef instead of 0
2039             }
2040              
2041             sub get_fields {
2042             my $c = &SQL::Exec::check_options or return;
2043             $c->check_conn() or return;
2044              
2045             my $stmt = $c->__get_statement();
2046             my @fields = @{$stmt->{NAME_lc}};
2047            
2048             return wantarray ? @fields : \@fields; # copy to have a clean rw array
2049             }
2050              
2051              
2052             =for comment
2053              
2054             ################################################################################
2055             ################################################################################
2056             ## ##
2057             ## HIGH LEVEL HELPER FUNCTIONS ##
2058             ##                                                                            ##
2059             ################################################################################
2060             ################################################################################
2061              
2062             push @EXPORT_OK, ('split_query');
2063              
2064              
2065             # TODO : décider de la sémantique (renvoie des statements vides ?)
2066             sub split_query {
2067             my ($str) = @_;
2068             return grep { $sql_split_grepper->split($_) } $sql_splitter->split($str);
2069             }
2070              
2071             =cut
2072              
2073             $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
2074              
2075             1;
2076              
2077             =head1 SUB-CLASSING
2078              
2079             The implementation of this library is as generic as possible. However some
2080             specific functions can be better written for some specific database server and
2081             some helper function can be easier to use if they are tuned for a single
2082             database server.
2083              
2084             This specific support is provided through sub-classse which extend both the OO
2085             and the functionnal interface of this library. As stated above, if there is a
2086             sub-classe for your specific database, you should use it instead of this module,
2087             otherwise.
2088              
2089             =head2 Sub-classes
2090              
2091             The sub-classes currently existing are the following ones:
2092              
2093             =over 4
2094              
2095             =item * L: the in-file or in memory database with L;
2096              
2097             =item * L: access to Oracle database server with L;
2098              
2099             =item * L: access to any ODBC enabled DBMS through L;
2100              
2101             =item * L: access to a Teradata database with
2102             the C driver (there is a C C driver using the native
2103             driver for this database (C), but its latest version is not on CPAN, so I
2104             recommend using the C interface).
2105              
2106             =back
2107              
2108             If your database of choice is not yet supported, let me know it and I will do my
2109             best to add a module for it (if the DBMS is freely available) or help you add
2110             this support (if I cannot have access to an instance of this database server).
2111              
2112             In the meantime, C should just work with your database. If that is
2113             not the case, you should report this as a L.
2114              
2115             =head2 How to
2116              
2117             ...
2118              
2119             =head1 EXAMPLES
2120              
2121             Examples would be good.
2122              
2123             =head1 BUGS
2124              
2125             Please report any bugs or feature requests to C, or
2126             through the web interface at L.
2127              
2128             =head1 SEE ALSO
2129              
2130             At some point or another you will want to look at the L documentation,
2131             mother of all database manipulation in Perl. You may also want to look at the
2132             L and L modules upon which SQL::Exec
2133             is based.
2134              
2135             There is several CPAN module similar to SQL::Exec, I list here only the
2136             closest (e.g. which does not impose OO upon your code), you should have a look
2137             at them before deciding to use SQL::Exec:
2138             L, L, L, C,
2139             L, L, C.
2140              
2141             Also, SQL::Exec will try its best to enable you to run your SQL code
2142             in a simple and efficiant way but it will not boil your coffee. You may be
2143             interested in other packages which may be used to go beyond SQL::Exec
2144             functionnalities, like L, L, and
2145             L.
2146              
2147             =head1 AUTHOR
2148              
2149             Mathias Kende (mathias@cpan.org)
2150              
2151             =head1 VERSION
2152              
2153             Version 0.10 (March 2013)
2154              
2155             =head1 COPYRIGHT & LICENSE
2156              
2157             Copyright 2013 © Mathias Kende. All rights reserved.
2158              
2159             This program is free software; you can redistribute it and/or
2160             modify it under the same terms as Perl itself.
2161              
2162             =cut
2163              
2164