File Coverage

blib/lib/SQL/SimpleOps.pm
Criterion Covered Total %
statement 607 1003 60.5
branch 325 692 46.9
condition 69 191 36.1
subroutine 52 66 78.7
pod 18 29 62.0
total 1071 1981 54.0


line stmt bran cond sub pod time code
1             ## ABSTRACT SQL Simple Operations Commands
2             #
3             ## LICENSE AND COPYRIGHT
4             #
5             ## Copyright (C) Carlos Celso
6             #
7             ## This program is free software: you can redistribute it and/or modify
8             ## it under the terms of the GNU General Public License as published by
9             ## the Free Software Foundation, either version 3 of the License, or
10             ## (at your option) any later version.
11             #
12             ## This program is distributed in the hope that it will be useful,
13             ## but WITHOUT ANY WARRANTY; without even the implied warranty of
14             ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15             ## GNU General Public License for more details.
16             #
17             ## You should have received a copy of the GNU General Public License
18             ## along with this program. If not, see L.
19             #
20             package SQL::SimpleOps;
21              
22 3     3   226327 use 5.006001;
  3         27  
23 3     3   17 use strict;
  3         4  
  3         61  
24 3     3   25 use warnings;
  3         5  
  3         95  
25 3     3   16 use Exporter;
  3         6  
  3         110  
26              
27 3     3   4867 use DBI;
  3         53081  
  3         176  
28 3     3   25 use File::Spec;
  3         5  
  3         379  
29              
30             ## dynamic modules
31              
32             ## option configfile=
33             ## JSON
34              
35             ## option driver=[drivername]
36             ## SQL::SimpleOps::[interface]::[driver]
37              
38             ## option message_log=1 (used as "required")
39             ## Sys::Syslog
40              
41             ## option sql_save=1 (used as "required")
42             ## Calc::Date
43             ## File::Path
44             ## IO::File
45              
46             ################################################################################
47             ## global initialization
48              
49             our @ISA = qw ( Exporter );
50              
51             our @EXPORT = qw(
52             new
53             Open Select SelectCursor Delete Insert
54             Update Commit Close Call Wait
55             getDBH getMessage getRC getRows
56             getLastCursor getLastSQL getLastSave getWhere
57             getAliasTable getAliasCols
58             setDumper
59              
60             SQL_SIMPLE_CURSOR_BACK
61             SQL_SIMPLE_CURSOR_NEXT
62             SQL_SIMPLE_CURSOR_TOP
63             SQL_SIMPLE_CURSOR_LAST
64             SQL_SIMPLE_CURSOR_RELOAD
65              
66             SQL_SIMPLE_ORDER_OFF
67             SQL_SIMPLE_ORDER_ASC
68             SQL_SIMPLE_ORDER_DESC
69              
70             SQL_SIMPLE_CMD_OFF
71             SQL_SIMPLE_CMD_ON
72             SQL_SIMPLE_CMD_ALL
73              
74             SQL_SIMPLE_LOG_OFF
75             SQL_SIMPLE_LOG_STD
76             SQL_SIMPLE_LOG_SYS
77             SQL_SIMPLE_LOG_ALL
78              
79             SQL_SIMPLE_RC_SYNTAX
80             SQL_SIMPLE_RC_OK
81             SQL_SIMPLE_RC_ERROR
82             SQL_SIMPLE_RC_EMPTY
83              
84             $VERSION
85             $errstr
86             $err
87             );
88              
89             our $VERSION = "2023.274.1";
90              
91             our @EXPORT_OK = @EXPORT;
92              
93             our %EXPORT_TAGS = ( all => [@EXPORT_OK] );
94              
95             ################################################################################
96             ## literals initialization
97              
98 3     3   25 use constant SQL_SIMPLE_CURSOR_TOP => 1; # page first
  3         6  
  3         243  
99 3     3   23 use constant SQL_SIMPLE_CURSOR_BACK => 2; # page backward
  3         7  
  3         167  
100 3     3   19 use constant SQL_SIMPLE_CURSOR_NEXT => 3; # page next
  3         5  
  3         163  
101 3     3   35 use constant SQL_SIMPLE_CURSOR_LAST => 4; # page last
  3         6  
  3         136  
102 3     3   15 use constant SQL_SIMPLE_CURSOR_RELOAD => 5; # page current
  3         6  
  3         134  
103              
104 3     3   16 use constant SQL_SIMPLE_ORDER_OFF => undef; # order disabled
  3         5  
  3         149  
105 3     3   17 use constant SQL_SIMPLE_ORDER_ASC => "ASC"; # order asceding
  3         36  
  3         138  
106 3     3   16 use constant SQL_SIMPLE_ORDER_DESC => "DESC"; # order descending
  3         5  
  3         148  
107              
108 3     3   18 use constant SQL_SIMPLE_CMD_OFF => 0; # sql_save disabled
  3         6  
  3         142  
109 3     3   17 use constant SQL_SIMPLE_CMD_ON => 1; # sql_save update
  3         6  
  3         158  
110 3     3   18 use constant SQL_SIMPLE_CMD_ALL => 2; # sql_save read/update
  3         5  
  3         150  
111              
112 3     3   17 use constant SQL_SIMPLE_LOG_OFF => 0; # log disabled
  3         5  
  3         180  
113 3     3   18 use constant SQL_SIMPLE_LOG_SYS => 1; # log syslog
  3         6  
  3         141  
114 3     3   18 use constant SQL_SIMPLE_LOG_STD => 2; # log stderr
  3         5  
  3         141  
115 3     3   19 use constant SQL_SIMPLE_LOG_ALL => 3; # log stderr/syslog
  3         5  
  3         142  
116              
117 3     3   17 use constant SQL_SIMPLE_RC_SYNTAX => -1; # syntax error
  3         5  
  3         246  
118 3     3   22 use constant SQL_SIMPLE_RC_OK => 0; # sql successul
  3         5  
  3         130  
119 3     3   38 use constant SQL_SIMPLE_RC_ERROR => 1; # sql error
  3         8  
  3         164  
120 3     3   17 use constant SQL_SIMPLE_RC_EMPTY => 2; # sql successul, empty
  3         6  
  3         37266  
121              
122             ################################################################################
123             ## local environments
124            
125             our $SQL_SIMPLE_CLASS = "SQL::SimpleOps";
126              
127             our %SQL_SIMPLE_TABLE_OF_MSGS =
128             (
129             "001" => { T=>"E", M=>"[%s] Database is missing" },
130             "002" => { T=>"E", M=>"[%s] Server is missing" },
131             "003" => { T=>"E", M=>"[%s] Interface invalid" },
132             "004" => { T=>"S", M=>"[%s] The Database driver is omitted or empty" },
133             "005" => { T=>"E", M=>"[%s] Table is missing" },
134             "006" => { T=>"E", M=>"[%s] Table invalid, must be single-value or array" },
135             "007" => { T=>"E", M=>"[%s] Fields invalid, must be array" },
136             "008" => { T=>"E", M=>"[%s] Group_by invalid, must be single-value or array" },
137             "009" => { T=>"E", M=>"[%s] Order_by invalid, must be single-value or array-pairs" },
138             "010" => { T=>"E", M=>"[%s] Table/Field Index invalid" },
139             "011" => { T=>"E", M=>"[%s} Stat File error, %s" },
140             "012" => { T=>"I", M=>"[%s] Key not found" },
141             "013" => { T=>"E", M=>"[%s] Cursor is missing or invalid" },
142             "014" => { T=>"E", M=>"[%s] Cursor-key is missing or invalid" },
143             "015" => { T=>"E", M=>"[%s] Cursor Command invalid" },
144             "016" => { T=>"W", M=>"[%s] Key is missing, option 'force' is required" },
145             "017" => { T=>"E", M=>"[%s] Fields is missing" },
146             "018" => { T=>"E", M=>"[%s] Fields Format error, must be hash-pairs or arrayref" },
147             "019" => { T=>"E", M=>"[%s] Interface '%s::%s' missing" },
148             "020" => { T=>"E", M=>"[%s] Where Clause invalid" },
149             "021" => { T=>"E", M=>"[%s] Field invalid, must be single-value or array" },
150             "022" => { T=>"E", M=>"[%s] Database is not open" },
151             "023" => { T=>"E", M=>"[%s] SQL Command is missing" },
152             "024" => { T=>"E", M=>"[%s] Buffer Type invalid, must be hashref, arrayref, scalaref or callback_ref" },
153             "025" => { T=>"S", M=>"[%s] Make Folder error, %s" },
154             "026" => { T=>"S", M=>"[%s] Open File error, %s" },
155             "027" => { T=>"S", M=>"[%s] Values is missing" },
156             "028" => { T=>"E", M=>"[%s] Table/Field Value invalid, must be single-value or array" },
157             "029" => { T=>"E", M=>"[%s] TCP Port invalid, must be numeric and between 1-65536" },
158             "030" => { T=>"E", M=>"[%s] Aliass Table is not a hashref" },
159             "031" => { T=>"E", M=>"[%s] Aliases '%s' invalid, table_cols must be hashref" },
160             "032" => { T=>"E", M=>"[%s] Aliases '%s' invalid, table_cols invalid format" },
161             "033" => { T=>"E", M=>"[%s] Table '%s' already, there can be only one" },
162             "034" => { T=>"E", M=>"[%s] Aliases '%s' invalid, table_name is missing" },
163             "035" => { T=>"S", M=>"[%s] Interface '%s::%s' error, %s" },
164             "036" => { T=>"S", M=>"[%s] Interface '%s::%s' load error" },
165             "037" => { T=>"S", M=>"[%s] Interface '%s::%s' aborted, %s" },
166             "038" => { T=>"E", M=>"[%s] Syslog Facility invalid, must be 'local0' to 'local7'" },
167             "039" => { T=>"E", M=>"[%s] Syslog Service invalid, must contains 'alphanumeric' characters" },
168             "040" => { T=>"E", M=>"[%s] Log File invalid, must contains 'alphanumeric' characters" },
169             "041" => { T=>"E", M=>"[%s] Values Format error, must be arrayref" },
170             "042" => { T=>"E", M=>"[%s] Conflict/Duplicate Format error, must be hashref" },
171             "043" => { T=>"E", M=>"[%s] Limit is missing" },
172             "044" => { T=>"E", M=>"[%s] Buffer hashkey invalid, buffer is not hashref" },
173             "045" => { T=>"E", M=>"[%s] Buffer hashkey not mapped" },
174             "046" => { T=>"E", M=>"[%s] Buffer hashkey must be scalaref or arrayref" },
175             "047" => { T=>"E", M=>"[%s] Buffer arrayref Off not allowed for multiple field list" },
176             "099" => { T=>"S", M=>"[%s] %s" },
177             );
178              
179             our $errstr = ""; # last message
180             our $err = 0; # last return code
181              
182             1;
183              
184             ################################################################################
185             ## action: create object
186             ## return:
187             ## null falure to loaded, system error
188             ## bless is successful loaded
189              
190             sub new()
191             {
192 2   33 2 0 207 my $class = shift; $class = ref($class) || $class || $SQL_SIMPLE_CLASS;
  2         18  
193 2         5 my $self = {};
194              
195 2         14 $self->{argv} = {@_};
196              
197             ## checking for configfile
198 2 50       10 if (defined($self->{argv}{configfile}))
199             {
200 0 0       0 if (!stat($self->{argv}{configfile}))
201             {
202 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"011",$self->{argv}{configfile});
203 0         0 return undef;
204             }
205 0         0 my $fh = new IO::File($self->{argv}{configfile});
206 0 0       0 if (!defined($fh))
207             {
208 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"026",$!);
209 0         0 return undef;
210             }
211 0         0 require JSON;
212 0         0 my $st; while (!$fh->eof) { $st .= <$fh>; }; undef($fh);
  0         0  
  0         0  
  0         0  
213 0         0 my $pt = new JSON(); $self->{argv} = $pt->decode($st); undef($pt);
  0         0  
  0         0  
