yay! the reporter spits out csv and excel now ... html tomorrow (with any luck)
[Evergreen.git] / Open-ILS / src / reporter / clark-kent.pl
index 438efb6..9a5a50b 100755 (executable)
@@ -2,6 +2,7 @@
 
 use strict;
 use DBI;
+use FileHandle;
 use XML::LibXML;
 use Getopt::Long;
 use DateTime;
@@ -9,13 +10,19 @@ use DateTime::Format::ISO8601;
 use JSON;
 use Data::Dumper;
 use OpenILS::WWW::Reporter::transforms;
+use Text::CSV_XS;
+use Spreadsheet::WriteExcel;
+use OpenSRF::EX qw/:try/;
+use OpenSRF::Utils qw/:daemon/;
+use OpenSRF::Utils::Logger qw/:level/;
 
 my $current_time = DateTime->from_epoch( epoch => time() )->strftime('%FT%T%z');
 
-my ($base_xml, $count) = ('/openils/conf/reporter.xml', 1);
+my ($base_xml, $count, $daemon) = ('/openils/conf/reporter.xml', 1);
 
 GetOptions(
        "file=s"        => \$base_xml,
+       "daemon"        => \$daemon,
        "concurrency=i" => \$count,
 );
 
@@ -24,8 +31,6 @@ $parser->expand_xinclude(1);
 
 my $doc = $parser->parse_file($base_xml);
 
-warn $doc->toString;
-
 my $db_driver = $doc->findvalue('/reporter/setup/database/driver');
 my $db_host = $doc->findvalue('/reporter/setup/database/host');
 my $db_name = $doc->findvalue('/reporter/setup/database/name');
@@ -34,12 +39,36 @@ my $db_pw = $doc->findvalue('/reporter/setup/database/password');
 
 my $dsn = "dbi:" . $db_driver . ":dbname=" . $db_name .';host=' . $db_host;
 
-my $dbh = DBI->connect($dsn,$db_user,$db_pw);
+my $dbh;
+
+daemonize("Clark Kent, waiting for trouble") if ($daemon);
+
+DAEMON:
+
+$dbh = DBI->connect($dsn,$db_user,$db_pw);
+
+# Move new reports into the run queue
+$dbh->do(<<'SQL', {}, $current_time);
+INSERT INTO reporter.output ( stage3, state ) 
+       SELECT  id, 'wait'
+         FROM  reporter.stage3 
+         WHERE runtime <= $1
+               AND (   (       recurrence = '0 seconds'::INTERVAL
+                               AND id NOT IN ( SELECT stage3 FROM reporter.output ) )
+                       OR (    recurrence > '0 seconds'::INTERVAL
+                               AND id NOT IN (
+                                       SELECT  stage3
+                                         FROM  reporter.output
+                                         WHERE state <> 'complete')
+                       )
+               )
+         ORDER BY runtime;
+SQL
 
 # make sure we're not already running $count reports
 my ($running) = $dbh->selectrow_array(<<SQL);
 SELECT count(*)
-  FROM reporter.run_queue
+  FROM reporter.output
   WHERE        state = 'running';
 SQL
 
