File Coverage

lib/CGI/OptimalQuery/SaveSearchTool.pm
Criterion Covered Total %
statement 21 377 5.5
branch 0 226 0.0
condition 0 116 0.0
subroutine 7 18 38.8
pod 0 10 0.0
total 28 747 3.7


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

208            
209            
210            
211            
212            
213            

214            
215             (1440 min per day)
216              
217            

218            
219            
220            
221            
222            
223            
224            
225            
226              
227            

228 0 0        
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
229            

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}.

230             ";
231             }
232             else {
233 0           my $rec;
234 0 0         if ($$o{q}->param('OQss') ne '') {
235 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});
236             }
237 0   0       $rec ||= {};
238             $buf .= "
239 0           ";
240             }
241              
242             # include checkbox to allow user to set saved search as the default settings
243 0 0         if($$o{schema}{canSaveDefaultSearches}) {
244 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});
245 0 0         $buf .= "
";
246             }
247              
248 0           $buf .= "

";

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

Query: "

298 0 0         .escapeHTML($$o{queryDescr}) if $$o{queryDescr};
299 0 0         $buf .= "

Filter: "

300             .escapeHTML($filter) if $filter;
301 0           $buf .= "

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

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

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

676             $$rec{buf}
677            

678             total: $total_count
679             added: $total_new
680             removed: $total_deleted
681            

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