214             }
215              
216             ## defaults
217 2 50       11 $self->{argv}{interface} = "dbi" if (!defined($self->{argv}{interface}));
218 2 50       10 $self->{argv}{quote} = "'" if (!defined($self->{argv}{quote}));
219 2 50       9 $self->{argv}{connect} = 1 if (!defined($self->{argv}{connect}));
220 2 50       11 $self->{argv}{message_log} = SQL_SIMPLE_LOG_STD if (!defined($self->{argv}{message_log}));
221 2 50       8 $self->{argv}{port} = "" if (!defined($self->{argv}{port}));
222              
223             ## check interfaces
224 2 50       37 if (!grep(/^$self->{argv}{interface}$/i,"dbi"))
225             {
226 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"003");
227 0         0 return undef;
228             }
229              
230             ## check driver
231 2 50 33     19 if (!defined($self->{argv}{driver}) || $self->{argv}{driver} eq "")
232             {
233 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"004");
234 0         0 return undef;
235             }
236              
237             ## check database
238 2 50 33     14 if (!defined($self->{argv}{db}) || $self->{argv}{db} eq "")
239             {
240 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"001");
241 0         0 return undef;
242             }
243              
244             ## check aliases table
245 2 50       7 if (defined($self->{argv}{tables}))
246             {
247 0 0       0 if (ref($self->{argv}{tables}) ne "HASH")
248             {
249 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"030");
250 0         0 return undef;
251             }
252 0         0 foreach my $table(keys(%{$self->{argv}{tables}}))
  0         0  
253             {
254 0 0 0     0 if (!defined($self->{argv}{tables}{$table}{name}) || $self->{argv}{tables}{$table}{name} eq "")
255             {
256 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"034",$table);
257 0         0 return undef;
258             }
259 0 0       0 if (defined($self->{argv}{tables}{$table}{cols}))
260             {
261 0 0       0 if (ref($self->{argv}{tables}{$table}{cols}) ne "HASH")
262             {
263 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"031",$table);
264 0         0 return undef;
265             }
266 0         0 foreach my $field(keys(%{$self->{argv}{tables}{$table}{cols}}))
  0         0  
267             {
268 0 0       0 if ($self->{argv}{tables}{$table}{cols}{$field} eq "")
269             {
270 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"032",$field);
271 0         0 return undef;
272             }
273             }
274             }
275             }
276             }
277              
278             ## check syslog options
279 2 50 33     8 if (defined($self->{argv}{message_syslog_facility}) && !($self->{argv}{message_syslog_facility} =~ /^local[0-7]$/i))
280             {
281 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"038",$self->{argv}{message_syslog_facility});
282 0         0 return undef;
283             }
284 2 50 33     7 if (defined($self->{argv}{message_syslog_service}) && ($self->{argv}{message_syslog_service} =~ s/[a-zA-Z0-9\-\_]//g))
285             {
286 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"039",$self->{argv}{message_syslog_service});
287 0         0 return undef;
288             }
289 2 50 33     8 if (defined($self->{argv}{sql_save_name}) && ($self->{argv}{sql_save_name} =~ s/[a-zA-Z0-9\-\_]//g))
290             {
291 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"040",$self->{argv}{sql_save_name});
292 0         0 return undef;
293             }
294              
295             ## interface defaults values
296 2         8 $self->{argv}{interface} = uc($self->{argv}{interface});
297 2 50       11 $self->{argv}{interface_options}{RaiseError} = 0 if (!defined($self->{argv}{interface_options}{RaiseError}));
298 2 50       9 $self->{argv}{interface_options}{PrintError} = 0 if (!defined($self->{argv}{interface_options}{PrintError}));
299              
300             ## standards plugins
301 2 50       99 if (grep(/^$self->{argv}{driver}$/i,"mysql","mariadb")) {$self->{init}{plugin_id} = "MySQL";}
  0 50       0  
    50          
302 0         0 elsif (grep(/^$self->{argv}{driver}$/i,"pg","postgres","postsql","pgsql")) {$self->{init}{plugin_id} = "PG";}
303 2         15 elsif (grep(/^$self->{argv}{driver}$/i,"sqlite","sqlite3")) {$self->{init}{plugin_id} = "SQLite";}
304 0         0 else {$self->{init}{plugin_id} = $self->{argv}{driver};}
305              
306             ## load pluging
307 2         4 my $fn;
308 2         12 my $plugin = $SQL_SIMPLE_CLASS."::".$self->{argv}{interface}."::".$self->{init}{plugin_id};
309 2         7 foreach my $dir(@INC)
310             {
311 4         51 $fn = File::Spec->catdir($dir,split(/::/,$plugin)).".pm";
312 4 100       79 last if (stat($fn));
313 2         8 $fn = "";
314             }
315 2 50       13 if ($fn eq "")
316             {
317 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"019",$self->{argv}{interface},$self->{init}{plugin_id});
318 0         0 return undef;
319             }
320 2         4 eval { require $fn; };
  2         1003  
321 2 50       12 if ($@)
322             {
323 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"035",$self->{argv}{interface},$self->{init}{plugin_id},$@);
324 0         0 return undef;
325             }
326 2         14 $self->{init}{plugin_fh} = $plugin->new(sql_simple => $self);
327 2 50       11 if (!defined($self->{init}{plugin_fh}))
328             {
329 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"035",$self->{argv}{interface},$self->{init}{plugin_id},$@);
330 0         0 return undef;
331             }
332              
333             ## test server, the 'test_server' env must be defined on plugin
334 2 50       7 if ($self->{init}{test_server})
335             {
336 0 0       0 if ($self->{argv}{server} eq "")
337             {
338 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"002");
339 0         0 return undef;
340             }
341 0 0 0     0 if ($self->{argv}{port} ne "" && (($self->{argv}{port} =~ /^\D+$/) || ($self->{argv}{port} < 1 || $self->{argv}{port} > 65535)))
      0        
342             {
343 0         0 &setMessage($self,"new",SQL_SIMPLE_RC_SYNTAX,"029");
344 0         0 return undef;
345             }
346             }
347              
348             ## new object
349 2         7 my $bless = bless($self,$class);
350 2 50       7 return undef if (!defined($bless));
351              
352             ## my first connect
353 2 50 33     17 return undef if ($self->{argv}{connect} && $self->Open());
354              
355             ## successful
356 2         7 return $bless;
357             }
358              
359             ################################################################################
360             ## action: open database
361             ## return:
362             ## rc<0 syntax error
363             ## rc=0 successful
364             ## rc>0 sql return code
365              
366             sub Open()
367             {
368 1     1 1 2 my $self = shift;
369              
370 1 50 33     10 if ($self->{init}{plugin_fh}->can('Open') && $self->{init}{plugin_fh}->Open())
371             {
372 0         0 $self->setMessage("open",SQL_SIMPLE_RC_SYNTAX,"037",$self->{argv}{interface},$self->{argv}{driver},$self->getMessage());
373 0         0 return SQL_SIMPLE_RC_SYNTAX;
374             }
375 1 50       8 if ($self->{argv}{interface} =~ /^dbi$/i)
376             {
377             $self->{init}{dbh} = DBI->connect(
378 1         6 $self->{argv}{dsname}, $self->{argv}{login}, $self->{argv}{password}, \%{$self->{argv}{interface_options}});
  1         10  
379 1         13617 $self->setMessage("open");
380 1         3 return $self->getRC();
381             }
382 0         0 return SQL_SIMPLE_RC_SYNTAX;
383             }
384              
385             ################################################################################
386             ## action: select as fetch command, buffers of lines based cursor
387             ## return:
388             ## rc<0 syntax error
389             ## rc=0 successful
390             ## rc=1 sql error
391             ## rc=2 successful, no lines selected (no match or empty)
392              
393             sub SelectCursor()
394             {
395 8     8 1 15654 my $self = shift;
396 8         37 my $argv = {@_};
397              
398 8         23 $self->_Dumper("selectcursor",$argv);
399 8         22 $self->setLastSQL("");
400 8 50       23 $self->Open() if (!defined($self->{init}{dbh}));
401              
402             ## define the command in load
403 8         13 $self->{init}{command} = "select";
404              
405 8 50 33     39 if ($self->{init}{plugin_fh}->can('SelectCursor') && $self->{init}{plugin_fh}->SelectCursor($argv))
406             {
407 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"037",$self->{argv}{interface},$self->{argv}{driver},$self->getMessage());
408 0         0 return SQL_SIMPLE_RC_SYNTAX;
409             }
410              
411 8 50       21 my $saved_message_log = $self->setLogMessage($argv->{message_log}) if (defined($argv->{message_log}));
412 8 50       32 my $saved_quote = $self->setQuote($argv->{quote}) if (defined($argv->{quote}));
413 8 50       19 my $saved_sql_save = $self->setSqlSave($argv->{sql_save}) if (defined($argv->{sql_save}));
414              
415 8         13 my $rc = $self->_SelectCursor(%{$argv});
  8         31  
416              
417 8 50       28 $self->setMessgeLog($saved_message_log) if (defined($argv->{message_log}));
418 8 50       20 $self->setQuote($saved_quote) if (defined($argv->{quote}));
419 8 50       19 $self->setSqlSave($saved_sql_save) if (defined($argv->{sql_save}));
420              
421 8         25 return $rc;
422             }
423              
424             sub _SelectCursor()
425             {
426 8     8   23 my $self = shift;
427 8         26 my $argv = {@_};
428              
429             ## check mandatory options
430 8 100 100     38 if ($argv->{cursor_command} != SQL_SIMPLE_CURSOR_TOP && $argv->{cursor_command} != SQL_SIMPLE_CURSOR_LAST)
431             {
432 5 50 33     17 if (!defined($argv->{cursor}) || $argv->{cursor} eq "")
433             {
434 5 50       12 if (!defined($argv->{cursor_info}))
435             {
436 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"013");
437 0         0 return SQL_SIMPLE_RC_SYNTAX;
438             }
439 5         10 my ($first,$last);
440 5 50       14 if (ref($argv->{cursor_info}) eq "HASH") { ($first,$last) = ($argv->{cursor_info}{first},$argv->{cursor_info}{last}); }
  5 0       16  
    0          
441 0         0 elsif (ref($argv->{cursor_info}) eq "ARRAY") { ($first,$last) = ($argv->{cursor_info}[2],$argv->{cursor_info}[3]); }
442 0         0 elsif (ref($argv->{cursor_info}) eq "SCALAR") { my @a=split(" ",$argv->{cursor_info}); ($first,$last) = ($a[2],$a[3]); }
  0         0  
443             else
444             {
445 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"013");
446 0         0 return SQL_SIMPLE_RC_SYNTAX;
447             }
448 5 100       16 if ($argv->{cursor_command} == SQL_SIMPLE_CURSOR_NEXT) { $argv->{cursor} = $last; $argv->{cursor_command} = SQL_SIMPLE_CURSOR_TOP if (!defined($last));}
  2 100       6  
  2 100       7  
    50          
449 2 100       7 elsif ($argv->{cursor_command} == SQL_SIMPLE_CURSOR_BACK) { $argv->{cursor} = $first; $argv->{cursor_command} = SQL_SIMPLE_CURSOR_LAST if (!defined($first));}
  2         7  
450 1         4 elsif ($argv->{cursor_command} == SQL_SIMPLE_CURSOR_RELOAD) { $argv->{cursor} = $first; }
451             }
452             }
453 8 50 33     36 if (!defined($argv->{cursor_key}) || ref($argv->{cursor_key}) ne "")
454             {
455 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"014");
456 0         0 return SQL_SIMPLE_RC_SYNTAX;
457             }
458 8 50 33     18 if (defined($argv->{where}) && ref($argv->{where}) ne "ARRAY")
459             {
460 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"021");
461 0         0 return SQL_SIMPLE_RC_SYNTAX;
462             }
463              
464             ## have order by?
465 8         15 my @order;
466 8 50       17 if (!defined($argv->{order_by})) {}
    0          
    0          
    0          
467 0         0 elsif (ref($argv->{order_by}) eq "ARRAY") { @order = @{$argv->{order_by}}; }
  0         0  
468 0         0 elsif (ref($argv->{order_by}) eq "HASH") { @order = ($argv->{order_by}); }
469 0         0 elsif (ref($argv->{order_by}) eq "") { @order = ($argv->{order_by}); }
470             else
471             {
472 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"009");
473 0         0 return SQL_SIMPLE_RC_SYNTAX;
474             }
475             ## test the type of cursor
476 8 100 100     47 if ($argv->{cursor_command} == SQL_SIMPLE_CURSOR_TOP)
    100          
    100          
    50          
