File Coverage

lib/CGI/OptimalQuery/SaveSearchTool.pm
Criterion Covered Total %
statement 18 374 4.8
branch 0 230 0.0
condition 0 113 0.0
subroutine 6 16 37.5
pod 0 9 0.0
total 24 742 3.2


line stmt bran cond sub pod time code
1             package CGI::OptimalQuery::SaveSearchTool;
2              
3 1     1   3 use strict;
  1         14  
  1         24  
4 1     1   3 use POSIX qw/strftime/;
  1         0  
  1         4  
5 1     1   831 use Data::Dumper;
  1         1  
  1         40  
6 1     1   474 use Mail::Sendmail();
  1         8963  
  1         20  
7 1     1   4 use CGI qw( escapeHTML );
  1         1  
  1         5  
8 1     1   79 use JSON::XS;
  1         1  
  1         3500  
9              
10             # save a reference to the current saved save that is running via crontab right now
11             our $current_saved_search;
12              
13             # this is called from Base constructor
14             sub on_init {
15 0     0 0   my ($o) = @_;
16              
17             # adjust config if a saved search alert is running via cron right now
18             # unable to set these earlier because we dont have a constructed OQ yet
19 0   0       $$o{schema}{savedSearchAlertMaxRecs} ||= 1000;
20 0   0       $$o{schema}{savedSearchAlertEmailCharLimit} ||= 500000;
21              
22             # one more to detect overflow
23 0 0         $$o{q}->param('rows_page', $$o{schema}{savedSearchAlertMaxRecs} + 1) if $current_saved_search;
24              
25             # request to save a search?
26 0 0         if ($$o{q}->param('OQsaveSearchTitle') ne '') {
27              
28 0           eval {
29             # serialize params
30 0           my $params;
31 0           { my %data;
  0            
32 0           foreach my $p (qw( show filter sort rows_page queryDescr hiddenFilter )) {
33 0           $data{$p} = $$o{q}->param($p);
34             }
35 0 0 0       delete $data{rows_page} unless $data{rows_page} eq 'All' || $data{rows_page} > 25;
36 0 0         if (ref($$o{schema}{state_params}) eq 'ARRAY') {
37 0           foreach my $p (@{ $$o{schema}{state_params} }) {
  0            
38 0           my @v = $$o{q}->param($p);
39 0           $data{$p} = \@v;
40             }
41             }
42            
43 0           local $Data::Dumper::Indent = 0;
44 0           local $Data::Dumper::Quotekeys = 0;
45 0           local $Data::Dumper::Pair = '=>';
46 0           local $Data::Dumper::Sortkeys = 1;
47 0           $params = Dumper(\%data);
48 0           $params =~ s/^[^\{]+\{//;
49 0           $params =~ s/\}\;\s*$//;
50             }
51            
52 0           $$o{q}->param('queryDescr', $$o{q}->param('OQsaveSearchTitle'));
53            
54             my %rec = (
55             user_id => $$o{schema}{savedSearchUserID},
56             uri => $$o{schema}{URI},
57             oq_title => $$o{schema}{title},
58 0           user_title => $$o{q}->param('OQsaveSearchTitle'),
59             params => $params
60             );
61            
62             # does the user want to set this as the default search, and if so do they have permission
63 0 0 0       if($$o{schema}{canSaveDefaultSearches} && defined $$o{q}->param('save_search_default')) {
64 0   0       $rec{is_default} = $$o{q}->param('save_search_default') || 0;
65             }
66              
67             # is saved search alerts enabled
68 0 0         if ($$o{schema}{savedSearchAlerts}) {
69 0   0       $rec{alert_mask} = $$o{q}->param('alert_mask') || 0;
70             }
71              
72             # if user enabled search search alerts
73 0 0         if ($rec{alert_mask}) {
74 0           $rec{alert_interval_min} = $$o{q}->param('alert_interval_min');
75 0           $rec{alert_dow} = $$o{q}->param('alert_dow');
76 0           $rec{alert_start_hour} = $$o{q}->param('alert_start_hour');
77 0           $rec{alert_end_hour} = $$o{q}->param('alert_end_hour');
78 0           $rec{alert_last_dt} = [get_sysdate_sql($$o{dbh})];
79            
80             # get starting alert_uids
81 0           my @uids;
82             my $sth = $$o{oq}->prepare(
83             show => ['UID'],
84             filter => scalar($$o{q}->param('filter')),
85             forceFilter => $$o{schema}{forceFilter},
86 0           hiddenFilter => scalar($$o{q}->param('hiddenFilter'))
87             );
88              
89 0           $sth->execute(limit => [1, $$o{schema}{savedSearchAlertMaxRecs} + 1]);
90 0           while (my $h = $sth->fetchrow_hashref()) {
91 0           push @uids, $$h{U_ID};
92             }
93 0 0         die "MAX_ROWS_EXCEEDED - your report contains too many rows to send alerts via email. Reduce the total row count of your report by adding additional filters." if scalar(@uids) > $$o{schema}{savedSearchAlertMaxRecs};
94 0           $rec{alert_uids} = join('~', @uids);
95             }
96            
97             # save saved search to db
98 0           my $is_update=0;
99 0 0         if ($$o{q}->param('OQss') ne '') {
100 0           my $id = scalar($$o{q}->param('OQss'));
101 0           ($is_update) = $$o{dbh}->selectrow_array("SELECT 1 FROM oq_saved_search WHERE id=? AND user_id=?", undef, $id, $rec{user_id});
102 0 0         if ($is_update) {
103 0           my (@cols,@binds);
104 0           while (my ($col,$val) = each %rec) {
105 0 0         if (ref($val) eq 'ARRAY') {
106 0           my ($sql,@rest) = @$val;
107 0           push @cols, "$col=$sql";
108 0 0         push @binds, map { $_ eq '' ? undef : $_ } @rest;
  0            
109             } else {
110 0           push @cols, "$col=?";
111 0 0         push @binds, ($val eq '') ? undef : $val;
112             }
113             }
114 0           push @binds, $id;
115 0           $$o{dbh}->do("UPDATE oq_saved_search SET ".join(',', @cols)." WHERE id=?", undef, @binds);
116 0           $rec{id} = $id;
117             }
118             }
119 0 0         if (! $is_update) {
120 0 0         ($rec{id}) = $$o{dbh}->selectrow_array("SELECT s_oq_saved_search.nextval FROM dual") if $$o{dbh}{Driver}{Name} eq 'Oracle';
121 0           my (@cols,@vals,@binds);
122 0           while (my ($col,$val) = each %rec) {
123 0           push @cols, $col;
124 0 0         if (ref($val) eq 'ARRAY') {
125 0           my ($sql,@rest) = @$val;
126 0           push @vals, $sql;
127 0 0         push @binds, map { $_ eq '' ? undef : $_ } @rest;
  0            
128             } else {
129 0           push @vals, '?';
130 0 0         push @binds, ($val eq '') ? undef : $val;
131             }
132             }
133 0           $$o{dbh}->do("INSERT INTO oq_saved_search (".join(',',@cols).") VALUES (".join(',',@vals).")", undef, @binds);
134 0   0       $rec{id} ||= $$o{dbh}->last_insert_id("","","","");
135             }
136            
137             # ensure only one possible default saved search
138 0           eval {
139 0 0 0       if($$o{schema}{canSaveDefaultSearches} && $rec{is_default}) {
140 0           my $stmt = $$o{dbh}->prepare('UPDATE oq_saved_search SET is_default = 0 WHERE id <> ? AND uri = ?');
141 0           $stmt->execute($rec{id}, $rec{uri});
142             }
143 0 0         }; if($@) {}
144            
145 0           $$o{output_handler}->(CGI::header('application/json').encode_json({ status => "ok", msg => "search saved successfully", id => $rec{id} }));
146 0 0         }; if ($@) {
147 0           my $err = $@;
148 0           $err =~ s/\ at\ .*//;
149              
150 0 0 0       if ($err =~ /unique\ constraint/i ||
      0        
      0        
      0        
      0        
151             $err =~ /duplicate\ entry/i ||
152             $err =~ /unique\_violation/i ||
153             $err =~ /unique\ key/i ||
154             $err =~ /duplicate\ key/i ||
155             $err =~ /constraint\_unique/i) {
156 0           $err = 'Another record with this name already exists.';
157             }
158              
159 0           $$o{output_handler}->(CGI::header('application/json').encode_json({ status => "error", msg => $err }));
160             }
161 0           return undef;
162             }
163             }
164              
165              
166             sub on_open {
167 0     0 0   my ($o) = @_;
168 0           my $buf;
169              
170             # if saved search alerts are enabled
171 0 0         if ($$o{schema}{savedSearchAlerts}) {
172 0           my $rec;
173 0 0         if ($$o{q}->param('OQss') ne '') {
174 0           $rec = $$o{dbh}->selectrow_hashref("SELECT USER_TITLE,ALERT_MASK,ALERT_INTERVAL_MIN,ALERT_DOW,ALERT_START_HOUR,ALERT_END_HOUR FROM oq_saved_search WHERE id=? AND user_id=?", undef, scalar($$o{q}->param('OQss')), $$o{schema}{savedSearchUserID});
175             }
176 0   0       $rec ||= {};
177 0 0         my $alerts_enabled = ($$rec{ALERT_MASK} > 0) ? 1 : 0;
178 0   0       $$rec{ALERT_MASK} ||= 1;
179 0   0       $$rec{ALERT_INTERVAL_MIN} ||= 1440;
180 0   0       $$rec{ALERT_DOW} ||= '12345';
181 0   0       $$rec{ALERT_START_HOUR} ||= 8;
182 0   0       $$rec{ALERT_END_HOUR} ||= 17;
183              
184 0 0         if ($$rec{ALERT_START_HOUR} > 12) {
185 0           $$rec{ALERT_START_HOUR} = ($$rec{ALERT_START_HOUR} - 12).'PM';
186             } else {
187 0           $$rec{ALERT_START_HOUR} .= 'AM';
188             }
189 0 0         if ($$rec{ALERT_END_HOUR} > 12) {
190 0           $$rec{ALERT_END_HOUR} = ($$rec{ALERT_END_HOUR} - 12).'PM';
191             } else {
192 0           $$rec{ALERT_END_HOUR} .= 'AM';
193             }
194              
195             $buf .= "
196            
197            
198            
199              
200            

201            
202            
203            
204            
205            
206            

207            
208             (1440 min per day)
209              
210            

211            
212            
213            
214            
215            
216            
217            
218            
219              
220            

221 0 0        
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
222            

Notice: This tool sends automatic alerts over insecure email. By creating an alert you acknowledge that the fields in the report will never contain sensitive data. Alerts are automatically disabled when the count exceeds $$o{schema}{savedSearchAlertMaxRecs}.

223             ";
224             }
225             else {
226 0           my $rec;
227 0 0         if ($$o{q}->param('OQss') ne '') {
228 0           $rec = $$o{dbh}->selectrow_hashref("SELECT USER_TITLE FROM oq_saved_search WHERE id=? AND user_id=?", undef, scalar($$o{q}->param('OQss')), $$o{schema}{savedSearchUserID});
229             }
230 0   0       $rec ||= {};
231             $buf .= "
232 0           ";
233             }
234              
235             # include checkbox to allow user to set saved search as the default settings
236 0 0         if($$o{schema}{canSaveDefaultSearches}) {
237 0           my ($is_default_ss) = $$o{dbh}->selectrow_array("SELECT is_default FROM oq_saved_search WHERE id=? AND user_id=?", undef, scalar($$o{q}->param('OQss')), $$o{schema}{savedSearchUserID});
238 0 0         $buf .= "";
239             }
240              
241 0           $buf .= "

";

242 0 0         $buf .= "" if $$o{q}->param('OQss') ne '';
243 0           $buf .= "";
244            
245 0           return $buf;
246             }
247              
248             sub activate {
249 0     0 0   my ($o) = @_;
250             $$o{schema}{tools}{savereport} ||= {
251 0   0       title => "Save Report",
252             on_init => \&on_init,
253             on_open => \&on_open
254             };
255             }
256              
257              
258             # this function is called from a cron to help execute saved searches that have alerts that need to be checked
259             # Note: this custom output handler does not print anything as normal output handlers do.
260             # This output handler insteads updates the $current_saved_search
261             # it discovers which uids have been added, deleted, or are still present for a saved search.
262             # this information is then used by the [arent caller (execute_saved_search_alerts) to send out alert emails
263             sub custom_output_handler {
264 0     0 0   my ($o) = @_;
265             # verify that a proper email_to was defined
266 0 0         die "missing email_to" if $$current_saved_search{email_to} eq '';
267              
268 0           my %opts;
269 0 0         if (exists $$o{schema}{options}{__PACKAGE__}) {
    0          
270 0           %opts = %{$$o{schema}{options}{__PACKAGE__}};
  0            
271             } elsif (exists $$o{schema}{options}{'CGI::OptimalQuery::InteractiveQuery'}) {
272 0           %opts = %{$$o{schema}{options}{'CGI::OptimalQuery::InteractiveQuery'}};
  0            
273             }
274 0           my %noEsc = map { $_ => 1 } @{ $opts{noEscapeCol} };
  0            
  0            
275              
276              
277             # fetch all records in the report
278             # update the uids hash
279             # $$current_saved_search{uids}{} => 1-deleted, 2-seen before, 3-first time seen
280             # Before this block all values for previously seen uids are 1
281             # if the uid was previously seen and then seen again, we'll mark it with a 2
282             # if it was not previously seen, and we see it now, we'll mark it with a 3
283             # at the end of processing all previously found uids that weren't seen will still be marked 1
284             # which indicates the record is no longer within the report
285 0           my $cnt = 0;
286 0           my $dataTruc = 0;
287 0           my $row_cnt = 0;
288 0           my $buf;
289 0           { my $filter = $o->get_filter();
  0            
290             $buf .= "

Query: "

291 0 0         .escapeHTML($$o{queryDescr}) if $$o{queryDescr};
292 0 0         $buf .= "

Filter: "

293             .escapeHTML($filter) if $filter;
294 0           $buf .= "

"; "; "; "; "; \n";
295 0           foreach my $colAlias (@{ $o->get_usersel_cols }) {
  0            
296 0           my $colOpts = $$o{schema}{select}{$colAlias}[3];
297 0           $buf .= "".escapeHTML($o->get_nice_name($colAlias))."
298             }
299 0           $buf .= "
300             }
301              
302             # remember state param vals that were used so we can provide a link to view the live data
303 0 0         if ($$o{schema}{state_params}) {
304 0           my $args;
305 0           foreach my $p (@{ $$o{schema}{state_params} }) {
  0            
306 0           my $v = $$o{q}->param($p);
307 0 0         $args .= '&'.$p.'='.$o->escape_uri($v) if $v;
308             }
309 0           $$current_saved_search{state_param_args} = $args;
310             }
311              
312 0           while (my $rec = $o->sth->fetchrow_hashref()) {
313 0 0         die "MAX_ROWS_EXCEEDED - your report contains too many rows to send alerts via email. Reduce the total row count of your report by adding additional filters." if ++$cnt > $$o{schema}{savedSearchAlertMaxRecs};
314 0 0         $opts{mutateRecord}->($rec) if ref($opts{mutateRecord}) eq 'CODE';
315              
316             # if this record has been seen before, mark it with a '2'
317 0 0         if (exists $$current_saved_search{uids}{$$rec{U_ID}}) {
318 0           $$current_saved_search{uids}{$$rec{U_ID}}=2;
319             }
320              
321             # if this record hasn't been seen before, mark it with a '3'
322             else {
323 0           $$current_saved_search{uids}{$$rec{U_ID}}=3;
324             }
325              
326             # if we need to output report
327 0 0 0       if (! $dataTruc && (
      0        
328             # output if when rows are present is checked
329             ($$current_saved_search{ALERT_MASK} & 4)
330             # output if when rows are added is checked AND this is a new row not seen before
331             || ($$current_saved_search{ALERT_MASK} & 1 && $$current_saved_search{uids}{$$rec{U_ID}}==3))) {
332              
333 0           $row_cnt++;
334              
335             # get open record link
336 0           my $link;
337 0 0 0       if (ref($opts{OQdataLCol}) eq 'CODE') {
    0          
    0          
338 0           $link = $opts{OQdataLCol}->($rec);
339 0 0         if ($link =~ /href\s*\=\s*\"?\'?([^\s\'\"\>]+)/i) {
340 0           $link = $1;
341             }
342             } elsif (ref($opts{buildEditLink}) eq 'CODE') {
343 0           $link = $opts{buildEditLink}->($o, $rec, \%opts);
344             } elsif ($opts{editLink} ne '' && $$rec{U_ID} ne '') {
345 0 0         $link = $opts{editLink}.(($opts{editLink} =~ /\?/)?'&':'?')."act=load&id=$$rec{U_ID}";
346             }
347 0           $buf .= "
348              
349             # if this record is first time visible
350 0 0         $buf .= " class=ftv" if $$current_saved_search{uids}{$$rec{U_ID}}==3;
351 0           $buf .= ">";
352 0 0         if ($link) {
353 0 0         if ($link !~ /^https?\:\/\//i) {
354 0 0         $link .= '/'.$link unless $link =~ /^\//;
355 0           $link = $$current_saved_search{opts}{base_url}.$link;
356             }
357 0           $buf .= "open";
358             }
359 0           $buf .= "
360 0           foreach my $col (@{ $o->get_usersel_cols }) {
  0            
361 0           my $val;
362 0 0         if (exists $noEsc{$col}) {
    0          
363 0 0         if (ref($$rec{$col}) eq 'ARRAY') {
364 0           $val = join(' ', @{ $$rec{$col} });
  0            
365             } else {
366 0           $val = $$rec{$col};
367             }
368             } elsif (ref($$rec{$col}) eq 'ARRAY') {
369 0           $val = join(', ', map { escapeHTML($_) } @{ $$rec{$col} });
  0            
  0            
370             } else {
371 0           $val = escapeHTML($$rec{$col});
372             }
373 0           $buf .= "$val
374             }
375 0           $buf .= "
376              
377 0 0         $dataTruc = 1 if length($buf) > $$o{schema}{savedSearchAlertEmailCharLimit};
378             }
379             }
380 0           $o->sth->finish();
381              
382             # if we found rows, encase it in a table with thead
383 0 0         if ($row_cnt > 0) {
384 0           $buf .= "
";
385 0 0         $buf .= "

This report does not show all data found because the report exceeds the maximum limit. Reduce report size by hiding columns, adding additional filters, or only showing new records." if $dataTruc;

386 0           $$current_saved_search{buf} = $buf;
387             }
388              
389              
390 0           return undef;
391             }
392              
393              
394             sub sendmail_handler {
395 0     0 0   my %email = @_;
396 0   0       $email{from} ||= ($ENV{USER}||'root').'@'.($ENV{HOSTNAME}||'localhost');
      0        
      0        
397 0           return Mail::Sendmail::sendmail(%email);
398             }
399              
400             sub get_sysdate_sql {
401 0     0 0   my ($dbh) = @_;
402 0           my $now;
403 0 0 0       if ($$dbh{Driver}{Name} eq 'Oracle') {
    0          
    0          
    0          
404 0           $now = 'SYSDATE';
405             } elsif ($$dbh{Driver}{Name} eq 'SQLite') {
406 0           $now = 'DATETIME()';
407             } elsif ($$dbh{Driver}{Name} eq 'mysql') {
408 0           $now = 'NOW()';
409             } elsif ($$dbh{Driver}{Name} eq 'Pg' || $$dbh{Driver}{Name} eq 'Microsoft SQL Server') {
410 0           $now = 'CURRENT_TIMESTAMP';
411             } else {
412 0           die "Driver: $$dbh{Driver}{Name} not yet supported. Please add support for this database";
413             }
414 0           return $now;
415             }
416              
417              
418             sub execute_saved_search_alerts {
419 0     0 0   my %opts = @_;
420 0   0       my $sendmail_handler = $opts{sendmail_handler} ||= \&sendmail_handler;
421              
422 0 0         if ($opts{base_url} =~ /^(https?\:\/\/[^\/]+)(.*)/i) {
423 0           $opts{server_url} = $1;
424 0           $opts{path_prefix} = $2;
425             } else {
426 0           die "invalid option base_url";
427             }
428 0 0         die "missing option handler" unless ref($opts{handler}) eq 'CODE';
429 0 0         my $dbh = $opts{dbh} or die "missing dbh";
430            
431             $opts{error_handler} ||= sub {
432 0     0     my ($type, @msg) = @_;
433 0           my $dt = strftime "%F %T", localtime $^T;
434 0           my $msg = join(' ', $dt, lc($type), @msg)."\n";
435 0 0         if ($type =~ /^(err|debug)$/i) {
436 0           print STDERR $msg;
437             } else {
438 0           print $msg;
439             }
440 0   0       };
441              
442 0           $opts{error_handler}->("info", "execute_saved_search_alerts started");
443              
444 0           local $CGI::OptimalQuery::CustomOutput::custom_output_handler = \&custom_output_handler;
445              
446 0           my @dt = localtime;
447 0           my $dow = $dt[6];
448 0           my $hour = $dt[2];
449              
450 0 0         if ($$dbh{Driver}{Name} eq 'Oracle') {
451 0           $$dbh{LongReadLen} = 900000;
452 0           my ($readLen) = $dbh->selectrow_array("
453             SELECT GREATEST(
454             dbms_lob.getlength(params),
455             dbms_lob.getlength(alert_uids)
456             )
457             FROM oq_saved_search");
458 0 0         $$dbh{LongReadLen} = $readLen if $readLen > $$dbh{LongReadLen};
459             }
460              
461             # find all saved searches that need to be checked
462 0           my @recs;
463 0           { local $$dbh{FetchHashKeyName} = 'NAME_uc';
  0            
464 0           my @binds = ('%'.$dow.'%', $hour);
465 0           my $sql = "
466             SELECT *
467             FROM oq_saved_search
468             WHERE alert_dow LIKE ?
469             AND alert_mask > 0
470             AND ? BETWEEN alert_start_hour AND alert_end_hour";
471              
472             # only select if interval has been exceeded
473 0 0         if ($$dbh{Driver}{Name} eq 'Oracle') {
    0          
    0          
    0          
    0          
474 0           $sql .= "\nAND ((SYSDATE - alert_last_dt) * 24 * 60) > alert_interval_min";
475             }
476             elsif ($$dbh{Driver}{Name} eq 'SQLite') {
477 0           $sql .= "\nAND (strftime('%s','now') - strftime('%s',COALESCE(alert_last_dt,'2000-01-01'))) > alert_interval_min";
478             }
479             elsif ($$dbh{Driver}{Name} eq 'mysql') {
480 0           $sql .= "\nAND alert_last_dt <= DATE_SUB(NOW(), INTERVAL alert_interval_min MINUTE)";
481             }
482             elsif ($$dbh{Driver}{Name} eq 'Pg') {
483 0           $sql .= "\nAND ((CURRENT_TIMESTAMP - alert_last_dt) * 24 * 60) > alert_interval_min";
484             }
485             elsif ($$dbh{Driver}{Name} eq 'Microsoft SQL Server') {
486 0           $sql .= "\nAND DATEADD(minute, alert_interval_min, alert_last_dt) < CURRENT_TIMESTAMP";
487             }
488             else {
489 0           die "Driver: $$dbh{Driver}{Name} not yet supported. Please add support for this database";
490             }
491 0           $sql .= "\nORDER BY id";
492 0           my $sth = $dbh->prepare($sql);
493            
494 0 0         $opts{error_handler}->("debug", "search for saved searches that need checked. BINDS: ".join(',', @binds)) if $opts{debug};
495 0           $sth->execute(@binds);
496 0           while (my $h = $sth->fetchrow_hashref()) { push @recs, $h; }
  0            
497             }
498              
499 0 0         $opts{error_handler}->("debug", "found ".scalar(@recs)." saved searches to execute") if $opts{debug};
500              
501             # for each saved search that has alerts which need to be checked
502 0           local $current_saved_search = undef;
503 0           while ($#recs > -1) {
504 0           my $rec = pop @recs;
505              
506 0           $current_saved_search = $rec;
507 0           my %uids = map { $_ => 1 } split /\~/, $$rec{ALERT_UIDS};
  0            
508 0           $$rec{opts} = \%opts;
509 0           $$rec{uids} = \%uids; # contains all the previously seen uids
510 0           $$rec{buf} = ''; # will be populated with a table containing report rows for a simple HTML email
511 0           $$rec{err_msg} = '';
512 0           $opts{error_handler}->("info", "executing saved search: $$rec{ID}");
513              
514             # configure CGI environment
515             # construct a query string
516 0           local $ENV{QUERY_STRING};
517 0           { my $p = eval '{'.$$rec{PARAMS}.'}';
  0            
518 0 0         $p = {} unless ref($p) eq 'HASH';
519 0           $$p{module} = 'CustomOutput'; # this will call our custom_output_handler function
520 0           $$p{page} = 1;
521 0           my @args;
522 0           while (my ($k,$v) = each %$p) {
523 0 0         if (ref($v) eq 'ARRAY') {
524 0           foreach my $v2 (@$v) {
525 0           push @args, "$k=".CGI::escape($v2);
526             }
527             } else {
528 0           push @args, "$k=".CGI::escape($v);
529             }
530             }
531 0           $ENV{QUERY_STRING} = join('&', @args);
532             }
533 0   0       local $ENV{REQUEST_METHOD} ||= 'GET';
534 0   0       local $ENV{REMOTE_ADDR} ||= '127.0.0.1';
535 0           local $ENV{SCRIPT_URL} = $$rec{URI};
536              
537 0           local $ENV{REQUEST_URI} = $$rec{URI};
538 0 0         $ENV{REQUEST_URI} .= '?'.$ENV{QUERY_STRING} if $ENV{QUERY_STRING};
539              
540 0 0 0       local $ENV{HTTP_HOST} ||= ($opts{base_url} =~ /https?\:\/\/([^\/]+)/) ? $1 : 'localhost';
541 0   0       local $ENV{SERVER_NAME} ||= $ENV{HTTP_HOST};
542 0           local $ENV{SCRIPT_URI} = $opts{base_url}.$ENV{REQUEST_URI};
543              
544             # The CGI library has some globals that need to be reset otherwise the previous params stick around
545 0           CGI::initialize_globals();
546              
547             # call app specific request bootstrap handler
548             # which will execute a CGI::OptimalQuery object somehow
549             # and populate $$rec{buf}, $$rec{uids}, $$rec{err_msg}
550 0           eval {
551 0           $opts{handler}->($rec);
552 0 0         die "email_to not defined" if $$rec{email_to} eq '';
553 0 0         $opts{error_handler}->("debug", "after OQ execution uids: ".Dumper(\%uids)) if $opts{debug};
554             };
555 0 0         if ($@) {
556 0           $$rec{err_msg} = $@;
557 0           $$rec{err_msg} =~ s/\ at\ .*//;
558             }
559              
560 0           my @update_uids;
561             # if there was an error processing saved search, send user an email
562 0 0         if ($$rec{err_msg}) {
563 0           $opts{error_handler}->("err", "Error: $@\n\nsaved search:\n".Dumper($rec)."\n\nENV:\n".Dumper(\%ENV)."\n\n");
564 0 0         if ($$rec{email_to}) {
565             my %email = (
566             to => $$rec{email_to},
567             from => $$rec{email_from} || $opts{email_from},
568             'Reply-To' => $$rec{'email_Reply-To'} || $opts{'email_Reply-To'},
569             subject => "Problem with email alert: $$rec{OQ_TITLE} - $$rec{USER_TITLE}",
570             body => "Your saved search alert encountered the following error:
571              
572             $$rec{err_msg}
573              
574             load report:
575 0   0       ".$opts{base_url}.$$rec{URI}.'?OQLoadSavedSearch='.$$rec{ID}.$$rec{state_param_args}."
      0        
576              
577             Please contact your administrator if you are unable to fix the problem."
578             );
579              
580 0 0         if ($opts{debug}) {
581 0           $opts{error_handler}->("debug", "debug sendmail (not sent): ".Dumper(\%email));
582             } else {
583 0           $opts{error_handler}->("info", "sending email to: $email{to}; subject: $email{subject}");
584 0 0         $sendmail_handler->(%email) or die "could not send email to: $$rec{email_to}";
585             }
586             }
587             }
588              
589             else {
590 0           my $total_new = 0;
591 0           my $total_deleted = 0;
592 0           my $total_count = 0;
593 0           while (my ($uid, $status) = each %uids) {
594 0 0         if ($status == 1) {
595 0           $total_deleted++;
596             }
597             else {
598 0           push @update_uids, $uid;
599 0           $total_count++;
600 0 0         if ($status == 3) {
601 0           $total_new++;
602             }
603             }
604             }
605 0           $opts{error_handler}->("info", "total_new: $total_new; total_deleted: $total_deleted; total_count: $total_count");
606              
607             my $should_send_email = 1 if
608             ( # alert when records are added
609             ($$rec{ALERT_MASK} & 1 && $total_new > 0) ||
610             # alert when records are deleted
611             ($$rec{ALERT_MASK} & 2 && $total_deleted > 0) ||
612             # alert when records are present
613 0 0 0       ($$rec{ALERT_MASK} & 4 && $total_count > 0)
      0        
      0        
      0        
      0        
614             );
615              
616 0 0         if ($should_send_email) {
617             my %email = (
618             to => $$rec{email_to},
619             from => $$rec{email_from} || $opts{email_from},
620 0   0       'Reply-To' => $$rec{'email_Reply-To'} || $opts{'email_Reply-To'},
      0        
621             subject => "$$rec{OQ_TITLE} - $$rec{USER_TITLE}",
622             'content-type' => 'text/html; charset="iso-8859-1"'
623             );
624 0 0         $email{subject} .= " ($total_new added)" if $total_new > 0;
625              
626             $email{body} =
627             "
628            
629             ".escapeHTML("$$rec{OQ_TITLE} - $$rec{USER_TITLE}")."
630            
663            
664            
665            
666            

".escapeHTML("$$rec{OQ_TITLE} - $$rec{USER_TITLE}")."
667            

668             $$rec{buf}
669            

670             total: $total_count
671             added: $total_new
672             removed: $total_deleted
673            

674 0           load report
675            
676            
677             ";
678              
679 0 0         if ($opts{debug}) {
680 0           $opts{error_handler}->("debug", "debug sendmail (not sent): ".Dumper(\%email));
681             } else {
682 0           $opts{error_handler}->("info", "sending email to: $email{to}; subject: $email{subject}");
683 0 0         $sendmail_handler->(%email) or die "could not send email to: $$rec{email_to}";
684             }
685             }
686             }
687              
688             # update database
689 0           my $update_uids = join('~', sort @update_uids);
690 0 0         $update_uids = undef if $update_uids eq '';
691 0 0         $$rec{err_msg} = undef if $$rec{err_msg} eq '';
692 0           my @binds = ($$rec{err_msg});
693 0           my $now = get_sysdate_sql($dbh);
694              
695 0           my $sql = "UPDATE oq_saved_search SET alert_last_dt=$now, alert_err=?";
696 0 0         if ($update_uids ne $$rec{ALERT_UIDS}) {
697 0           $sql .= ", alert_uids=?";
698 0           push @binds, $update_uids;
699             }
700 0           $sql .= " WHERE id=?";
701 0           push @binds, $$rec{ID};
702 0 0         $opts{error_handler}->("debug", "SQL: $sql\nBINDS: ".join(',', @binds)) if $opts{debug};
703 0           my $sth = $dbh->prepare_cached($sql);
704 0           $sth->execute(@binds);
705              
706 0           $current_saved_search = undef;
707             }
708              
709 0           $opts{error_handler}->("info", "execute_saved_search_alerts done");
710             }
711              
712              
713             # helper function to execute a script. called from with execute_saved_search_alerts from perl script
714             my %COMPILED_FUNCS;
715             sub execute_script {
716 0     0 0   my ($fn) = @_;
717 0 0         if (! exists $COMPILED_FUNCS{$fn}) {
718 0 0         open my $fh, "<", $fn or die "can't read file $fn; $!";
719 0           local $/=undef;
720 0           my $code = 'sub { '.scalar(<$fh>). ' }';
721 0           $COMPILED_FUNCS{$fn} = eval $code;
722 0 0         die "could not compile $fn; $@" if $@;
723             }
724 0           $COMPILED_FUNCS{$fn}->();
725 0           return undef;
726             }
727              
728             sub execute_handler {
729 0     0 0   my ($pack, $func) = @_;
730 0   0       $func ||= 'handler';
731 0           my $rv = eval "require $pack";
732 0 0         die "NOT_FOUND - $@" if $@ =~ /Can\'t locate/;
733 0 0         die "COMPILE_ERROR - $@" if $@;
734 0 0         die "COMPILE_ERROR - module must end with true value" unless $rv == 1;
735 0           my $codeRef = $pack->can($func);
736 0 0         die "MISSING_HANDLER - could not find ".$pack.'::'.$func unless $codeRef;
737 0           return $codeRef->();
738             }
739             1;