yay! the reporter spits out csv and excel now ... html tomorrow (with any luck)
[Evergreen.git] / Open-ILS / src / reporter / clark-kent.pl
1 #!/usr/bin/perl -w
2
3 use strict;
4 use DBI;
5 use FileHandle;
6 use XML::LibXML;
7 use Getopt::Long;
8 use DateTime;
9 use DateTime::Format::ISO8601;
10 use JSON;
11 use Data::Dumper;
12 use OpenILS::WWW::Reporter::transforms;
13 use Text::CSV_XS;
14 use Spreadsheet::WriteExcel;
15 use OpenSRF::EX qw/:try/;
16 use OpenSRF::Utils qw/:daemon/;
17 use OpenSRF::Utils::Logger qw/:level/;
18
19 my $current_time = DateTime->from_epoch( epoch => time() )->strftime('%FT%T%z');
20
21 my ($base_xml, $count, $daemon) = ('/openils/conf/reporter.xml', 1);
22
23 GetOptions(
24         "file=s"        => \$base_xml,
25         "daemon"        => \$daemon,
26         "concurrency=i" => \$count,
27 );
28
29 my $parser = XML::LibXML->new;
30 $parser->expand_xinclude(1);
31
32 my $doc = $parser->parse_file($base_xml);
33
34 my $db_driver = $doc->findvalue('/reporter/setup/database/driver');
35 my $db_host = $doc->findvalue('/reporter/setup/database/host');
36 my $db_name = $doc->findvalue('/reporter/setup/database/name');
37 my $db_user = $doc->findvalue('/reporter/setup/database/user');
38 my $db_pw = $doc->findvalue('/reporter/setup/database/password');
39
40 my $dsn = "dbi:" . $db_driver . ":dbname=" . $db_name .';host=' . $db_host;
41
42 my $dbh;
43
44 daemonize("Clark Kent, waiting for trouble") if ($daemon);
45
46 DAEMON:
47
48 $dbh = DBI->connect($dsn,$db_user,$db_pw);
49
50 # Move new reports into the run queue
51 $dbh->do(<<'SQL', {}, $current_time);
52 INSERT INTO reporter.output ( stage3, state ) 
53         SELECT  id, 'wait'
54           FROM  reporter.stage3 
55           WHERE runtime <= $1
56                 AND (   (       recurrence = '0 seconds'::INTERVAL
57                                 AND id NOT IN ( SELECT stage3 FROM reporter.output ) )
58                         OR (    recurrence > '0 seconds'::INTERVAL
59                                 AND id NOT IN (
60                                         SELECT  stage3
61                                           FROM  reporter.output
62                                           WHERE state <> 'complete')
63                         )
64                 )
65           ORDER BY runtime;
66 SQL
67
68 # make sure we're not already running $count reports
69 my ($running) = $dbh->selectrow_array(<<SQL);
70 SELECT  count(*)
71   FROM  reporter.output
72   WHERE state = 'running';
73 SQL
74
75 if ($count <= $running) {
76         print "Already running maximum ($running) concurrent reports\n";
77         exit 1;
78 }
79
80 # if we have some open slots then generate the sql
81 my $run = $count - $running;
82
83 my $sth = $dbh->prepare(<<SQL);
84 SELECT  *
85   FROM  reporter.output
86   WHERE state = 'wait'
87   ORDER BY queue_time
88   LIMIT $run;
89 SQL
90
91 $sth->execute;
92
93 my @reports;
94 while (my $r = $sth->fetchrow_hashref) {
95         my $s3 = $dbh->selectrow_hashref(<<"    SQL", {}, $r->{stage3});
96                 SELECT * FROM reporter.stage3 WHERE id = ?;
97         SQL
98
99         my $s2 = $dbh->selectrow_hashref(<<"    SQL", {}, $s3->{stage2});
100                 SELECT * FROM reporter.stage2 WHERE id = ?;
101         SQL
102
103         $s3->{stage2} = $s2;
104         $r->{stage3} = $s3;
105
106         generate_query( $r );
107         push @reports, $r;
108 }
109
110 $sth->finish;
111
112 $dbh->disconnect;
113
114 # Now we spaun the report runners
115
116 for my $r ( @reports ) {
117         next if (safe_fork());
118
119         # This is the child (runner) process;
120         my $p = JSON->JSON2perl( $r->{stage3}->{params} );
121         daemonize("Clark Kent reporting: $p->{reportname}");
122
123         $dbh = DBI->connect($dsn,$db_user,$db_pw);
124
125         try {
126
127                 $dbh->do(<<'            SQL',{}, $r->{sql}->{'select'}, $$, $r->{id});
128                         UPDATE  reporter.output
129                           SET   state = 'running',
130                                 run_time = 'now',
131                                 query = ?,
132                                 run_pid = ?
133                           WHERE id = ?;
134                 SQL
135
136                 $sth = $dbh->prepare($r->{sql}->{'select'});
137
138                 $sth->execute(@{ $r->{sql}->{'bind'} });
139                 $r->{data} = $sth->fetchall_arrayref;
140
141                 my $base = $doc->findvalue('/reporter/setup/files/output_base');
142                 my $s1 = $r->{stage3}->{stage2}->{stage1};
143                 my $s2 = $r->{stage3}->{stage2}->{id};
144                 my $s3 = $r->{stage3}->{id};
145                 my $output = $r->{id};
146
147                 mkdir($base);
148                 mkdir("$base/$s1");
149                 mkdir("$base/$s1/$s2");
150                 mkdir("$base/$s1/$s2/$s3");
151                 mkdir("$base/$s1/$s2/$s3/$output");
152         
153                 my @formats;
154                 if (ref $p->{output_format}) {
155                         @formats = @{ $p->{output_format} };
156                 } else {
157                         @formats = ( $p->{output_format} );
158                 }
159         
160                 if ( grep { $_ eq 'csv' } @formats ) {
161                         build_csv("$base/$s1/$s2/$s3/$output/report-data.csv", $r);
162                 }
163                 
164                 if ( grep { $_ eq 'excel' } @formats ) {
165                         build_excel("$base/$s1/$s2/$s3/$output/report-data.xls", $r);
166                 }
167                 
168                 if ( grep { $_ eq 'html' } @formats ) {
169                         mkdir("$base/$s1/$s2/$s3/$output/html");
170                         build_html("$base/$s1/$s2/$s3/$output/report-data.html", $r);
171                 }
172
173
174                 $dbh->begin_work;
175                 $dbh->do(<<'            SQL',{}, $r->{stage3}->{id});
176                         UPDATE  reporter.stage3
177                           SET   runtime = runtime + recurrence
178                           WHERE id = ? AND recurrence > '0 seconds'::INTERVAL;
179                 SQL
180                 $dbh->do(<<'            SQL',{}, $r->{id});
181                         UPDATE  reporter.output
182                           SET   state = 'complete',
183                                 complete_time = 'now'
184                           WHERE id = ?;
185                 SQL
186                 $dbh->commit;
187
188
189         } otherwise {
190                 my $e = shift;
191                 $dbh->rollback;
192                 $dbh->do(<<'            SQL',{}, $e, $r->{id});
193                         UPDATE  reporter.output
194                           SET   state = 'error',
195                                 error_time = 'now',
196                                 error = ?,
197                                 run_pid = NULL
198                           WHERE id = ?;
199                 SQL
200         };
201
202         $dbh->disconnect;
203
204         exit; # leave the child
205 }
206
207 if ($daemon) {
208         sleep 60;
209         goto DAEMON;
210 }
211
212 #-------------------------------------------------------------------
213
214 sub build_csv {
215         my $file = shift;
216         my $r = shift;
217
218         my $csv = Text::CSV_XS->new({ always_quote => 1, eol => "\015\012" });
219         my $f = new FileHandle (">$file");
220
221         $csv->print($f, $r->{sql}->{columns});
222         $csv->print($f, $_) for (@{$r->{data}});
223
224         $f->close;
225 }
226 sub build_excel {
227         my $file = shift;
228         my $r = shift;
229         my $p = JSON->JSON2perl( $r->{stage3}->{params} );
230
231         my $xls = Spreadsheet::WriteExcel->new($file);
232         my $sheet = $xls->add_worksheet($p->{reportname});
233
234         $sheet->write_row('A1', $r->{sql}->{columns});
235
236         $sheet->write_col('A2', $r->{data});
237
238         $xls->close;
239 }
240
241 sub build_html {}
242
243 sub table_by_id {
244         my $id = shift;
245         my ($node) = $doc->findnodes("//*[\@id='$id']");
246         if ($node && $node->findvalue('@table')) {
247                 ($node) = $doc->findnodes("//*[\@id='".$node->getAttribute('table')."']");
248         }
249         return $node;
250 }
251
252 sub generate_query {
253         my $r = shift;
254
255         my $p = JSON->JSON2perl( $r->{stage3}->{params} );
256
257         my @group_by;
258         my @aggs;
259         my $core = $r->{stage3}->{stage2}->{stage1};
260         my @dims;
261
262         for my $t (keys %{$$p{filter}}) {
263                 if ($t ne $core) {
264                         push @dims, $t;
265                 }
266         }
267
268         for my $t (keys %{$$p{output}}) {
269                 if ($t ne $core && !grep { $t } @dims ) {
270                         push @dims, $t;
271                 }
272         }
273
274         my @dim_select;
275         my @dim_from;
276         for my $d (@dims) {
277                 my $t = table_by_id($d);
278                 my $t_name = $t->findvalue('tablename');
279                 push @dim_from, "$t_name AS \"$d\"";
280
281                 my $k = $doc->findvalue("//*[\@id='$d']/\@key");
282                 push @dim_select, "\"$d\".\"$k\" AS \"${d}_${k}\"";
283
284                 for my $c ( keys %{$$p{output}{$d}} ) {
285                         push @dim_select, "\"$d\".\"$c\" AS \"${d}_${c}\"";
286                 }
287
288                 for my $c ( keys %{$$p{filter}{$d}} ) {
289                         next if (exists $$p{output}{$d}{$c});
290                         push @dim_select, "\"$d\".\"$c\" AS \"${d}_${c}\"";
291                 }
292         }
293
294         my $d_select =
295                 '(SELECT ' . join(',', @dim_select) .
296                 '  FROM ' . join(',', @dim_from) . ') AS dims';
297         
298         my @output_order = map { { (split ':')[1] => (split ':')[2] } } @{ $$p{output_order} };
299         
300         my $col = 1;
301         my @groupby;
302         my @output;
303         my @columns;
304         my @join;
305         my @join_base;
306         for my $pair (@output_order) {
307                 my ($t_name) = keys %$pair;
308                 my $t = $t_name;
309
310                 $t_name = "dims" if ($t ne $core);
311
312                 my $t_node = table_by_id($t);
313
314                 for my $c ( values %$pair ) {
315                         my $label = $t_node->findvalue("fields/field[\@name='$c']/label");
316
317                         my $full_col = $c;
318                         $full_col = "${t}_${c}" if ($t ne $t_name);
319                         $full_col = "\"$t_name\".\"$full_col\"";
320
321                         
322                         if (my $xform_type = $$p{xform}{type}{$t}{$c}) {
323                                 my $xform = $$OpenILS::WWW::Reporter::dtype_xforms{$xform_type};
324                                 if ($xform->{group}) {
325                                         push @groupby, $col;
326                                 }
327                                 $label = "$$xform{label} -- $label";
328
329                                 my $tmp = $xform->{'select'};
330                                 $tmp =~ s/\?COLNAME\?/$full_col/gs;
331                                 $tmp =~ s/\?PARAM\?/$$p{xform}{param}{$t}{$c}/gs;
332                                 $full_col = $tmp;
333                         } else {
334                                 push @groupby, $col;
335                         }
336
337                         push @output, "$full_col AS \"$label\"";
338                         push @columns, $label;
339                         $col++;
340                 }
341
342                 if ($t ne $t_name && (!@join_base || !grep{$t eq $_}@join_base)) {
343                         my $k = $doc->findvalue("//*[\@id='$t']/\@key");
344                         my $f = $doc->findvalue("//*[\@id='$t']/\@field");
345                         push @join, "dims.\"${t}_${k}\" = \"$core\".\"$f\"";
346                         push @join_base, $t;
347                 }
348         }
349
350         my @where;
351         my @bind;
352         for my $t ( keys %{$$p{filter}} ) {
353                 my $t_name = $t;
354                 $t_name = "dims" if ($t ne $core);
355
356                 my $t_node = table_by_id($t);
357
358                 for my $c ( keys %{$$p{filter}{$t}} ) {
359                         my $label = $t_node->findvalue("fields/field[\@name='$c']/label");
360
361                         my $full_col = $c;
362                         $full_col = "${t}_${c}" if ($t ne $t_name);
363                         $full_col = "\"$t_name\".\"$full_col\"";
364
365                         # XXX make this use widget specific code
366
367                         my ($fam) = keys %{ $$p{filter}{$t}{$c} };
368                         my ($w) = keys %{ $$p{filter}{$t}{$c}{$fam} };
369                         my $val = $$p{filter}{$t}{$c}{$fam}{$w};
370
371                         if (ref $val) {
372                                 push @where, "$full_col IN (".join(",",map {'?'}@$val).")";
373                                 push @bind, @$val;
374                         } else {
375                                 push @where, "$full_col = ?";
376                                 push @bind, $val;
377                         }
378                 }
379
380                 if ($t ne $t_name && (!@join_base || !grep{$t eq $_}@join_base)) {
381                         my $k = $doc->findvalue("//*[\@id='$t']/\@key");
382                         my $f = $doc->findvalue("//*[\@id='$t']/\@field");
383                         push @join, "dims.\"${t}_${k}\" = \"$core\".\"$f\"";
384                         push @join_base, $t;
385                 }
386         }
387
388         my $t = table_by_id($core)->findvalue('tablename');
389         my $from = " FROM $t AS \"$core\" RIGHT JOIN $d_select ON (". join(' AND ', @join).")";
390         my $select =
391                 "SELECT ".join(',', @output).
392                   $from.
393                   ' WHERE '.join(' AND ', @where).
394                   ' GROUP BY '.join(',',@groupby);
395
396         $r->{sql}->{'select'}   = $select;
397         $r->{sql}->{'bind'}     = \@bind;
398         $r->{sql}->{columns}    = \@columns;
399         
400 }
401
402
403
404
405
406