477             {
478 3         16 unshift(@order,{$argv->{cursor_key} => SQL_SIMPLE_ORDER_ASC});
479             }
480             elsif ($argv->{cursor_command} == SQL_SIMPLE_CURSOR_BACK)
481             {
482 1         4 unshift(@order,{$argv->{cursor_key} => SQL_SIMPLE_ORDER_DESC});
483              
484 1         2 unshift(@{$argv->{where}}, $argv->{cursor_key} => [ "<", $argv->{cursor} ]);
  1         5  
485             }
486             elsif ($argv->{cursor_command} == SQL_SIMPLE_CURSOR_NEXT || $argv->{cursor_command} == SQL_SIMPLE_CURSOR_RELOAD)
487             {
488 2         7 unshift(@order,{$argv->{cursor_key} => SQL_SIMPLE_ORDER_ASC});
489              
490 2         3 unshift(@{$argv->{where}}, $argv->{cursor_key} => [ ">", $argv->{cursor} ]);
  2         10  
491             }
492             elsif ($argv->{cursor_command} == SQL_SIMPLE_CURSOR_LAST)
493             {
494 2         8 unshift(@order,{$argv->{cursor_key} => SQL_SIMPLE_ORDER_DESC});
495             }
496             else
497             {
498 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"015");
499 0         0 return SQL_SIMPLE_RC_SYNTAX;
500             }
501 8 50 33     36 if (!defined($argv->{limit}) || $argv->{limit} eq "")
502             {
503 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"043");
504 0         0 return SQL_SIMPLE_RC_SYNTAX;
505             }
506             ## format o order options
507 8 50       18 unshift(@{$argv->{order_by}},@order) if (@order);
  8         21  
508              
509             ## define notfound if not exists
510 8 50       23 $argv->{notfound} = 1 if (!defined($argv->{notfound}));
511              
512             ## execute and save cursor info
513 8 50       12 return $self->{init}{cursor}{rc} if ($self->{init}{cursor}{rc} = $self->_Select(%{$argv}));
  8         34  
514              
515 0         0 $self->{init}{cursor}{lines} = $self->getRows();
516              
517             ($self->{init}{cursor}{first},$self->{init}{cursor}{last}) =
518             ($self->{init}{cursor}{lines}) ?
519 0 0       0 ( $argv->{buffer}[0]{$argv->{cursor_key}}, $argv->{buffer}[$self->{init}{cursor}{lines}-1]{$argv->{cursor_key}} ):
520             ( 0, 0 );
521              
522             ## return cursor info
523 0 0       0 if (!defined($argv->{cursor_info})) {}
    0          
    0          
    0          
524             elsif (ref($argv->{cursor_info}) eq "HASH")
525             {
526 0         0 $argv->{cursor_info}->{rc} = $self->{init}{cursor}{rc};
527 0         0 $argv->{cursor_info}->{lines} = $self->{init}{cursor}{lines};
528             ($argv->{cursor_info}->{first},$argv->{cursor_info}->{last}) = ($argv->{cursor_command} == SQL_SIMPLE_CURSOR_BACK) ?
529             ($self->{init}{cursor}{last},$self->{init}{cursor}{first}) :
530 0 0       0 ($self->{init}{cursor}{first},$self->{init}{cursor}{last});
531             }
532             elsif (ref($argv->{cursor_info}) eq "ARRAY")
533             {
534 0         0 $argv->{cursor_info}->[0] = $self->{init}{cursor}{rc};
535 0         0 $argv->{cursor_info}->[1] = $self->{init}{cursor}{lines};
536             ($argv->{cursor_info}->[2],$argv->{cursor_info}->[3]) = ($argv->{cursor_command} == SQL_SIMPLE_CURSOR_BACK) ?
537             ($self->{init}{cursor}{last},$self->{init}{cursor}{first}) :
538 0 0       0 ($self->{init}{cursor}{first},$self->{init}{cursor}{last});
539             }
540             elsif (ref($argv->{cursor_info}) eq "SCALAR")
541             {
542 0         0 my @a = split(" ",${$argv->{cursor_info}});
  0         0  
543 0         0 $argv->{cursor_info} = $self->{init}{cursor}{rc}." ".$self->{init}{cursor}{lines}." ".$a[2]." ".$a[3];
544             }
545 0         0 return SQL_SIMPLE_RC_OK;
546             }
547              
548             ################################################################################
549             ## action: select command
550             ## return:
551             ## rc<0 syntax error
552             ## rc=0 successful
553             ## rc=1 sql error
554             ## rc=2 no selected found (no match where found)
555              
556             sub Select()
557             {
558 25     25 1 44515 my $self = shift;
559 25         90 my $argv = {@_};
560              
561 25         70 $self->_Dumper("select",$argv);
562 25         78 $self->setLastSQL("");
563 25 50       68 $self->Open() if (!defined($self->{init}{dbh}));
564              
565             ## define the command in load
566 25         45 $self->{init}{command} = "select";
567              
568 25 50 33     106 if ($self->{init}{plugin_fh}->can('Select') && $self->{init}{plugin_fh}->Select($argv))
569             {
570 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"037",$self->{argv}{interface},$self->{argv}{driver},$self->getMessage());
571 0         0 return SQL_SIMPLE_RC_SYNTAX;
572             }
573              
574 25 50       57 my $saved_message_log = $self->setLogMessage($argv->{message_log}) if (defined($argv->{message_log}));
575 25 50       51 my $saved_quote = $self->setQuote($argv->{quote}) if (defined($argv->{quote}));
576 25 100       52 my $saved_sql_save = $self->setSqlSave($argv->{sql_save}) if (defined($argv->{sql_save}));
577              
578 25         47 my $rc = $self->_Select(%{$argv});
  25         96  
579              
580 25 50       103 $self->setMessgeLog($saved_message_log) if (defined($argv->{message_log}));
581 25 50       55 $self->setQuote($saved_quote) if (defined($argv->{quote}));
582 25 100       58 $self->setSqlSave($saved_sql_save) if (defined($argv->{sql_save}));
583              
584 25         96 return $rc;
585             }
586              
587             sub _Select()
588             {
589 33     33   46 my $self = shift;
590 33         88 my $argv = {@_};
591              
592             ## check mandatory options
593 33 50       73 if (!defined($argv->{table}))
594             {
595 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"005");
596 0         0 return SQL_SIMPLE_RC_SYNTAX;
597             }
598 33         49 my @tables_work;
599 33 100       95 if (ref($argv->{table}) eq "") { @tables_work = ($argv->{table}); }
  30 50       60  
600             elsif (ref($argv->{table}) eq "ARRAY")
601             {
602 3         6 my %tables_tmp;
603 3         6 foreach my $table(@{$argv->{table}})
  3         7  
604             {
605 6 50       24 if ($tables_tmp{$table})
606             {
607 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"033",$table);
608 0         0 return SQL_SIMPLE_RC_SYNTAX;
609             }
610 6         15 $tables_tmp{$table}=1;
611             }
612 3         5 @tables_work = @{$argv->{table}};
  3         10  
613             }
614             else
615             {
616 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"006");
617 0         0 return SQL_SIMPLE_RC_SYNTAX;
618             }
619 33         81 my @fields_work;
620             my %fields_distinct;
621 33         0 my %fields_aliases;
622 33 100       58 if (defined($argv->{fields}))
623             {
624 26         37 my $fields_argv;
625 26 50       82 if (ref($argv->{fields}) eq "ARRAY") { $fields_argv = $argv->{fields}; }
  26 0       38  
626 0         0 elsif (ref($argv->{fields}) eq "") { $fields_argv = [ $argv->{fields} ]; }
627             else
628             {
629 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"007");
630 0         0 return SQL_SIMPLE_RC_SYNTAX;
631             }
632 26         53 for (my $ix=0; $ix < @{$fields_argv}; $ix++)
  81         159  
