9 use DateTime::Format::ISO8601;
12 use OpenILS::WWW::Reporter::transforms;
14 use Spreadsheet::WriteExcel;
15 use OpenSRF::EX qw/:try/;
16 use OpenSRF::Utils qw/:daemon/;
17 use OpenSRF::Utils::Logger qw/:level/;
19 my $current_time = DateTime->from_epoch( epoch => time() )->strftime('%FT%T%z');
21 my ($base_xml, $count, $daemon) = ('/openils/conf/reporter.xml', 1);
24 "file=s" => \$base_xml,
26 "concurrency=i" => \$count,
29 my $parser = XML::LibXML->new;
30 $parser->expand_xinclude(1);
32 my $doc = $parser->parse_file($base_xml);
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');
40 my $dsn = "dbi:" . $db_driver . ":dbname=" . $db_name .';host=' . $db_host;
44 daemonize("Clark Kent, waiting for trouble") if ($daemon);
48 $dbh = DBI->connect($dsn,$db_user,$db_pw);
50 # Move new reports into the run queue
51 $dbh->do(<<'SQL', {}, $current_time);
52 INSERT INTO reporter.output ( stage3, state )
56 AND ( ( recurrence = '0 seconds'::INTERVAL
57 AND id NOT IN ( SELECT stage3 FROM reporter.output ) )
58 OR ( recurrence > '0 seconds'::INTERVAL
62 WHERE state <> 'complete')
68 # make sure we're not already running $count reports
69 my ($running) = $dbh->selectrow_array(<<SQL);
72 WHERE state = 'running';
75 if ($count <= $running) {
76 print "Already running maximum ($running) concurrent reports\n";
80 # if we have some open slots then generate the sql
81 my $run = $count - $running;
83 my $sth = $dbh->prepare(<<SQL);
94 while (my $r = $sth->fetchrow_hashref) {
95 my $s3 = $dbh->selectrow_hashref(<<" SQL", {}, $r->{stage3});
96 SELECT * FROM reporter.stage3 WHERE id = ?;
99 my $s2 = $dbh->selectrow_hashref(<<" SQL", {}, $s3->{stage2});
100 SELECT * FROM reporter.stage2 WHERE id = ?;
106 generate_query( $r );
114 # Now we spaun the report runners
116 for my $r ( @reports ) {
117 next if (safe_fork());
119 # This is the child (runner) process;
120 my $p = JSON->JSON2perl( $r->{stage3}->{params} );
121 daemonize("Clark Kent reporting: $p->{reportname}");
123 $dbh = DBI->connect($dsn,$db_user,$db_pw);
127 $dbh->do(<<' SQL',{}, $r->{sql}->{'select'}, $$, $r->{id});
128 UPDATE reporter.output
129 SET state = 'running',
136 $sth = $dbh->prepare($r->{sql}->{'select'});
138 $sth->execute(@{ $r->{sql}->{'bind'} });
139 $r->{data} = $sth->fetchall_arrayref;
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};
149 mkdir("$base/$s1/$s2");
150 mkdir("$base/$s1/$s2/$s3");
151 mkdir("$base/$s1/$s2/$s3/$output");
154 if (ref $p->{output_format}) {
155 @formats = @{ $p->{output_format} };
157 @formats = ( $p->{output_format} );
160 if ( grep { $_ eq 'csv' } @formats ) {
161 build_csv("$base/$s1/$s2/$s3/$output/report-data.csv", $r);
164 if ( grep { $_ eq 'excel' } @formats ) {
165 build_excel("$base/$s1/$s2/$s3/$output/report-data.xls", $r);
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);
175 $dbh->do(<<' SQL',{}, $r->{stage3}->{id});
176 UPDATE reporter.stage3
177 SET runtime = runtime + recurrence
178 WHERE id = ? AND recurrence > '0 seconds'::INTERVAL;
180 $dbh->do(<<' SQL',{}, $r->{id});
181 UPDATE reporter.output
182 SET state = 'complete',
183 complete_time = 'now'
192 $dbh->do(<<' SQL',{}, $e, $r->{id});
193 UPDATE reporter.output
204 exit; # leave the child
212 #-------------------------------------------------------------------
218 my $csv = Text::CSV_XS->new({ always_quote => 1, eol => "\015\012" });
219 my $f = new FileHandle (">$file");
221 $csv->print($f, $r->{sql}->{columns});
222 $csv->print($f, $_) for (@{$r->{data}});
229 my $p = JSON->JSON2perl( $r->{stage3}->{params} );
231 my $xls = Spreadsheet::WriteExcel->new($file);
232 my $sheet = $xls->add_worksheet($p->{reportname});
234 $sheet->write_row('A1', $r->{sql}->{columns});
236 $sheet->write_col('A2', $r->{data});
245 my ($node) = $doc->findnodes("//*[\@id='$id']");
246 if ($node && $node->findvalue('@table')) {
247 ($node) = $doc->findnodes("//*[\@id='".$node->getAttribute('table')."']");
255 my $p = JSON->JSON2perl( $r->{stage3}->{params} );
259 my $core = $r->{stage3}->{stage2}->{stage1};
262 for my $t (keys %{$$p{filter}}) {
268 for my $t (keys %{$$p{output}}) {
269 if ($t ne $core && !grep { $t } @dims ) {
277 my $t = table_by_id($d);
278 my $t_name = $t->findvalue('tablename');
279 push @dim_from, "$t_name AS \"$d\"";
281 my $k = $doc->findvalue("//*[\@id='$d']/\@key");
282 push @dim_select, "\"$d\".\"$k\" AS \"${d}_${k}\"";
284 for my $c ( keys %{$$p{output}{$d}} ) {
285 push @dim_select, "\"$d\".\"$c\" AS \"${d}_${c}\"";
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}\"";
295 '(SELECT ' . join(',', @dim_select) .
296 ' FROM ' . join(',', @dim_from) . ') AS dims';
298 my @output_order = map { { (split ':')[1] => (split ':')[2] } } @{ $$p{output_order} };
306 for my $pair (@output_order) {
307 my ($t_name) = keys %$pair;
310 $t_name = "dims" if ($t ne $core);
312 my $t_node = table_by_id($t);
314 for my $c ( values %$pair ) {
315 my $label = $t_node->findvalue("fields/field[\@name='$c']/label");
318 $full_col = "${t}_${c}" if ($t ne $t_name);
319 $full_col = "\"$t_name\".\"$full_col\"";
322 if (my $xform_type = $$p{xform}{type}{$t}{$c}) {
323 my $xform = $$OpenILS::WWW::Reporter::dtype_xforms{$xform_type};
324 if ($xform->{group}) {
327 $label = "$$xform{label} -- $label";
329 my $tmp = $xform->{'select'};
330 $tmp =~ s/\?COLNAME\?/$full_col/gs;
331 $tmp =~ s/\?PARAM\?/$$p{xform}{param}{$t}{$c}/gs;
337 push @output, "$full_col AS \"$label\"";
338 push @columns, $label;
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\"";
352 for my $t ( keys %{$$p{filter}} ) {
354 $t_name = "dims" if ($t ne $core);
356 my $t_node = table_by_id($t);
358 for my $c ( keys %{$$p{filter}{$t}} ) {
359 my $label = $t_node->findvalue("fields/field[\@name='$c']/label");
362 $full_col = "${t}_${c}" if ($t ne $t_name);
363 $full_col = "\"$t_name\".\"$full_col\"";
365 # XXX make this use widget specific code
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};
372 push @where, "$full_col IN (".join(",",map {'?'}@$val).")";
375 push @where, "$full_col = ?";
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\"";
388 my $t = table_by_id($core)->findvalue('tablename');
389 my $from = " FROM $t AS \"$core\" RIGHT JOIN $d_select ON (". join(' AND ', @join).")";
391 "SELECT ".join(',', @output).
393 ' WHERE '.join(' AND ', @where).
394 ' GROUP BY '.join(',',@groupby);
396 $r->{sql}->{'select'} = $select;
397 $r->{sql}->{'bind'} = \@bind;
398 $r->{sql}->{columns} = \@columns;