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