633             {
634 55         68 my $field = $fields_argv->[$ix];
635 55         85 my $distinct;
636             my $alias;
637 55 100       93 if (ref($field) eq "HASH")
638             {
639 7         11 $alias = $field;
640 7         11 ($fields_aliases{$alias}{f},$fields_aliases{$alias}{a}) = %{$field};
  7         32  
641 7         20 $field = $fields_aliases{$alias}{f};
642             }
643 55 100       159 if ($field =~ /^distinct$/i)
    50          
644             {
645 3         7 $field = $fields_argv->[++$ix];
646 3         7 $distinct = 1;
647             }
648             elsif ($field =~ /^distinct\s+(.*)/i)
649             {
650 0         0 $field = $1;
651 0         0 $distinct = 1;
652             }
653 55 100       124 if (!($field =~ /^\\/))
654             {
655 52 100       140 my $value = ($field =~ /^(.*?)\((.*?)\,(.*)\)/) ? $2 : ($field =~ /^(.*?)\((.*)\)/) ? $2 : $field;
    100          
656 52 100       126 if ($value =~ /^(.*)\.(.*)$/)
657             {
658 9         20 my $table = $1;
659 9 50       124 if (!grep(/^$table$/i,@tables_work))
660             {
661 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"010");
662 0         0 return SQL_SIMPLE_RC_SYNTAX;
663             }
664             }
665             }
666 55   66     174 push(@fields_work,$alias || $field);
667 55 100       120 $fields_distinct{$field} = 1 if ($distinct);
668             }
669             }
670             else
671             {
672 7 50       20 if (@tables_work > 1)
673             {
674 0         0 foreach my $table(@tables_work)
675             {
676 0 0 0     0 if (!defined($self->{argv}{tables}{$table}) || !defined($self->{argv}{tables}{$table}{cols}))
677             {
678 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"010");
679 0         0 return SQL_SIMPLE_RC_SYNTAX;
680             }
681 0         0 foreach my $field(sort(keys(%{$self->{argv}{tables}{$table}{cols}})))
  0         0  
682             {
683 0         0 push(@fields_work,$table.".".$field);
684             }
685             }
686             }
687             else
688             {
689 7 50 33     29 if (defined($self->{argv}{tables}{$tables_work[0]}) && defined($self->{argv}{tables}{$tables_work[0]}{cols}))
690             {
691 0         0 push(@fields_work,sort(keys(%{$self->{argv}{tables}{$tables_work[0]}{cols}})));
  0         0  
692             }
693             }
694             }
695 33         51 my @group_work;
696 33 50       66 if (defined($argv->{group_by}))
697             {
698 0 0       0 if (ref($argv->{group_by}) eq "") { @group_work = ($argv->{group_by}); }
  0 0       0  
699 0         0 elsif (ref($argv->{group_by}) eq "ARRAY") { push(@group_work,@{$argv->{group_by}}); }
  0         0  
700             else
701             {
702 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"008");
703 0         0 return SQL_SIMPLE_RC_SYNTAX;
704             }
705             }
706 33         45 my @order_work;
707 33 100       62 if (defined($argv->{order_by}))
708             {
709 15 100       51 if (ref($argv->{order_by}) eq "") { @order_work = ($argv->{order_by}); }
  1 100       3  
    50          
710 1         3 elsif (ref($argv->{order_by}) eq "HASH") { @order_work = ($argv->{order_by}); }
711             elsif (ref($argv->{order_by}) eq "ARRAY")
712             {
713 13         21 push(@order_work,@{$argv->{order_by}});
  13         24  
714             }
715             else
716             {
717 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"009");
718 0         0 return SQL_SIMPLE_RC_SYNTAX;
719             }
720             }
721             ## making fields
722 33 50       78 my $middle = ($self->{init}{alias_with_as}) ? " AS " : " ";
723 33         45 my @fields;
724 33         44 my $table = $tables_work[0];
725 33 100       68 if (@fields_work)
726             {
727 26         80 foreach my $field(@fields_work)
728             {
729 55         106 my $alias;
730 55 100       126 my $distinct = ($fields_distinct{$field}) ? "DISTINCT " : "";
731             ## field is hash?
732 55 100       104 if (defined($fields_aliases{$field}))
733             {
734 7         12 $alias = $fields_aliases{$field}{a};
735 7         13 $field = $fields_aliases{$field}{f};
736             }
737             ## is escape?
738 55 100       104 if ($field =~ /^\\(.*)/)
739             {
740 3 100       15 ($alias) ?
741             push(@fields,$distinct.$1.$middle.$alias) :
742             push(@fields,$distinct.$1);
743 3         8 next;
744             }
745             ## have function?
746 52         98 my $field_a;
747             my $field_b;
748 52 100       116 if ($field =~ /^(.*?)\((.*?)\,(.*)\)/)
    100          
749             {
750 1         4 $field_a = $1."(";
751 1         3 $field = $2;
752 1         3 $field_b = ",".$3.")";
753             }
754             elsif ($field =~ /^(.*?)\((.*)\)/)
755             {
756 5         11 $field_a = $1."(";
757 5         11 $field = $2;
758 5         10 $field_b = ")";
759             }
760             else
761             {
762 46         59 $field_a = "";
763 46         63 $field_b = "";
764             }
765             ## translate field
766 52 100       103 if ($field =~ /^(.*)\.(.*)$/)
767             {
768 9         29 my $table = $1;
769 9         16 my $field = $2;
770 9         19 my $realn = $self->getAliasCols($table,$field);
771 9 50       46 ($alias) ?
    100          
772             push(@fields,$distinct.$field_a.$table.".".$realn.$field_b.$middle.$alias) :
773             ($field ne $realn) ?
774             push(@fields,$distinct.$field_a.$table.".".$realn.$field_b." ".$table."_".$field) :
775             push(@fields,$distinct.$field_a.$table.".".$realn.$field_b);
776             }
777             else
778             {
779 43 50       79 if (@tables_work == 1)
780             {
781 43         83 my $realn = $self->getAliasCols($table,$field);
782 43 50       165 ($alias) ?
    100          
783             push(@fields,$distinct.$field_a.$realn.$field_b.$middle.$alias) :
784             ($field ne $realn) ?
785             push(@fields,$distinct.$field_a.$realn.$field_b." ".$field) :
786             push(@fields,$distinct.$field_a.$field.$field_b);
787             }
788             else
789             {
790 0 0       0 ($alias) ?
791             push(@fields,$distinct.$field.$middle.$alias):
792             push(@fields,$distinct.$field);
793             }
794             }
795             }
796             }
797             else
798             {
799 7         11 push(@fields,"*");
800             }
801             ## make where
802 33         48 my $where;
803 33 50       114 return SQL_SIMPLE_RC_SYNTAX if ($self->_getWhere("select",\@tables_work,$argv->{where},\$where));
804              
805             ## make order
806 33         68 my @order;
807 33         69 while (@order_work)
808             {
809 18         30 my $field = shift(@order_work);
810 18 100       39 if (ref($field) eq "HASH")
811             {
812 13         18 foreach my $_id(sort(keys(%{$field})))
  13         50  
813             {
814 13         39 $self->_SelectOrderBy(\@order,$table,$_id,$field->{$_id});
815             }
816             }
817 5         12 else { $self->_SelectOrderBy(\@order,$table,$field); }
818             }
819             ## make tables
820 33         53 my @tables;
821 33         64 foreach my $table(@tables_work)
822             {
823 36         71 push(@tables,$self->getAliasTable($table,1));
824             }
825              
826             ## build sql command
827 33         102 my $sql = "SELECT ".join(", ",@fields)." FROM ".join(", ",@tables);
828 33 100       74 $sql .= " WHERE ".$where if ($where);
829 33 50       61 $sql .= " GROUP BY ".join(", ",@group_work) if (@group_work);
830 33 100       75 $sql .= " ORDER BY ".join(", ",@order) if (@order);
831 33 100 100     101 $sql .= " LIMIT ".$argv->{limit} if (defined($argv->{limit}) && $argv->{limit} > 0);
832              
833             ## execute
834             return SQL_SIMPLE_RC_ERROR if ($self->_Call(
835             command => $sql,
836             command_type => 0, # (ZERO is read)
837             buffer => $argv->{buffer},
838             buffer_options => $argv->{buffer_options},
839             buffer_hashkey => $argv->{buffer_hashkey},
840             buffer_arrayref => $argv->{buffer_arrayref},
841             buffer_fields => @fields+0,
842             make_only => $argv->{make_only},
843             flush => $argv->{flush},
844             sql_save => $argv->{sql_save},
845 33 50       225 ));
846 0 0       0 return SQL_SIMPLE_RC_OK if ($self->getRows());
847 0 0       0 return SQL_SIMPLE_RC_OK if ($argv->{notfound});
848              
849 0         0 $self->setMessage("select",SQL_SIMPLE_RC_SYNTAX,"012");
850 0         0 return SQL_SIMPLE_RC_EMPTY;
851             }
852              
853             sub _SelectOrderBy()
854             {
855 18     18   32 my $self = shift;
856 18         25 my $array = shift;
857 18         20 my $table = shift;
858 18         25 my $field = shift;
859 18         32 my $order = shift;
860              
861 18 100       69 if ($field =~ /^(.*?)\.(.*?)$/)
862             {
863 10         25 my $table = $1;
864 10         15 my $field = $2;
865 10         24 $field = $table.".".$self->getAliasCols($table,$field);
866             }
867 8         16 else { $field = $self->getAliasCols($table,$field); }
868              
869 18 100       41 if ($order)
870             {
871 13         31 $order = uc($order);
872 13 50       36 $field .= " ".(($order eq SQL_SIMPLE_ORDER_ASC) ? 'ASC' : ($order eq SQL_SIMPLE_ORDER_DESC) ? 'DESC' : 'USING '.$order);
    100          
873             }
874 18         28 push(@{$array},$field);
  18         63  
875             }
876              
877             ################################################################################
878             ## action: delete
879             ## return:
880             ## rc<0 syntax error
881             ## rc=0 successful
882             ## rc=1 sql error
883             ## rc=2 no selected found (no match where found)
884              
885             sub Delete()
886             {
887 2     2 1 3236 my $self = shift;
888 2         8 my $argv = {@_};
889              
890 2         8 $self->_Dumper("delete",$argv);
891 2         8 $self->setLastSQL("");
892 2 100       9 $self->Open() if (!defined($self->{init}{dbh}));
893              
894             ## define the command in load
895 2         9 $self->{init}{command} = "delete";
896              
897 2 50 33     15 if ($self->{init}{plugin_fh}->can('Delete') && $self->{init}{plugin_fh}->Delete($argv))
898             {
899 0         0 $self->setMessage("delete",SQL_SIMPLE_RC_SYNTAX,"037",$self->{argv}{interface},$self->{argv}{driver},$self->getMessage());
900 0         0 return SQL_SIMPLE_RC_SYNTAX;
901             }
902              
903 2 50       6 my $saved_commit = $self->setCommit($argv->{commit}) if (defined($argv->{commit}));
904 2 50       6 my $saved_message_log = $self->setLogMessage($argv->{message_log}) if (defined($argv->{message_log}));
905 2 50       5 my $saved_quote = $self->setQuote($argv->{quote}) if (defined($argv->{quote}));
906 2 50       6 my $saved_sql_save = $self->setSqlSave($argv->{sql_save}) if (defined($argv->{sql_save}));
907              
908 2         3 my $rc = $self->_Delete(%{$argv});
  2         23  
909              
910 2 50       11 $self->setCommit($saved_commit) if (defined($argv->{commit}));
911 2 50       5 $self->setMessgeLog($saved_message_log) if (defined($argv->{message_log}));
912 2 50       7 $self->setQuote($saved_quote) if (defined($argv->{quote}));
913 2 50       5 $self->setSqlSave($saved_sql_save) if (defined($argv->{sql_save}));
914              
915 2         7 return $rc;
916             }
917              
918             sub _Delete()
919             {
920 2     2   6 my $self = shift;
921 2         5 my $argv = {@_};
922              
923             ## check mandatory options
924 2 50 33     8 if (!defined($argv->{table}) && ref($argv->{table}) ne "")
925             {
926 0         0 $self->setMessage("delete",SQL_SIMPLE_RC_SYNTAX,"005");
927 0         0 return SQL_SIMPLE_RC_SYNTAX;
928             }
929             ## make where
930 2         3 my $where;
931 2 50       9 return SQL_SIMPLE_RC_SYNTAX if ($self->_getWhere("delete",[$argv->{table}],$argv->{where},\$where));
932 2 50 66     16 if ((!defined($where) || $where eq "") && !$argv->{force})
      66        
933             {
934 0         0 $self->setMessage("delete",SQL_SIMPLE_RC_SYNTAX,"016");
935 0         0 return SQL_SIMPLE_RC_SYNTAX;
936             }
937             ## build sql command
938 2         14 my $sql = "DELETE FROM ".$self->getAliasTable($argv->{table},0);
939 2 100       9 $sql .= " WHERE ".$where if ($where);
940              
941             return SQL_SIMPLE_RC_ERROR if ($self->_Call(
942             command => $sql,
943             command_type => 1, # (NOT_ZERO is update)
944             buffer => $argv->{buffer},
945             buffer_options => $argv->{buffer_options},
946             buffer_hashkey => $argv->{buffer_hashkey},
947             buffer_arrayref => $argv->{buffer_arrayref},
948             make_only => $argv->{make_only},
949             flush => $argv->{flush},
950             sql_save => $argv->{sql_save},
951 2 50       15 ));
952 0 0       0 return SQL_SIMPLE_RC_OK if ($argv->{notfound});
953 0 0       0 if ($self->getRows() == 0)
954             {
955 0         0 $self->setMessage("delete",SQL_SIMPLE_RC_SYNTAX,"012");
956 0         0 return SQL_SIMPLE_RC_EMPTY;
957             }
958 0         0 return SQL_SIMPLE_RC_OK;
959             }
960              
961             ################################################################################
962             ## action: insert
963             ## return:
964             ## rc<0 syntax error
965             ## rc=0 successful
966             ## rc=1 sql error
967             ## rc=2 no selected found (no match where found)
968              
969             sub Insert()
970             {
971 2     2 1 3435 my $self = shift;
972 2         9 my $argv = {@_};
973              
974 2         5 $self->_Dumper("insert",$argv);
975 2         10 $self->setLastSQL("");
976 2 50       9 $self->Open() if (!defined($self->{init}{dbh}));
977              
978             ## define the command in load
979 2         6 $self->{init}{command} = "insert";
980              
981 2 50 33     13 if ($self->{init}{plugin_fh}->can('Insert') && $self->{init}{plugin_fh}->Insert($argv))
982             {
983 0         0 $self->setMessage("insert",SQL_SIMPLE_RC_SYNTAX,"037",$self->{argv}{interface},$self->{argv}{driver},$self->getMessage());
984 0         0 return SQL_SIMPLE_RC_SYNTAX;
985             }
986              
987 2 50       9 my $saved_commit = $self->setCommit($argv->{commit}) if (defined($argv->{commit}));
988 2 50       5 my $saved_message_log = $self->setLogMessage($argv->{message_log}) if (defined($argv->{message_log}));
989 2 50       5 my $saved_quote = $self->setQuote($argv->{quote}) if (defined($argv->{quote}));
990 2 50       4 my $saved_sql_save = $self->setSqlSave($argv->{sql_save}) if (defined($argv->{sql_save}));
991              
992 2         5 my $rc = $self->_Insert(%{$argv});
  2         7  
993              
994 2 50       15 $self->setCommit($saved_commit) if (defined($argv->{commit}));
995 2 50       5 $self->setMessgeLog($saved_message_log) if (defined($argv->{message_log}));
996 2 50       5 $self->setQuote($saved_quote) if (defined($argv->{quote}));
997 2 50       12 $self->setSqlSave($saved_sql_save) if (defined($argv->{sql_save}));
998              
999 2         8 return $rc;
1000             }
1001              
1002             sub _Insert()
1003             {
1004 2     2   4 my $self = shift;
1005 2         6 my $argv = {@_};
1006              
1007             ## check mandatory options
1008 2 50 33     11 if (!defined($argv->{table}) && ref($argv->{table}) ne "")
1009             {
1010 0         0 $self->setMessage("insert",SQL_SIMPLE_RC_SYNTAX,"005");
1011 0         0 return SQL_SIMPLE_RC_SYNTAX;
1012             }
1013 2 50       6 if (!defined($argv->{fields}))
1014             {
1015 0         0 $self->setMessage("insert",SQL_SIMPLE_RC_SYNTAX,"017");
1016 0         0 return SQL_SIMPLE_RC_SYNTAX;
1017             }
1018 2 100       22 if (ref($argv->{fields}) eq "HASH") {}
    50          
1019             elsif (ref($argv->{fields}) eq "ARRAY")
1020             {
1021 1 50       3 if (!defined($argv->{values}))
1022             {
1023 0         0 $self->setMessage("insert",SQL_SIMPLE_RC_SYNTAX,"027");
1024 0         0 return SQL_SIMPLE_RC_SYNTAX;
1025             }
1026 1 50       5 if (ref($argv->{values}) ne "ARRAY")
1027             {
1028 0         0 $self->setMessage("insert",SQL_SIMPLE_RC_SYNTAX,"041");
1029 0         0 return SQL_SIMPLE_RC_SYNTAX;
1030             }
1031             }
1032             else
1033             {
1034 0         0 $self->setMessage("insert",SQL_SIMPLE_RC_SYNTAX,"018");
1035 0         0 return SQL_SIMPLE_RC_SYNTAX;
1036             }
1037 2 50 33     8 if (defined($argv->{conflict}) && ref($argv->{conflict}) ne "HASH")
1038             {
1039 0         0 $self->setMessage("insert",SQL_SIMPLE_RC_SYNTAX,"042");
1040 0         0 return SQL_SIMPLE_RC_SYNTAX;
1041             }
1042             ## making fields
1043 2         6 my @fields;
1044             my @values;
1045 2 100       8 if (ref($argv->{fields}) eq "HASH")
1046             {
1047 1         2 my @line;
1048 1         2 foreach my $field(sort(keys(%{$argv->{fields}})))
  1         7  
1049             {
1050 3         11 push(@fields,$self->getAliasCols($argv->{table},$field));
1051 3         7 push(@line,$argv->{fields}{$field});
1052             }
1053 1         13 push(@values,"(".$self->{argv}{quote}.join($self->{argv}{quote}.",".$self->{argv}{quote},@line).$self->{argv}{quote}.")");
1054             }
1055             else
1056             {
1057 1         3 my $no_fld = @{$argv->{fields}};
  1         3  
1058 1         2 foreach my $field(@{$argv->{fields}})
  1         3  
1059             {
1060 3         7 push(@fields,$self->getAliasCols($argv->{table},$field));
1061             }
1062 1         2 foreach my $values(@{$argv->{values}})
  1         4  
1063             {
1064 1 50       6 if ($no_fld == 1)
1065             {
1066 0 0       0 if (ref($values) eq "ARRAY")
1067             {
1068 0         0 push(@values,"(".$self->{argv}{quote}.join($self->{argv}{quote}."),(".$self->{argv}{quote},@{$values}).$self->{argv}{quote}.")");
  0         0  
1069             }
1070             else
1071             {
1072 0         0 push(@values,"(".$self->{argv}{quote}.$values.$self->{argv}{quote}.")");
1073             }
1074             }
1075             else
1076             {
1077 1 50       4 if (ref($values) eq "ARRAY")
1078             {
1079 0         0 push(@values,"(".$self->{argv}{quote}.join($self->{argv}{quote}.",".$self->{argv}{quote},@{$values}).$self->{argv}{quote}.")");
  0         0  
1080             }
1081             else
1082             {
1083 1         7 push(@values,"(".$self->{argv}{quote}.join($self->{argv}{quote}.",".$self->{argv}{quote},@{$argv->{values}}).$self->{argv}{quote}.")");
  1         5  
1084 1         18 goto EXIT_VALUES;
1085             }
1086             }
1087             }
1088             EXIT_VALUES:
1089 1         1 }
1090             ## build sql
1091 2         7 my $sql = "INSERT INTO ".$self->getAliasTable($argv->{table},0)." (".join(",",@fields).") VALUES ".join(",",@values);
1092 2 50       6 if (defined($argv->{conflict}))
1093             {
1094 0         0 my @conflict;
1095 0         0 foreach my $field(sort(keys(%{$argv->{conflict}})))
  0         0  
1096             {
1097             ($argv->{conflict}{$field} =~ /^\\(.*)/) ?
1098             push(@conflict,$self->getAliasCols($argv->{table},$field)." = ".$1):
1099 0 0       0 push(@conflict,$self->getAliasCols($argv->{table},$field)." = ".$self->{argv}{quote}.$argv->{conflict}{$field}.$self->{argv}{quote});
1100             }
1101             $sql .= ($self->{init}{plugin_id} =~ /^mysql/i || $self->{init}{plugin_id} =~ /^mariadb/i) ?
1102             " ON DUPLICATE KEY UPDATE ".join(", ",@conflict) :
1103 0 0 0     0 " ON CONFLICT ".(($argv->{conflict_key})?"(".$self->getAliasCols($argv->{table},$argv->{conflict_key}).") ":"")."DO UPDATE SET ".join(", ",@conflict);
    0          
1104             }
1105             ## execute
1106             return SQL_SIMPLE_RC_ERROR if ($self->_Call(
1107             command => $sql,
1108             command_type => 1, # (NOT_ZERO is update)
1109             buffer => $argv->{buffer},
1110             buffer_options => $argv->{buffer_options},
1111             buffer_hashkey => $argv->{buffer_hashkey},
1112             buffer_arrayref => $argv->{buffer_arrayref},
1113             make_only => $argv->{make_only},
1114             flush => $argv->{flush},
1115             sql_save => $argv->{sql_save},
1116 2 50       25 ));
1117 0         0 return SQL_SIMPLE_RC_OK;
1118             }
1119              
1120             ################################################################################
1121             ## action: update
1122             ## return:
1123             ## rc<0 syntax error
1124             ## rc=0 successful
1125             ## rc=1 sql error
1126             ## rc=2 no selected found (no match where found)
1127              
1128             sub Update()
1129             {
1130 2     2 1 3411 my $self = shift;
1131 2         9 my $argv = {@_};
1132              
1133 2         7 $self->_Dumper("update",$argv);
1134 2         5 $self->setLastSQL("");
1135 2 50       6 $self->Open() if (!defined($self->{init}{dbh}));
1136              
1137             ## define the command in load
1138 2         5 $self->{init}{command} = "update";
1139              
1140 2 50 33     14 if ($self->{init}{plugin_fh}->can('Update') && $self->{init}{plugin_fh}->Update($argv))
1141             {
1142 0         0 $self->setMessage("update",SQL_SIMPLE_RC_SYNTAX,"037",$self->{argv}{interface},$self->{argv}{driver},$self->getMessage());
1143 0         0 return SQL_SIMPLE_RC_SYNTAX;
1144             }
1145              
1146 2 50       5 my $saved_commit = $self->setCommit($argv->{commit}) if (defined($argv->{commit}));
1147 2 50       5 my $saved_message_log = $self->setLogMessage($argv->{message_log}) if (defined($argv->{message_log}));
1148 2 50       5 my $saved_quote = $self->setQuote($argv->{quote}) if (defined($argv->{quote}));
1149 2 50       5 my $saved_sql_save = $self->setSqlSave($argv->{sql_save}) if (defined($argv->{sql_save}));
1150              
1151 2         4 my $rc = $self->_Update(%{$argv});
  2         9  
1152              
1153 2 50       10 $self->setCommit($saved_commit) if (defined($argv->{commit}));
1154 2 50       5 $self->setMessgeLog($saved_message_log) if (defined($argv->{message_log}));
1155 2 50       7 $self->setQuote($saved_quote) if (defined($argv->{quote}));
1156 2 50       13 $self->setSqlSave($saved_sql_save) if (defined($argv->{sql_save}));
1157              
1158 2         8 return $rc;
1159             }
1160              
1161             sub _Update()
1162             {
1163 2     2   4 my $self = shift;
1164 2         5 my $argv = {@_};
1165              
1166             ## check mandatory options
1167 2 50 33     7 if (!defined($argv->{table}) && ref($argv->{table}) ne "")
1168             {
1169 0         0 $self->setMessage("update",SQL_SIMPLE_RC_SYNTAX,"005");
1170 0         0 return SQL_SIMPLE_RC_SYNTAX;
1171             }
1172 2 50       22 if (!defined($argv->{fields}))
1173             {
1174 0         0 $self->setMessage("update",SQL_SIMPLE_RC_SYNTAX,"017");
1175 0         0 return SQL_SIMPLE_RC_SYNTAX;
1176             }
1177 2 50       14 if (ref($argv->{fields}) ne "HASH")
1178             {
1179 0         0 $self->setMessage("update",SQL_SIMPLE_RC_SYNTAX,"018");
1180 0         0 return SQL_SIMPLE_RC_SYNTAX;
1181             }
1182             ## make fields
1183 2         5 my @fields;
1184 2         4 foreach my $field(keys(%{$argv->{fields}}))
  2         8  
1185             {
1186             ($argv->{fields}{$field} =~ /^\\(.*)/) ?
1187             push(@fields,$self->getAliasCols($argv->{table},$field)." = ".$1):
1188 3 100       20 push(@fields,$self->getAliasCols($argv->{table},$field)." = ".$self->{argv}{quote}.$argv->{fields}{$field}.$self->{argv}{quote});
1189             }
1190             ## make where
1191 2         4 my $where;
1192 2 50       8 return SQL_SIMPLE_RC_SYNTAX if ($self->_getWhere("update",[$argv->{table}],$argv->{where},\$where));
1193              
1194 2 50 66     16 if ((!defined($where) || $where eq "") && !$argv->{force})
      66        
1195             {
1196 0         0 $self->setMessage("update",SQL_SIMPLE_RC_SYNTAX,"016");
1197 0         0 return SQL_SIMPLE_RC_SYNTAX;
1198             }
1199             ## formata o sql
1200 2         14 my $sql = "UPDATE ".$self->getAliasTable($argv->{table},0)." SET ".join(", ",@fields);
1201 2 100       9 $sql .= " WHERE ".$where if ($where);
1202              
1203             ## execute
1204             return SQL_SIMPLE_RC_ERROR if ($self->_Call(
1205             command => $sql,
1206             command_type => 1, # (NOT_ZERO is update)
1207             buffer => $argv->{buffer},
1208             buffer_options => $argv->{buffer_options},
1209             buffer_hashkey => $argv->{buffer_hashkey},
1210             buffer_arrayref => $argv->{buffer_arrayref},
1211             make_only => $argv->{make_only},
1212             flush => $argv->{flush},
1213             sql_save => $argv->{sql_save},
1214 2 50       15 ));
1215 0 0       0 return SQL_SIMPLE_RC_OK if ($argv->{notfound});
1216 0 0       0 if ($self->getRows() == 0)
1217             {
1218 0         0 $self->setMessage("update",SQL_SIMPLE_RC_SYNTAX,"012");
1219 0         0 return SQL_SIMPLE_RC_EMPTY;
1220             }
1221 0         0 return SQL_SIMPLE_RC_OK;
1222             }
1223              
1224             ################################################################################
1225             ## action: wait db connect
1226             ## return:
1227             ## rc<0 syntax error
1228             ## rc=0 successful
1229             ## rc>0 sql command error
1230              
1231             sub Wait()
1232             {
1233 0     0 0 0 my $self = shift;
1234 0         0 my $argv= {@_};
1235              
1236 0         0 $self->_Dumper("wait",$argv);
1237              
1238 0 0       0 my $count = 1 if (!defined($argv->{count}));
1239 0 0       0 my $sleep = 5 if (!defined($argv->{interval}));
1240              
1241 0 0       0 return SQL_SIMPLE_RC_SYNTAX if ($count =~ /^\D+$/);
1242 0 0       0 return SQL_SIMPLE_RC_SYNTAX if ($sleep =~ /^\D+$/);
1243              
1244 0         0 while ($count-- > 0)
1245             {
1246 0 0       0 last if (!$self->Open());
1247              
1248 0 0 0     0 sleep($sleep) if ($count && $sleep);
1249             }
1250 0         0 return $self->getRC();
1251             }
1252              
1253             ################################################################################
1254             ## action: execute sql command
1255             ## return:
1256             ## rc<0 syntax error
1257             ## rc=0 successful
1258             ## rc>0 sql command error
1259             #
1260             ## callback example:
1261             ## sub myfunc()
1262             ## {
1263             ## my $ref = shift; # input field hash info
1264             ## my $options = shift; # options args
1265             ## return 0; # if ok to continue than return ZERO
1266             ## return 1; # if aboort needed than return NOT_ZERO
1267             ## }
1268              
1269             sub Call()
1270             {
1271 0     0 1 0 my $self = shift;
1272 0         0 my $argv = {@_};
1273              
1274 0         0 $self->_Dumper("call",$argv);
1275 0         0 $self->setLastSQL("");
1276 0 0       0 $self->Open() if (!defined($self->{init}{dbh}));
1277              
1278             ## define the command in load
1279 0         0 $self->{init}{command} = "call";
1280              
1281 0 0 0     0 if ($self->{init}{plugin_fh}->can('Call') && $self->{init}{plugin_fh}->Call($argv))
1282             {
1283 0         0 $self->setMessage("call",SQL_SIMPLE_RC_SYNTAX,"037",$self->{argv}{interface},$self->{argv}{driver},$self->getMessage());
1284 0         0 return SQL_SIMPLE_RC_SYNTAX;
1285             }
1286 0 0       0 if ($argv->{command} eq "")
1287             {
1288 0         0 $self->setMessage("call",SQL_SIMPLE_RC_SYNTAX,"023");
1289 0         0 return SQL_SIMPLE_RC_SYNTAX;
1290             }
1291              
1292 0 0       0 my $saved_commit = $self->setCommit($argv->{commit}) if (defined($argv->{commit}));
1293 0 0       0 my $saved_message_log = $self->setLogMessage($argv->{message_log}) if (defined($argv->{message_log}));
1294 0 0       0 my $saved_quote = $self->setQuote($argv->{quote}) if (defined($argv->{quote}));
1295 0 0       0 my $saved_sql_save = $self->setSqlSave($argv->{sql_save}) if (defined($argv->{sql_save}));
1296              
1297 0         0 my $rc = $self->_Call(%{$argv});
  0         0  
1298              
1299 0 0       0 $self->setCommit($saved_commit) if (defined($argv->{commit}));
1300 0 0       0 $self->setMessgeLog($saved_message_log) if (defined($argv->{message_log}));
1301 0 0       0 $self->setQuote($saved_quote) if (defined($argv->{quote}));
1302 0 0       0 $self->setSqlSave($saved_sql_save) if (defined($argv->{sql_save}));
1303              
1304 0         0 return $rc;
1305             }
1306              
1307             sub _Call()
1308             {
1309 39     39   95 my $self = shift;
1310 39         345 my $argv = {@_};
1311              
1312 39         128 $self->setLastSQL($argv->{command});
1313              
1314             ## save command (call-sql_save is prior that new-sql_save
1315 39 50 66     193 if ((defined($argv->{sql_save}) && $argv->{sql_save}) || (defined($self->{argv}{sql_save}) && $self->{argv}{sql_save} && $argv->{command_type}))
      66        
      33        
      66        
1316             {
1317 1 50       5 return SQL_SIMPLE_RC_ERROR if ($self->Save($argv->{command}));
1318             }
1319             ## return if makeonly
1320 39 50       329 return SQL_SIMPLE_RC_ERROR if ($argv->{make_only});
1321              
1322             ## mandatory
1323 0 0       0 if (!defined($self->{init}{dbh}))
1324             {
1325 0         0 $self->setMessage("call",SQL_SIMPLE_RC_SYNTAX,"022");
1326 0         0 return SQL_SIMPLE_RC_SYNTAX;
1327             }
1328 0 0 0     0 my $flush_buffer = (!defined($argv->{flush}) || $argv->{flush}) ? 1 : 0;
1329 0         0 my $type;
1330 0 0       0 if (!defined($argv->{buffer})) {}
    0          
1331             elsif (ref($argv->{buffer}) eq "HASH")
1332             {
1333 0 0       0 if (!defined($argv->{buffer_hashkey})) { $type=1; }
  0 0       0  
    0          
    0          
1334 0         0 elsif (ref($argv->{buffer_hashkey}) eq "ARRAY") { $type=6; }
1335 0         0 elsif (ref($argv->{buffer_hashkey}) eq "SCALAR") { $type=5; }
1336 0         0 elsif (ref($argv->{buffer_hashkey}) eq "") { $type=5; }
1337             else
1338             {
1339 0         0 $self->setMessage("call",SQL_SIMPLE_RC_SYNTAX,"046");
1340 0         0 return SQL_SIMPLE_RC_SYNTAX;
1341             }
1342 0 0       0 undef(%{$argv->{buffer}}) if ($flush_buffer);
  0         0  
1343             }
1344             else
1345             {
1346 0 0       0 if (ref($argv->{buffer}) eq "ARRAY")
    0          
    0          
1347             {
1348 0 0 0     0 if (defined($argv->{buffer_arrayref}) && !$argv->{buffer_arrayref})
1349             {
1350 0 0       0 if ($argv->{buffer_fields} != 1)
1351             {
1352 0         0 $self->setMessage("call",SQL_SIMPLE_RC_SYNTAX,"047");
1353 0         0 return SQL_SIMPLE_RC_SYNTAX;
1354             }
1355 0         0 $type=7;
1356             }
1357 0         0 else { $type=2; }
1358 0 0       0 undef(@{$argv->{buffer}}) if ($flush_buffer);
  0         0  
1359             }
1360 0         0 elsif (ref($argv->{buffer}) eq "CODE") { $type=3; }
1361 0         0 elsif (ref($argv->{buffer}) eq "SCALAR") { $type=4; }
1362             else
1363             {
1364 0         0 $self->setMessage("call",SQL_SIMPLE_RC_SYNTAX,"024");
1365 0         0 return SQL_SIMPLE_RC_SYNTAX;
1366             }
1367              
1368             ## test buffer_hashkey
1369 0 0       0 if (defined($argv->{buffer_hashkey}))
1370             {
1371 0         0 $self->setMessage("call",SQL_SIMPLE_RC_SYNTAX,"044");
1372 0         0 return SQL_SIMPLE_RC_SYNTAX;
1373             }
1374             }
1375              
1376             ## run-PreFetch if exists
1377 0 0 0     0 if ($self->{init}{plugin_fh}->can('PreFetch') && $self->{init}{plugin_fh}->PreFetch($argv))
1378             {
1379 0         0 $self->setMessage("prefetch",SQL_SIMPLE_RC_SYNTAX,"037",$self->{argv}{interface},$self->{argv}{driver},$self->getMessage());
1380 0         0 return SQL_SIMPLE_RC_SYNTAX;
1381             }
1382              
1383             ## prepare command
1384 0         0 $argv->{command} =~ s/^\s+|\s+$//;
1385 0 0       0 my $sth = $self->{init}{dbh}->prepare($argv->{command}.( ($argv->{command} =~ /\;$/) ? "":";") );
1386              
1387             ## execute command
1388 0 0       0 if (defined($sth))
1389             {
1390 0         0 $sth->execute(); # send command to run
1391 0         0 $self->setMessage("call"); # save the current status
1392              
1393             ## scan the fields
1394 0 0       0 if (defined($argv->{buffer}))
1395             {
1396 0 0       0 if ($sth->{NUM_OF_FIELDS})
1397             {
1398 0         0 while (my $ref = $sth->fetchrow_hashref())
1399             {
1400 0 0       0 if ($type == 1) { %{$argv->{buffer}} = %{$ref}; }
  0 0       0  
  0 0       0  
  0 0       0  
    0          
    0          
    0          
1401 0         0 elsif ($type == 2) { push(@{$argv->{buffer}},$ref); }
  0         0  
1402 0 0       0 elsif ($type == 3) { last if (&{$argv->{buffer}}($ref,$argv->{buffer_options})); }
  0         0  
1403 0         0 elsif ($type == 4) { foreach my $id(keys(%{$ref})) { ${$argv->{buffer}} = $ref->{$id}; }}
  0         0  
  0         0  
  0         0  
1404             elsif ($type == 5)
1405             {
1406 0 0       0 if (!defined($ref->{ $argv->{buffer_hashkey} }))
1407             {
1408 0         0 $self->setMessage("call",SQL_SIMPLE_RC_SYNTAX,"045");
1409 0         0 return SQL_SIMPLE_RC_SYNTAX;
1410             }
1411 0         0 my $val = $ref->{$argv->{buffer_hashkey}};
1412 0         0 delete($ref->{$argv->{buffer_hashkey}});
1413 0 0       0 $argv->{buffer}->{ $val } = ($argv->{buffer_fields} != 2) ? $ref : $ref->{ each(%{$ref}) };
  0         0  
1414             }
1415             elsif ($type == 6)
1416             {
1417 0         0 my $addr = $argv->{buffer};
1418 0         0 foreach my $key(@{$argv->{buffer_hashkey}})
  0         0  
1419             {
1420 0 0       0 if (!defined($ref->{$key}))
1421             {
1422 0         0 $self->setMessage("call",SQL_SIMPLE_RC_SYNTAX,"045");
1423 0         0 return SQL_SIMPLE_RC_SYNTAX;
1424             }
1425 0 0       0 $addr->{$ref->{$key}} = {} if (!defined($addr->{$ref->{$key}}));
1426 0         0 $addr = $addr->{$ref->{$key}};
1427 0         0 delete($ref->{$key});
1428             }
1429 0 0       0 %{$addr} = (keys(%{$ref}) != 1) ? %{$ref} : $ref->{ each(%{$ref}) };
  0         0  
  0         0  
  0         0  
  0         0  
1430             }
1431             elsif ($type == 7)
1432             {
1433 0         0 my @key = keys(%{$ref});
  0         0  
1434 0         0 push(@{$argv->{buffer}},$ref->{ $key[0] });
  0         0  
1435             }
1436             }
1437             }
1438             }
1439 0         0 $self->{init}{rows} = $sth->rows(); # get number of extracted lines
1440              
1441             ## close and commit (if need)
1442 0         0 $sth->finish();
1443             }
1444             else
1445             {
1446 0         0 $self->setMessage("call");
1447             }
1448 0         0 undef($sth);
1449              
1450             ## force commit if required
1451 0 0 0     0 $self->_Commit(%{$argv}) if ($self->{argv}->{commit} && $argv->{command_type});
  0         0  
1452 0         0 return $self->getRC();
1453             }
1454              
1455             ################################################################################
1456             ## action: commit command
1457             ## return:
1458             ## rc=0 successful
1459             ## rc>0 sql command error
1460              
1461             sub Commit()
1462             {
1463 0     0 0 0 my $self = shift;
1464 0         0 my $argv = {@_};
1465              
1466 0         0 $self->_Dumper("commit",$argv);
1467 0         0 $self->setLastSQL("");
1468              
1469 0 0       0 return SQL_SIMPLE_RC_OK if (!defined($self->{init}{dbh}));
1470 0         0 return $self->_Commit(%{$argv});
  0         0  
1471             }
1472              
1473             sub _Commit()
1474             {
1475 0     0   0 my $self = shift;
1476 0         0 my $argv = {@_};
1477              
1478             return $self->_Call(
1479             command => "commit",
1480             command_type => 0, # (ZERO to eliminate the LOOP)
1481             make_only => $argv->{make_only},
1482             flush => $argv->{flush},
1483             sql_save => $argv->{sql_save},
1484 0         0 );
1485             }
1486              
1487             ################################################################################
1488             ## action: disconnect database
1489             ## return:
1490             ## rc=0 successful
1491             ## rc>0 sql command error
1492              
1493             sub Close()
1494             {
1495 0     0 0 0 my $self = shift;
1496              
1497 0 0       0 return SQL_SIMPLE_RC_OK if (!defined($self->{init}{dbh}));
1498              
1499 0         0 my $rc = $self->{init}{dbh}->disconnect();
1500              
1501 0         0 $self->setMessage("close");
1502              
1503 0         0 undef($self->{init}{dbh});
1504              
1505 0         0 return $self->getRC();
1506             }
1507              
1508             ##############################################################################
1509             ## action: save the current sql command
1510             ## return:
1511             ## rc=0, successful
1512             ## rc=1, system error (mkdir/openfile)
1513              
1514             sub Save()
1515             {
1516 1     1 0 3 my $self = shift;
1517 1         3 my @sqls = @_;
1518              
1519 1         5 $self->_Dumper("save",\@sqls);
1520 1 50       7 $self->{init}{sql_save_ix} = 0 if (!defined($self->{init}{sql_save_ix}));
1521 1 50       5 $self->{init}{sql_save_name} = "sql" if (!defined($self->{init}{sql_save_name}));
1522             $self->{init}{sql_save_dir} =
1523             (defined($self->{argv}{sql_save_dir})) ? $self->{argv}{sql_save_dir} :
1524             ($^O ne 'MSWin32') ? File::Spec->catdir("","var","spool","sql") :
1525 1 0       7 File::Spec->catdir("","windows","temp") if (!defined($self->{init}{sql_save_dir}));
    50          
    50          
1526              
1527 1         836 require Date::Calc;
1528 1         6488 require File::Path;
1529 1         568 require IO::File;
1530              
1531 1         9481 my $today = sprintf("%04s%02s%02s",Date::Calc::Today());
1532             my $path = ($self->{argv}{sql_save_bydate}) ?
1533             File::Spec->catdir($self->{init}{sql_save_dir},substr($today,0,4),substr($today,0,6),$today) :
1534 1 50       29 $self->{init}{sql_save_dir};
1535              
1536 1 50       83 if (!stat($path))
1537             {
1538 1         4 eval { &File::Path::mkpath($path); };
  1         495  
1539 1 50       9 if ($@)
1540             {
1541 0         0 $self->setMessage("save",SQL_SIMPLE_RC_ERROR,"025",$@);
1542 0 0       0 return ($self->{argv}{sql_save_ignore}) ? SQL_SIMPLE_RC_OK : SQL_SIMPLE_RC_ERROR;
1543             }
1544             }
1545              
1546 1   50     52 $self->{init}{sql_save_logfile} = File::Spec->catpath("", $path,$self->{init}{sql_save_name}.".".($self->{argv}{db}||"public").".".$today.".".$$.".".(++$self->{init}{sql_save_ix}));
1547 1         41 my $fh = IO::File->new(">".$self->{init}{sql_save_logfile});
1548 1 50       141 if (!defined($fh))
1549             {
1550 0         0 $self->setMessage("save",SQL_SIMPLE_RC_ERROR,"026",$!);
1551 0 0       0 return ($self->{argv}{sql_save_ignore}) ? SQL_SIMPLE_RC_OK : SQL_SIMPLE_RC_ERROR;
1552             }
1553              
1554 1         28 print $fh join("\n",@sqls),"\n";
1555 1         58 close($fh);
1556 1         15 undef($fh);
1557 1         6 return SQL_SIMPLE_RC_OK;
1558             }
1559              
1560             ################################################################################
1561             ## action: where clause formater, used by: select, insert, delete, update
1562             ## return:
1563             ## rc<0 syntax error
1564             ## rc=0 successful
1565              
1566             sub getWhere()
1567             {
1568              
1569 33     33 1 30554 my $self = shift;
1570 33         96 my $argv = {@_};
1571              
1572             ## criar as regras de validacao da table, where, buffer.
1573             ## criar as regras de validacao da table, where, buffer.
1574             ## criar as regras de validacao da table, where, buffer.
1575              
1576 33         48 my @tables;
1577 33 100       104 if (ref($argv->{table}) eq "ARRAY"){ push(@tables,@{$argv->{table}}); }
  8 50       14  
  8         19  
1578 25         51 elsif (ref($argv->{table}) eq "") { push(@tables,$argv->{table}); }
1579             else
1580             {
1581 0         0 $self->setMessage("getWhere",SQL_SIMPLE_RC_SYNTAX,"006");
1582 0         0 return SQL_SIMPLE_RC_SYNTAX;
1583             }
1584              
1585 33         79 return $self->_getWhere("where",\@tables,$argv->{where},$argv->{buffer});
1586             }
1587              
1588             sub _getWhere()
1589             {
1590 70     70   107 my $self = shift;
1591 70         89 my $command = shift;
1592 70         92 my $tables = shift;
1593 70         107 my $where = shift;
1594 70         124 my $buffer = shift;
1595              
1596             ## return dummy where
1597 70 100       186 return SQL_SIMPLE_RC_OK if (!$where);
1598              
1599             ## format where
1600 47         68 my @where_local;
1601 47 50       108 return SQL_SIMPLE_RC_SYNTAX if ($self->_getWhereRecursive($command,0,$tables,$where,\@where_local));
1602              
1603             ## return the where clause
1604 47         92 ${$buffer} = join(" ",@where_local);
  47         95  
1605 47         145 return SQL_SIMPLE_RC_OK;
1606             }
1607              
1608             sub _getWhereRecursive()
1609             {
1610 53     53   108 my $self = shift;
1611 53         76 my $command = shift;
1612 53         67 my $level = shift;
1613 53         84 my $tables = shift;
1614 53         68 my $where = shift;
1615 53         69 my $buffer = shift;
1616              
1617             ## return error if argvs is empty, format error
1618 53 50       138 if ($where eq "")
1619             {
1620 0         0 $self->setMessage($command,SQL_SIMPLE_RC_SYNTAX,"020");
1621 0         0 return SQL_SIMPLE_RC_SYNTAX;
1622             }
1623 53 50       110 if (ref($where) eq "")
1624             {
1625 0         0 push(@{$buffer},$where);
  0         0  
1626 0         0 return 0;
1627             }
1628             ## return error if value1 is not array or value type
1629 53 50       104 if (ref($where) ne "ARRAY")
1630             {
1631 0         0 $self->setMessage($command,SQL_SIMPLE_RC_SYNTAX,"021");
1632 0         0 return SQL_SIMPLE_RC_SYNTAX;
1633             }
1634             ## format where
1635 53         63 my @where_tmp;
1636 53         79 my $oper_pend = 0;
1637 53         75 for (my $ix=0; $ix < @{$where};)
  137         309  
1638             {
1639 84         152 my $value1 = $where->[$ix++];
1640              
1641 84 100       157 if (ref($value1) ne "")
1642             {
1643 6         8 my @where_aux;
1644 6 50       46 return SQL_SIMPLE_RC_SYNTAX if ($self->_getWhereRecursive($command,$level+1,$tables,$value1,\@where_aux));
1645              
1646             ## valida se requer AND/OR
1647 6 100 66     20 push(@where_tmp,"AND") if ($oper_pend && @where_tmp);
1648             ## salva o where recursivo
1649 6         15 push(@where_tmp,join(" ",@where_aux));
1650 6         8 $oper_pend = 1;
1651 6         10 next;
1652             }
1653             ## check and/or logical connector
1654 78 100       272 if ($value1 =~ /^(and|\&\&|or|\|\|)$/i)
1655             {
1656 6         15 push(@where_tmp,uc($value1));
1657 6         9 $oper_pend = 0;
1658 6         10 next;
1659             }
1660             ## valida se requer AND/OR
1661 72 100 66     179 if ($oper_pend && @where_tmp)
1662             {
1663 17         30 push(@where_tmp,"AND");
1664 17         24 $oper_pend = 0;
1665             }
1666             ## convert value1 to realname if possible
1667 72 50 33     137 if ($value1 =~ /^\\/) {}
    100          
    50          
1668 72         195 elsif (@{$tables} == 1)
1669             {
1670 54         129 $value1 = $self->getAliasCols($tables->[0],$value1,0);
1671             }
1672 18         174 elsif ($value1 =~ /^(.*?)\.(.*?)$/ && grep(/^$1$/,@{$tables}))
1673             {
1674 18         46 $value1 = $self->getAliasCols($1,$2,1);
1675             }
1676             else
1677             {
1678 0         0 $value1 = $self->getAliasCols($tables->[0],$value1,0);
1679             }
1680 72 50       112 if ($ix >= @{$where})
  72         144  
1681             {
1682 0         0 push(@where_tmp,$value1);
1683 0         0 last;
1684             }
1685 72         124 my $value2 = $where->[$ix++];
1686 72         124 my $quote = $self->{argv}{quote};;
1687              
1688 72         94 $oper_pend = 1;
1689              
1690             ## value2 is array, multiple values
1691 72 100       149 if (ref($value2) eq "ARRAY")
1692             {
1693 34         50 my @_value2 = @{$value2};
  34         77  
1694 34         52 my $value2_b = "";
1695 34         52 my $value2_a = "";
1696 34         46 my $operator = $value2->[0];
1697 34         79 my $where_opr = "AND";
1698              
1699             ## value0 is escaped (not operator)
1700 34 50       199 if (!defined($operator)) { $operator = "="; }
  0 50       0  
    100          
    100          
    50          
    50          
    50          
    100          
    50          
    100          
    100          
    100          
    100          
    100          
    50          
    100          
    100          
    50          
1701 0         0 elsif ($operator =~ /^\\/) { $operator = "="; }
1702 4         5 elsif ($operator eq "=") { shift(@_value2); }
1703 12         17 elsif ($operator eq "!") { shift(@_value2); $operator = "!="; }
  12         19  
1704 0         0 elsif ($operator eq "!=") { shift(@_value2); $operator = "!="; }
  0         0  
1705 0         0 elsif ($operator eq "<>") { shift(@_value2); $operator = "!="; }
  0         0  
1706 0         0 elsif ($operator eq "<=") { shift(@_value2); }
1707 2         5 elsif ($operator eq "<") { shift(@_value2); }
1708 0         0 elsif ($operator eq ">=") { shift(@_value2); }
1709 3         7 elsif ($operator eq ">") { shift(@_value2); }
1710 1 50       2 elsif ($operator eq "%%") { shift(@_value2); $operator = "LIKE"; $value2_b = "%"; $value2_a = "%"; $where_opr = "OR" if (@_value2 > 1); }
  1         3  
  1         2  
  1         1  
  1         13  
1711 2 100       4 elsif ($operator eq "^%") { shift(@_value2); $operator = "LIKE"; $value2_b = "%"; $where_opr = "OR" if (@_value2 > 1); }
  2         3  
  2         3  
  2         6  
1712 2 100       3 elsif ($operator eq "%^") { shift(@_value2); $operator = "LIKE"; $value2_a = "%"; $where_opr = "OR" if (@_value2 > 1); }
  2         4  
  2         3  
  2         5  
1713 1 50       3 elsif ($operator eq "^^") { shift(@_value2); $operator = "LIKE"; $where_opr = "OR" if (@_value2 > 1); }
  1         1  
  1         4  
1714 0         0 elsif ($operator eq "!%%") { shift(@_value2); $operator = "NOT LIKE"; $value2_b = "%"; $value2_a = "%"; }
  0         0  
  0         0  
  0         0  
1715 2         3 elsif ($operator eq "!^%") { shift(@_value2); $operator = "NOT LIKE"; $value2_b = "%"; }
  2         4  
  2         3  
1716 2         3 elsif ($operator eq "!%^") { shift(@_value2); $operator = "NOT LIKE"; $value2_a = "%"; }
  2         4  
  2         2  
1717 0         0 elsif ($operator eq "!^^") { shift(@_value2); $operator = "NOT LIKE"; }
  0         0  
1718 3         6 else { $operator = "="; }
1719              
1720             ## construct condition
1721 34 100 100     129 if ($operator eq "=" || $operator eq "!=")
1722             {
1723 19 100       48 if (@_value2 > 1)
1724             {
1725 5 100       11 my $not = ($operator eq "!=") ? " NOT" : "";
1726 5 100 66     31 (@_value2 == 3 && $_value2[1] eq "..") ?
1727             push(@where_tmp,$value1.$not." BETWEEN (".$quote.$_value2[0].$quote.",".$quote.$_value2[2].$quote.")") :
1728             push(@where_tmp,$value1.$not." IN (".$quote.join("$quote,$quote",@_value2).$quote.")");
1729 5         16 next;
1730             }
1731             }
1732             ## multiple conditions
1733 29         37 my @where_aux;
1734 29         57 foreach my $value(@_value2)
1735             {
1736 35 100 66     121 if (defined($value) && $value ne "")
    50          
1737             {
1738 33 100 66     66 if ($value =~ /^\\(.*)/)
    100          
    100          
1739             {
1740 1         6 push(@where_tmp,$value1." ".$operator." ".$1);
1741             }
1742 32         84 elsif (@{$tables} == 1)
1743             {
1744 24         77 push(@where_aux,$value1." ".$operator." ".$quote.$value2_a.$value.$value2_b.$quote);
1745             }
1746 6         81 elsif ($value =~ /^(.*?)\.(.*?)$/ && grep(/^$1$/,@{$tables}))
1747             {
1748 6         15 my $_value = $self->getAliasCols($1,$2,1);
1749 6         22 push(@where_aux,$value1." ".$operator." ".$_value);
1750             }
1751             else
1752             {
1753 2         9 push(@where_aux,$value1." ".$operator." ".$quote.$value2_a.$value.$value2_b.$quote);
1754             }
1755             }
1756             elsif ($operator eq "=")
1757             {
1758 0         0 push(@where_aux,$value1." IS NULL");
1759             }
1760             else
1761             {
1762 2         6 push(@where_aux,$value1." NOT NULL");
1763             }
1764             }
1765 29 100       68 if (@where_aux > 1)
1766             {
1767 6         12 $where_aux[0] = "(".$where_aux[0];
1768 6         13 $where_aux[@where_aux-1] .= ")";
1769             }
1770 29 100       99 push(@where_tmp,join(" ".$where_opr." ",@where_aux)) if (@where_aux);
1771 29         79 next;
1772             }
1773             ## value2 is single value
1774 38 100       72 if (!defined($value2))
1775             {
1776 2         8 push(@where_tmp,$value1." IS NULL");
1777 2         4 next;
1778             }
1779 36 50       69 if (ref($value2) eq "")
1780             {
1781 36 50       72 if ($value2 ne "")
1782             {
1783 36 100 33     82 if ($value2 =~ /^\\(.*)/)
    100          
    50          
1784             {
1785 2         11 push(@where_tmp,$value1." = ".$1);
1786             }
1787 34         89 elsif (@{$tables} == 1)
1788             {
1789 25         65 push(@where_tmp,$value1." = ".$quote.$value2.$quote);
1790             }
1791 9         134 elsif ($value2 =~ /^(.*?)\.(.*?)$/ && grep(/^$1$/,@{$tables}))
1792             {
1793 9         28 my $_value2 = $self->getAliasCols($1,$2,1);
1794 9         26 push(@where_tmp,$value1." = ".$_value2);
1795             }
1796 0         0 else { push(@where_tmp,$value1." = ".$quote.$value2.$quote); }
1797             }
1798 0         0 else { push(@where_tmp,$value1." IS NULL"); }
1799 36         70 next;
1800             }
1801              
1802             ## return error if value2 is not array or value type
1803 0         0 $self->setMessage($command,SQL_SIMPLE_RC_SYNTAX,"028");
1804 0         0 return SQL_SIMPLE_RC_SYNTAX;
1805             }
1806 53 50       112 if (@where_tmp)
1807             {
1808 53         66 push(@{$buffer},join(" ",@where_tmp));
  53         127  
1809 53 100       108 $buffer->[0] = "(".$buffer->[0] if ($level);
1810 53         93 my $n = @{$buffer};
  53         82  
1811 53 100       113 $buffer->[$n-1] .= ")" if ($level);
1812             }
1813 53         141 return 0;
1814             }
1815              
1816             ##############################################################################
1817             ## action: get dbh entry point module
1818             ## return: current dbi drive pointer module
1819              
1820             sub getDBH()
1821             {
1822 0     0 1 0 return $_[0]->{init}{dbh};
1823             }
1824              
1825             ##############################################################################
1826             ## action: get last condition state
1827             ## return: last return code state
1828              
1829             sub getRC()
1830             {
1831 40     40 1 145 return $err;
1832             }
1833              
1834             ##############################################################################
1835             ## action: get last message state
1836             ## return: last system message
1837              
1838             sub getMessage()
1839             {
1840 0     0 1 0 return $errstr;
1841             }
1842              
1843             ##############################################################################
1844             ## action: get number of extracted lines
1845             ## return: number of extracted lines
1846              
1847             sub getRows()
1848             {
1849 0     0 1 0 return $_[0]->{init}{rows};
1850             }
1851              
1852             ##############################################################################
1853             ## action: get the last sql command
1854             ## return: last sql command
1855              
1856             sub getLastSQL()
1857             {
1858 39     39 1 204 return $_[0]->{init}{sql_command};
1859             }
1860              
1861             ##############################################################################
1862             ## action: get the last cursor pointer
1863             ## return: cursor pointer
1864              
1865             sub getLastCursor()
1866             {
1867 0     0 1 0 my $self = shift;
1868 0         0 return %{$self->{init}{cursor}};
  0         0  
1869             }
1870              
1871             ##############################################################################
1872             ## action: get the last saved fileset
1873             ## return: last sql logfile
1874              
1875             sub getLastSave()
1876             {
1877 1     1 1 726 return $_[0]->{init}{sql_save_logfile};
1878             }
1879              
1880             ##############################################################################
1881             ## action: get the table's realname
1882             ## return: name of the table
1883              
1884             sub getAliasTable()
1885             {
1886 42     42 1 62 my $self = shift;
1887 42         60 my $table = shift;
1888 42         61 my $ident = shift;
1889              
1890 42 50 33     136 my $schema = ($self->{init}{schema} && defined($self->{argv}{schema}) && $self->{argv}{schema} ne "") ? $self->{argv}{schema}."." : "";
1891              
1892             return (!defined($self->{argv}{tables}) ||
1893             !defined($self->{argv}{tables}{$table}) ||
1894             !defined($self->{argv}{tables}{$table}{name}) ||
1895             $self->{argv}{tables}{$table}{name} eq $table) ?
1896             $schema.$table :
1897             ($ident) ?
1898             $schema.$self->{argv}{tables}{$table}{name}." ".$table :
1899 42 0 33     221 $schema.$self->{argv}{tables}{$table}{name};
    50          
1900             }
1901              
1902             ##############################################################################
1903             ## action: get the table's realname
1904             ## return: name of the table
1905              
1906             sub getAliasCols()
1907             {
1908 166     166 1 241 my $self = shift;
1909 166         231 my $table = shift;
1910 166         230 my $field = shift;
1911 166         213 my $notab = shift;
1912              
1913             return (!defined($self->{argv}{tables}) ||
1914             !defined($self->{argv}{tables}{$table}) ||
1915             !defined($self->{argv}{tables}{$table}{cols}) ||
1916             !defined($self->{argv}{tables}{$table}{cols}{$field})) ?
1917             (($notab) ? $table.".".$field : $field) :
1918 166 100 0     654 (($notab) ? $table.".".$self->{argv}{tables}{$table}{cols}{$field} : $self->{argv}{tables}{$table}{cols}{$field});
    0          
    50          
1919             }
1920              
1921             ################################################################################
1922             ## action: set last command sql
1923             ## return: none
1924              
1925             sub setLastSQL()
1926             {
1927 78     78 0 166 $_[0]->{init}{sql_command} = $_[1];
1928             }
1929              
1930             ################################################################################
1931             ## action: set commit
1932             ## return: old commit
1933              
1934             sub setCommit()
1935             {
1936 0     0 0 0 my $self = shift;
1937 0         0 my $save = $self->{argv}{commit};
1938 0   0     0 $self->{argv}{commit} = shift || 0;
1939 0         0 return $save;
1940             }
1941              
1942             ################################################################################
1943             ## action: set message_log
1944             ## return: old message_log
1945              
1946             sub setLogMessage()
1947             {
1948 0     0 0 0 my $self = shift;
1949 0         0 my $save = $self->{argv}{message_log};
1950 0   0     0 $self->{argv}{message_log} = shift || 0 ;
1951 0         0 return $save;
1952             }
1953              
1954             ################################################################################
1955             ## action: set sql_save
1956             ## return: old sql_save
1957              
1958             sub setSqlSave()
1959             {
1960 2     2 0 4 my $self = shift;
1961 2         15 my $save = $self->{argv}{sql_save};
1962 2   100     12 $self->{argv}{sql_save} = shift || 0;
1963 2         5 return $save;
1964             }
1965              
1966             ################################################################################
1967             ## action: set quote character
1968             ## return: old quote chacracter
1969              
1970             sub setQuote()
1971             {
1972 0     0 0 0 my $self = shift;
1973 0         0 my $quote = shift;
1974 0         0 my $save = $self->{argv}{quote};
1975 0 0 0     0 $self->{argv}{quote} = $quote || "'" if ($quote eq "" || $quote eq '"' || $quote eq "'");
      0        
      0        
1976 0         0 return $save;
1977             }
1978              
1979             ################################################################################
1980             ## action: set message state
1981             ## return: return code
1982              
1983             sub setMessage()
1984             {
1985 1     1 0 4 my $self = shift;
1986 1         8 my $command = shift;
1987 1         3 my $rc = shift;
1988 1         17 my $code = shift;
1989 1         5 my @argv = @_;
1990              
1991 1 50       5 if (!defined($rc))
1992             {
1993 1 50 33     29 return $self->setMessage($command,$self->{init}{dbh}->err+0,"099",$self->{init}{dbh}->errstr()) if (defined($self->{init}{dbh}) && $self->{init}{dbh}->err);
1994 1 50       8 return $self->setMessage($command,$DBI::err+0,"099",$DBI::errstr) if ($DBI::err);
1995              
1996 1         4 $err = 0;
1997 1         2 $errstr = "";
1998 1         4 return $err;
1999             }
2000              
2001 0         0 $err = $rc;
2002             $errstr = (defined($SQL_SIMPLE_TABLE_OF_MSGS{$code})) ?
2003 0 0       0 $code.$SQL_SIMPLE_TABLE_OF_MSGS{$code}{T}." ".sprintf($SQL_SIMPLE_TABLE_OF_MSGS{$code}{M},$command,@argv) :
2004             "999S [message] invalid message code '$code'";
2005              
2006 0 0       0 if ($self->{argv}{message_log})
2007             {
2008 0 0       0 print STDERR $errstr."\n" if ($self->{argv}{message_log} & SQL_SIMPLE_LOG_STD);
2009              
2010 0 0       0 if ($self->{argv}{message_log} & SQL_SIMPLE_LOG_SYS)
2011             {
2012 0         0 require Sys::Syslog;
2013 0   0     0 openlog($self->{argv}{message_syslog_service} || "SQL-SimpleOps", "ndelay,pid", $self->{argv}{message_syslog_facility} || "local0");
      0        
2014             syslog(
2015             ($SQL_SIMPLE_TABLE_OF_MSGS{$code}{T} eq "E") ? "error" :
2016             ($SQL_SIMPLE_TABLE_OF_MSGS{$code}{T} eq "S") ? "error" :
2017 0 0       0 ($SQL_SIMPLE_TABLE_OF_MSGS{$code}{T} eq "W") ? "warning" :
    0          
    0          
2018             "info",
2019             $errstr
2020             );
2021 0         0 closelog();
2022             }
2023             }
2024 0         0 return $err;
2025             }
2026              
2027             ################################################################################
2028             ## action: enable/disable show dumper data at each call
2029             ## note: used for debug mode only.
2030              
2031             sub setDumper()
2032             {
2033 0     0 1 0 my $self = shift;
2034 0         0 return $self->{init}{dumper} = shift;
2035             }
2036              
2037             sub _Dumper()
2038             {
2039 40     40   60 my $self = shift;
2040 40         62 my $call = shift;
2041 40         69 my $argv = shift;
2042              
2043 40 50       119 return if (!$self->{init}{dumper});
2044              
2045 0           require Data::Dumper;
2046 0     0     $Data::Dumper::Sortkeys = \sub { my ($hash) = @_; return [ (sort keys %$hash) ]; };
  0            
  0            
2047              
2048 0           my $dumper = new Data::Dumper([$argv]);
2049              
2050 0           $dumper->Terse(1);
2051              
2052 0           print STDERR $call." = ".$dumper->Dump;
2053             }
2054              
2055             __END__