File Coverage

blib/lib/SQL/SimpleOps.pm
Criterion Covered Total %
statement 606 952 63.6
branch 325 662 49.0
condition 69 185 37.3
subroutine 54 66 81.8
pod 17 28 60.7
total 1071 1893 56.5


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