@@ -50,37 +79,167 @@ if ($count <= $running) {
 
 # if we have some open slots then generate the sql
 my $run = $count - $running;
+
 my $sth = $dbh->prepare(<<SQL);
 SELECT *
-  FROM reporter.stage3
-  WHERE        runtime <= ?
-  ORDER BY runtime
-  LIMIT $run
+  FROM reporter.output
+  WHERE        state = 'wait'
+  ORDER BY queue_time
+  LIMIT $run;
 SQL
 
-$sth->execute($current_time);
+$sth->execute;
 
 my @reports;
 while (my $r = $sth->fetchrow_hashref) {
-       $r->{sql} = generate_query( $r );
+       my $s3 = $dbh->selectrow_hashref(<<"    SQL", {}, $r->{stage3});
+               SELECT * FROM reporter.stage3 WHERE id = ?;
+       SQL
+
+       my $s2 = $dbh->selectrow_hashref(<<"    SQL", {}, $s3->{stage2});
+               SELECT * FROM reporter.stage2 WHERE id = ?;
+       SQL
+
+       $s3->{stage2} = $s2;
+       $r->{stage3} = $s3;
+
+       generate_query( $r );
        push @reports, $r;
 }
+
 $sth->finish;
 
+$dbh->disconnect;
+
+# Now we spaun the report runners
+
 for my $r ( @reports ) {
-       my $sql = shift @{ $r->{sql} };
+       next if (safe_fork());
 
-       $sth = $dbh->prepare($sql);
+       # This is the child (runner) process;
+       my $p = JSON->JSON2perl( $r->{stage3}->{params} );
+       daemonize("Clark Kent reporting: $p->{reportname}");
 
-       $sth->execute(@{ $r->{sql} });
-       while (my $row = $sth->fetchrow_hashref) {
-               print join(', ', map {"$_\t=> $$row{$_}"} keys %$row)."\n";
-       }
+       $dbh = DBI->connect($dsn,$db_user,$db_pw);
+
+       try {
+
+               $dbh->do(<<'            SQL',{}, $r->{sql}->{'select'}, $$, $r->{id});
+                       UPDATE  reporter.output
+                         SET   state = 'running',
+                               run_time = 'now',
+                               query = ?,
+                               run_pid = ?
+                         WHERE id = ?;
+               SQL
+
+               $sth = $dbh->prepare($r->{sql}->{'select'});
+
+               $sth->execute(@{ $r->{sql}->{'bind'} });
+               $r->{data} = $sth->fetchall_arrayref;
+
+               my $base = $doc->findvalue('/reporter/setup/files/output_base');
+               my $s1 = $r->{stage3}->{stage2}->{stage1};
+               my $s2 = $r->{stage3}->{stage2}->{id};
+               my $s3 = $r->{stage3}->{id};
+               my $output = $r->{id};
+
+               mkdir($base);
+               mkdir("$base/$s1");
+               mkdir("$base/$s1/$s2");
+               mkdir("$base/$s1/$s2/$s3");
+               mkdir("$base/$s1/$s2/$s3/$output");
+       
+               my @formats;
+               if (ref $p->{output_format}) {
+                       @formats = @{ $p->{output_format} };
+               } else {
+                       @formats = ( $p->{output_format} );
+               }
+       
+               if ( grep { $_ eq 'csv' } @formats ) {
+                       build_csv("$base/$s1/$s2/$s3/$output/report-data.csv", $r);
+               }
+               
+               if ( grep { $_ eq 'excel' } @formats ) {
+                       build_excel("$base/$s1/$s2/$s3/$output/report-data.xls", $r);
+               }
+               
+               if ( grep { $_ eq 'html' } @formats ) {
+                       mkdir("$base/$s1/$s2/$s3/$output/html");
+                       build_html("$base/$s1/$s2/$s3/$output/report-data.html", $r);
+               }
+
+
+               $dbh->begin_work;
+               $dbh->do(<<'            SQL',{}, $r->{stage3}->{id});
+                       UPDATE  reporter.stage3
+                         SET   runtime = runtime + recurrence
+                         WHERE id = ? AND recurrence > '0 seconds'::INTERVAL;
+               SQL
+               $dbh->do(<<'            SQL',{}, $r->{id});
+                       UPDATE  reporter.output
+                         SET   state = 'complete',
+                               complete_time = 'now'
+                         WHERE id = ?;
+               SQL
+               $dbh->commit;
+
+
+       } otherwise {
+               my $e = shift;
+               $dbh->rollback;
+               $dbh->do(<<'            SQL',{}, $e, $r->{id});
+                       UPDATE  reporter.output
+                         SET   state = 'error',
+                               error_time = 'now',
+                               error = ?,
+                               run_pid = NULL
+                         WHERE id = ?;
+               SQL
+       };
+
+       $dbh->disconnect;
+
+       exit; # leave the child
 }
 
+if ($daemon) {
+       sleep 60;
+       goto DAEMON;
+}
 
 #-------------------------------------------------------------------
 
+sub build_csv {
+       my $file = shift;
+       my $r = shift;
+
+       my $csv = Text::CSV_XS->new({ always_quote => 1, eol => "\015\012" });
+       my $f = new FileHandle (">$file");
+
+       $csv->print($f, $r->{sql}->{columns});
+       $csv->print($f, $_) for (@{$r->{data}});
+
+       $f->close;
+}
+sub build_excel {
+       my $file = shift;
+       my $r = shift;
+       my $p = JSON->JSON2perl( $r->{stage3}->{params} );
+
+       my $xls = Spreadsheet::WriteExcel->new($file);
+       my $sheet = $xls->add_worksheet($p->{reportname});
+
+       $sheet->write_row('A1', $r->{sql}->{columns});
+
+       $sheet->write_col('A2', $r->{data});
+
+       $xls->close;
+}
+
+sub build_html {}
+
 sub table_by_id {
        my $id = shift;
        my ($node) = $doc->findnodes("//*[\@id='$id']");
@@ -91,36 +250,26 @@ sub table_by_id {
 }
 
 sub generate_query {
-       my $s3 = shift;
-       warn Dumper($s3);
-
-       my $r = JSON->JSON2perl( $s3->{params} );
-       warn Dumper($r);
+       my $r = shift;
 
-       my $s2 = $dbh->selectrow_hashref(<<"    SQL", {}, $s3->{stage2});
-               SELECT  *
-                 FROM  reporter.stage2
-                 WHERE id = ?
-       SQL
-       warn Dumper($s2);
+       my $p = JSON->JSON2perl( $r->{stage3}->{params} );
 
        my @group_by;
        my @aggs;
-       my $core = $s2->{stage1};
+       my $core = $r->{stage3}->{stage2}->{stage1};
        my @dims;
 
-       for my $t (keys %{$$r{filter}}) {
+       for my $t (keys %{$$p{filter}}) {
                if ($t ne $core) {
                        push @dims, $t;
                }
        }
 
-       for my $t (keys %{$$r{output}}) {
+       for my $t (keys %{$$p{output}}) {
                if ($t ne $core && !grep { $t } @dims ) {
                        push @dims, $t;
                }
        }
-       warn Dumper(\@dims);
 
        my @dim_select;
        my @dim_from;
@@ -132,12 +281,12 @@ sub generate_query {
                my $k = $doc->findvalue("//*[\@id='$d']/\@key");
                push @dim_select, "\"$d\".\"$k\" AS \"${d}_${k}\"";
 
-               for my $c ( keys %{$$r{output}{$d}} ) {
+               for my $c ( keys %{$$p{output}{$d}} ) {
                        push @dim_select, "\"$d\".\"$c\" AS \"${d}_${c}\"";
                }
 
-               for my $c ( keys %{$$r{filter}{$d}} ) {
-                       next if (exists $$r{output}{$d}{$c});
+               for my $c ( keys %{$$p{filter}{$d}} ) {
+                       next if (exists $$p{output}{$d}{$c});
                        push @dim_select, "\"$d\".\"$c\" AS \"${d}_${c}\"";
                }
        }
@@ -146,19 +295,23 @@ sub generate_query {
                '(SELECT ' . join(',', @dim_select) .
                '  FROM ' . join(',', @dim_from) . ') AS dims';
        
-       warn "*** [$d_select]\n";
-
+       my @output_order = map { { (split ':')[1] => (split ':')[2] } } @{ $$p{output_order} };
+       
        my $col = 1;
        my @groupby;
        my @output;
+       my @columns;
        my @join;
-       for my $t ( keys %{$$r{output}} ) {
-               my $t_name = $t;
+       my @join_base;
+       for my $pair (@output_order) {
+               my ($t_name) = keys %$pair;
+               my $t = $t_name;
+
                $t_name = "dims" if ($t ne $core);
 
                my $t_node = table_by_id($t);
 
-               for my $c ( keys %{$$r{output}{$t}} ) {
+               for my $c ( values %$pair ) {
                        my $label = $t_node->findvalue("fields/field[\@name='$c']/label");
 
                        my $full_col = $c;
@@ -166,7 +319,7 @@ sub generate_query {
                        $full_col = "\"$t_name\".\"$full_col\"";
 
                        
-                       if (my $xform_type = $$r{xform}{type}{$t}{$c}) {
+                       if (my $xform_type = $$p{xform}{type}{$t}{$c}) {
                                my $xform = $$OpenILS::WWW::Reporter::dtype_xforms{$xform_type};
                                if ($xform->{group}) {
                                        push @groupby, $col;
@@ -175,32 +328,34 @@ sub generate_query {
 
                                my $tmp = $xform->{'select'};
                                $tmp =~ s/\?COLNAME\?/$full_col/gs;
-                               $tmp =~ s/\?PARAM\?/$$r{xform}{param}{$t}{$c}/gs;
+                               $tmp =~ s/\?PARAM\?/$$p{xform}{param}{$t}{$c}/gs;
                                $full_col = $tmp;
                        } else {
                                push @groupby, $col;
                        }
 
                        push @output, "$full_col AS \"$label\"";
+                       push @columns, $label;
                        $col++;
                }
 
-               if ($t ne $t_name) {
+               if ($t ne $t_name && (!@join_base || !grep{$t eq $_}@join_base)) {
                        my $k = $doc->findvalue("//*[\@id='$t']/\@key");
                        my $f = $doc->findvalue("//*[\@id='$t']/\@field");
                        push @join, "dims.\"${t}_${k}\" = \"$core\".\"$f\"";
+                       push @join_base, $t;
                }
        }
 
        my @where;
        my @bind;
-       for my $t ( keys %{$$r{filter}} ) {
+       for my $t ( keys %{$$p{filter}} ) {
                my $t_name = $t;
                $t_name = "dims" if ($t ne $core);
 
                my $t_node = table_by_id($t);
 
-               for my $c ( keys %{$$r{filter}{$t}} ) {
+               for my $c ( keys %{$$p{filter}{$t}} ) {
                        my $label = $t_node->findvalue("fields/field[\@name='$c']/label");
 
                        my $full_col = $c;
@@ -209,9 +364,9 @@ sub generate_query {
 
                        # XXX make this use widget specific code
 
-                       my ($fam) = keys %{ $$r{filter}{$t}{$c} };
-                       my ($w) = keys %{ $$r{filter}{$t}{$c}{$fam} };
-                       my $val = $$r{filter}{$t}{$c}{$fam}{$w};
+                       my ($fam) = keys %{ $$p{filter}{$t}{$c} };
+                       my ($w) = keys %{ $$p{filter}{$t}{$c}{$fam} };
+                       my $val = $$p{filter}{$t}{$c}{$fam}{$w};
 
                        if (ref $val) {
                                push @where, "$full_col IN (".join(",",map {'?'}@$val).")";
@@ -221,6 +376,13 @@ sub generate_query {
                                push @bind, $val;
                        }
                }
+
+               if ($t ne $t_name && (!@join_base || !grep{$t eq $_}@join_base)) {
+                       my $k = $doc->findvalue("//*[\@id='$t']/\@key");
+                       my $f = $doc->findvalue("//*[\@id='$t']/\@field");
+                       push @join, "dims.\"${t}_${k}\" = \"$core\".\"$f\"";
+                       push @join_base, $t;
+               }
        }
 
        my $t = table_by_id($core)->findvalue('tablename');
@@ -231,10 +393,10 @@ sub generate_query {
                  ' WHERE '.join(' AND ', @where).
                  ' GROUP BY '.join(',',@groupby);
 
-       warn " !!! [$select]\n";
-       warn " !!! [".join(', ',@bind)."]\n";
-
-       return [ $select, @bind ];
+       $r->{sql}->{'select'}   = $select;
+       $r->{sql}->{'bind'}     = \@bind;
+       $r->{sql}->{columns}    = \@columns;
+       
 }