use DateTime::Format::ISO8601;
use JSON;
use Data::Dumper;
-use OpenILS::WWW::Reporter::transforms;
use Text::CSV_XS;
use Spreadsheet::WriteExcel::Big;
use OpenSRF::EX qw/:try/;
use OpenSRF::Utils qw/:daemon/;
use OpenSRF::Utils::Logger qw/:level/;
+use OpenSRF::System;
+use OpenSRF::AppSession;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Reporter::SQLBuilder;
use POSIX;
use GD::Graph::pie;
use GD::Graph::bars3d;
use GD::Graph::lines3d;
+use Tie::IxHash;
use open ':utf8';
-my ($base_xml, $count, $daemon) = ('/openils/conf/reporter.xml', 1);
+my ($count, $config, $lockfile, $daemon) = (1, '/openils/conf/bootstrap.conf', '/tmp/reporter-LOCK');
GetOptions(
- "file=s" => \$base_xml,
"daemon" => \$daemon,
"concurrency=i" => \$count,
+ "boostrap=s" => \$config,
+ "lockfile=s" => \$lockfile,
);
-my $parser = XML::LibXML->new;
-$parser->expand_xinclude(1);
+if (-e $lockfile) {
+ die "I seem to be running already. If not remove $lockfile, try again\n";
+}
+
+open(F, ">$lockfile");
+print F $$;
+close F;
-my $doc = $parser->parse_file($base_xml);
+OpenSRF::System->bootstrap_client( config_file => $config );
-my $db_driver = $doc->findvalue('/reporter/setup/database/driver');
-my $db_host = $doc->findvalue('/reporter/setup/database/host');
-my $db_port = $doc->findvalue('/reporter/setup/database/port') || '5432';
-my $db_name = $doc->findvalue('/reporter/setup/database/name');
-my $db_user = $doc->findvalue('/reporter/setup/database/user');
-my $db_pw = $doc->findvalue('/reporter/setup/database/password');
+# XXX Get this stuff from the settings server
+my $sc = OpenSRF::Utils::SettingsClient->new;
+my $db_driver = $sc->config_value( reporter => setup => database => 'driver' );
+my $db_host = $sc->config_value( reporter => setup => database => 'host' );
+my $db_port = $sc->config_value( reporter => setup => database => 'port' );
+my $db_name = $sc->config_value( reporter => setup => database => 'name' );
+my $db_user = $sc->config_value( reporter => setup => database => 'user' );
+my $db_pw = $sc->config_value( reporter => setup => database => 'password' );
+
+my $output_base = $sc->config_value( reporter => setup => files => 'output_base' );
my $dsn = "dbi:" . $db_driver . ":dbname=" . $db_name .';host=' . $db_host . ';port=' . $db_port;
$dbh = DBI->connect($dsn,$db_user,$db_pw, {pg_enable_utf8 => 1, RaiseError => 1});
$current_time = DateTime->from_epoch( epoch => time() )->strftime('%FT%T%z');
-# 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 NOT disable
- AND ( ( recurrence = '0 seconds'::INTERVAL
- AND (
- id NOT IN ( SELECT stage3 FROM reporter.output )
- OR rerun IS TRUE
- )
- )
- 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
($running) = $dbh->selectrow_array(<<SQL);
SELECT count(*)
- FROM reporter.output
- WHERE state = 'running';
+ FROM reporter.schedule
+ WHERE start_time IS NOT NULL AND complete_time IS NULL;
SQL
if ($count <= $running) {
$sth = $dbh->prepare(<<SQL);
SELECT *
- FROM reporter.output
- WHERE state = 'wait'
- ORDER BY queue_time
+ FROM reporter.schedule
+ WHERE start_time IS NULL AND run_time < NOW()
+ ORDER BY run_time
LIMIT $run;
SQL
@reports = ();
while (my $r = $sth->fetchrow_hashref) {
- my $s3 = $dbh->selectrow_hashref(<<" SQL", {}, $r->{stage3});
- SELECT * FROM reporter.stage3 WHERE id = ?;
+ my $s3 = $dbh->selectrow_hashref(<<" SQL", {}, $r->{report});
+ SELECT * FROM reporter.report WHERE id = ?;
SQL
- my $s2 = $dbh->selectrow_hashref(<<" SQL", {}, $s3->{stage2});
- SELECT * FROM reporter.stage2 WHERE id = ?;
+ my $s2 = $dbh->selectrow_hashref(<<" SQL", {}, $s3->{template});
+ SELECT * FROM reporter.template WHERE id = ?;
SQL
- $s3->{stage2} = $s2;
- $r->{stage3} = $s3;
+ $s3->{template} = $s2;
+ $r->{report} = $s3;
- generate_query( $r );
+ my $b = OpenILS::Reporter::SQLBuilder->new;
+ $b->register_params( JSON->JSON2perl( $r->{report}->{data} ) );
+
+ $r->{resultset} = $b->parse_report( JSON->JSON2perl( $r->{report}->{template}->{data} ) );
push @reports, $r;
}
next if (safe_fork());
# This is the child (runner) process;
- my $p = JSON->JSON2perl( $r->{stage3}->{params} );
- daemonize("Clark Kent reporting: $p->{reportname}");
+ daemonize("Clark Kent reporting: $r->{report}->{name}");
$dbh = DBI->connect($dsn,$db_user,$db_pw, {pg_enable_utf8 => 1, RaiseError => 1});
try {
- $dbh->do(<<' SQL',{}, $r->{sql}->{'select'}, $$, $r->{id});
- UPDATE reporter.output
- SET state = 'running',
- run_time = 'now',
- query = ?,
- run_pid = ?
+ $dbh->do(<<' SQL',{}, $r->{id});
+ UPDATE reporter.schedule
+ SET start_time = 'now',
WHERE id = ?;
SQL
- my ($runtime) = $dbh->selectrow_array("SELECT run_time FROM reporter.output WHERE id = ?",{},$r->{id});
- $r->{run_time} = $runtime;
-
- $sth = $dbh->prepare($r->{sql}->{'select'});
+ $sth = $dbh->prepare($r->{resultset}->toSQL);
- $sth->execute(@{ $r->{sql}->{'bind'} });
+ $sth->execute;
$r->{data} = $sth->fetchall_arrayref;
- pivot_data($r);
+ $r->{column_labels} = [$r->{resultset}->column_label_list];
- 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};
+ if ($r->{resultset}->pivot_data && $r->{resultset}->pivot_label) {
+ my @labels = $r->{resultset}->column_label_list;
+ my $newdata = pivot_data(
+ { columns => $r->{column_labels}, data => $r->{data}},
+ $r->{resultset}->pivot_label,
+ $r->{resultset}->pivot_data,
+ $r->{resultset}->pivot_default
+ );
- 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} );
+ $r->{column_labels} = $newdata->{columns};
+ $r->{data} = $newdata->{data};
}
+
+ my $s2 = $r->{report}->{template}->{id};
+ my $s3 = $r->{report}->{id};
+ my $output = $r->{id};
+
+ mkdir($output_base);
+ mkdir("$output_base/$s2");
+ mkdir("$output_base/$s2/$s3");
+ mkdir("$output_base/$s2/$s3/$output");
- if ( grep { $_ eq 'csv' } @formats ) {
- build_csv("$base/$s1/$s2/$s3/$output/report-data.csv", $r);
+ my $output_dir = "$output_base/$s2/$s3/$output";
+
+ if ( $r->{csv_format} eq 't') {
+ build_csv("$output_dir/report-data.csv", $r);
}
- if ( grep { $_ eq 'excel' } @formats ) {
- build_excel("$base/$s1/$s2/$s3/$output/report-data.xls", $r);
+ if ( $r->{excel_format} eq 't') {
+ build_excel("$output_dir/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);
+ if ( $r->{html_format} eq 't') {
+ mkdir("$output_dir/html");
+ build_html("$output_dir/report-data.html", $r);
}
$dbh->begin_work;
- #$dbh->do(<<' SQL',{}, $r->{run_time}, $r->{stage3}->{id});
- # UPDATE reporter.stage3
- # SET runtime = CAST(? AS TIMESTAMP WITH TIME ZONE) + recurrence
- # WHERE id = ? AND recurrence > '0 seconds'::INTERVAL;
- #SQL
- $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->{stage3}->{id});
- UPDATE reporter.stage3
- SET rerun = FALSE
- WHERE id = ? AND rerun = TRUE;
- SQL
+
+ if ($r->{report}->{recur} eq 't') {
+ my $sql = <<' SQL';
+ INSERT INTO reporter.schedule ( report, folder, runner, run_time, email, csv_format, excel_format, html_format)
+ VALUES ( ?, ?, ?, NOW() + ?, ?, ?, ?, ? );
+ SQL
+
+ $dbh->do(
+ $sql,
+ {},
+ $r->{report}->{id},
+ $r->{folder},
+ $r->{runner},
+ $r->{report}->{recurance},
+ $r->{email},
+ $r->{csv_format},
+ $r->{excel_format},
+ $r->{html_format}
+ );
+ }
+
$dbh->do(<<' SQL',{}, $r->{id});
- UPDATE reporter.output
- SET state = 'complete',
- complete_time = 'now'
+ UPDATE reporter.schedule
+ SET complete_time = 'now'
WHERE id = ?;
SQL
+
$dbh->commit;
my $e = shift;
$dbh->rollback;
$dbh->do(<<' SQL',{}, $e, $r->{id});
- UPDATE reporter.output
- SET state = 'error',
- error_time = 'now',
- error = ?,
- run_pid = NULL
+ UPDATE reporter.schedule
+ SET error_text = ?,
+ complete_time = 'now',
+ error_code = 1,
WHERE id = ?;
SQL
};
#-------------------------------------------------------------------
-sub pivot_data {
- my $r = shift;
- my $p = JSON->JSON2perl( $r->{stage3}->{params} );
- my $settings = $r->{sql};
- my $data = $r->{data};
-
- return unless (defined($settings->{pivot}));
-
- my @groups = (map { ($_ - 1) } @{ $settings->{groupby} });
- my @values = (0 .. (scalar(@{$settings->{columns}}) - 1));
- splice(@values,$_,1) for (reverse @groups);
-
- # remove pivot from group-by
- my $count = 0;
- my $pivot_groupby;
- while ($count < scalar(@{$settings->{groupby}})) {
- if (defined $pivot_groupby) {
- $settings->{groupby}->[$count] -= 1;
- if ($settings->{groupby}->[$count] >= $values[0] + 1) {
- $settings->{groupby}->[$count] -= 1;
- }
- } elsif ($settings->{groupby}->[$count] == $settings->{pivot} + 1) {
- $pivot_groupby = $count;
- }
- $count++;
- }
-
-
- # grab positions of non-group-bys
- @values = (0 .. (scalar(@{$settings->{columns}}) - 1));
- splice(@values,$_,1) for (reverse @groups);
-
- # we're only doing one "value" for now, so grab that and remove from headings
- my ($val_col) = @values;
-
- my @remove_me = sort
- { $b <=> $a }
- ($val_col, $settings->{groupby}->[$pivot_groupby] - 1);
-
- # get the groups-to-be
- my @temp_groupby = @groups;
- splice(@temp_groupby, $pivot_groupby, 1);
-
- @groups = map { ($_ - 1) } @{ $settings->{groupby} };
-
- my %p_header;
- for my $row (@$data) {
- $p_header{ $$row[$settings->{pivot}] } = [] unless exists($p_header{ $$row[$settings->{pivot}] });
-
- # add the header from this row's pivot
- push @{ $p_header{ $$row[$settings->{pivot}] } },
- { val => $$row[$val_col], fp => join('', map { defined($_) ? $_ : '' } @$row[@temp_groupby]) };
-
- splice(@$row,$_,1) for (@remove_me);
- }
-
- push @{ $settings->{columns} }, sort keys %p_header;
-
- # remove from headings;
- splice(@{$settings->{columns}},$_,1) for (@remove_me);
-
- # remove pivot from groupby
- splice(@{$settings->{groupby}}, $pivot_groupby, 1);
- @groups = (map { ($_ - 1) } @{ $settings->{groupby} });
-
- my %seenit;
- my @new_data;
- { no warnings;
- for my $row (@$data) {
-
- my $fingerprint = join('',@$row[@groups]);
- next if $seenit{$fingerprint};
-
- $seenit{$fingerprint}++;
-
- for my $h ( sort keys %p_header ) {
- my $found = 0;
- my $bcount = 0;
- for my $blob (@{ $p_header{$h} }) {
- $fingerprint = join('', map { defined($_) ? $_ : '' } @$row[@groups]);
-
- if ($blob->{fp} eq $fingerprint ) {
- push @$row, $blob->{val};
- $found++;
- splice(@{ $p_header{$h} }, $bcount, 1);
- last;
- }
- $bcount++;
- }
- push @$row, 0 if (!$found);
- }
-
- push @new_data, [@$row];
- }
- }
-
- @new_data = sort { data_sorter($a,$b,\@groups) } @new_data;
-
- #replace old data with new
- $r->{data} = \@new_data;
-
-}
-
-sub data_sorter {
- no warnings;
-
- my $_a = shift;
- my $_b = shift;
- my $sort_cols = shift;
-
- for my $col (@$sort_cols) {
- return -1 if (!defined($$_a[$col]));
- return 1 if (!defined($$_b[$col]));
-
- return -1 if ($$_a[$col] lt $$_b[$col]);
- return 1 if ($$_a[$col] gt $$_b[$col]);
- }
- return 0;
-}
-
sub build_csv {
my $file = shift;
my $r = shift;
my $f = new FileHandle (">$file");
- $csv->print($f, $r->{sql}->{columns});
+ $csv->print($f, $r->{column_labels});
$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::Big->new($file);
- my $sheetname = substr($p->{reportname},1,31);
+ my $sheetname = substr($r->{report}->{name},1,31);
$sheetname =~ s/\W/_/gos;
my $sheet = $xls->add_worksheet($sheetname);
- $sheet->write_row('A1', $r->{sql}->{columns});
+ $sheet->write_row('A1', $r->{column_labels});
$sheet->write_col('A2', $r->{data});
sub build_html {
my $file = shift;
my $r = shift;
- my $p = JSON->JSON2perl( $r->{stage3}->{params} );
my $index = new FileHandle (">$file");
my $raw = new FileHandle (">$file.raw.html");
print $index <<" HEADER";
<html>
<head>
- <title>$$p{reportname}</title>
+ <title>$$r{report}{name}</title>
<style>
table { border-collapse: collapse; }
th { background-color: lightgray; }
</style>
</head>
<body>
- <h2><u>$$p{reportname}</u></h2>
+ <h2><u>$$r{report}{name}</u></h2>
+ $$r{report}{description}<br/><br/><br/>
HEADER
# add a link to the raw output html
- print $index "<a href='report-data.html.raw.html'>Raw output data</a><br/><br/><br/><br/>";
+ print $index "<a href='report-data.html.raw.html'>Tabular Output</a><br/><br/><br/><br/>";
# create the raw output html file
- print $raw "<html><head><title>$$p{reportname}</title>";
+ print $raw "<html><head><title>$$r{report}{name}</title>";
print $raw <<' CSS';
<style>
print $raw "</head><body><table>";
{ no warnings;
- print $raw "<tr><th>".join('</th><th>',@{$r->{sql}->{columns}}).'</th></tr>';
- print $raw "<tr><td>".join('</td><td>',@$_ ).'</td></tr>' for (@{$r->{data}});
+ print $raw "<tr><th>".join('</th><th>',@{$r->{column_labels}}).'</th></tr>';
+ print $raw "<tr><td>".join('</td><td>',@$_ ).'</td></tr>' for (@{$r->{data}});
}
print $raw '</table></body></html>';
$raw->close;
- # get the graph types
- my @graphs;
- if (ref $$p{html_graph_type}) {
- @graphs = @{ $$p{html_graph_type} };
- } else {
- @graphs = ( $$p{html_graph_type} );
- }
-
- if ($graphs[0]) {
- # Time for a pie chart
- if (grep {$_ eq 'pie'} @graphs) {
- my $pics = draw_pie($r, $p, $file);
- for my $pic (@$pics) {
- print $index "<img src='report-data.html.$pic->{file}' alt='$pic->{name}'/><br/><br/><br/><br/>";
- }
+ # Time for a pie chart
+ if ($r->{chart_pie} eq 't') {
+ my $pics = draw_pie($r, $file);
+ for my $pic (@$pics) {
+ print $index "<img src='report-data.html.$pic->{file}' alt='$pic->{name}'/><br/><br/><br/><br/>";
}
+ }
- print $index '<br/><br/><br/><br/>';
- # Time for a bar chart
- if (grep {$_ eq 'bar'} @graphs) {
- my $pics = draw_bars($r, $p, $file);
- for my $pic (@$pics) {
- print $index "<img src='report-data.html.$pic->{file}' alt='$pic->{name}'/><br/><br/><br/><br/>";
- }
+ print $index '<br/><br/><br/><br/>';
+ # Time for a bar chart
+ if ($r->{chart_bar} eq 't') {
+ my $pics = draw_bars($r, $file);
+ for my $pic (@$pics) {
+ print $index "<img src='report-data.html.$pic->{file}' alt='$pic->{name}'/><br/><br/><br/><br/>";
}
+ }
- print $index '<br/><br/><br/><br/>';
- # Time for a bar chart
- if (grep {$_ eq 'line'} @graphs) {
- my $pics = draw_lines($r, $p, $file);
- for my $pic (@$pics) {
- print $index "<img src='report-data.html.$pic->{file}' alt='$pic->{name}'/><br/><br/><br/><br/>";
- }
+ print $index '<br/><br/><br/><br/>';
+ # Time for a bar chart
+ if ($r->{chart_line} eq 't') {
+ my $pics = draw_lines($r, $file);
+ for my $pic (@$pics) {
+ print $index "<img src='report-data.html.$pic->{file}' alt='$pic->{name}'/><br/><br/><br/><br/>";
}
}
sub draw_pie {
my $r = shift;
- my $p = shift;
my $file = shift;
+
my $data = $r->{data};
- my $settings = $r->{sql};
- my @groups = (map { ($_ - 1) } @{ $settings->{groupby} });
+ my @groups = $r->{resultset}->group_by_list(0);
- my @values = (0 .. (scalar(@{$settings->{columns}}) - 1));
+ my @values = (0 .. (scalar(@{$r->{column_labels}}) - 1));
delete @values[@groups];
- my $logo = $doc->findvalue('/reporter/setup/files/chart_logo');
+ #my $logo = $doc->findvalue('/reporter/setup/files/chart_logo');
my @pics;
for my $vcol (@values) {
my $pic = new GD::Graph::pie;
$pic->set(
- label => $settings->{columns}->[$vcol],
+ label => $r->{column_labels}->[$vcol],
start_angle => 180,
legend_placement => 'R',
- logo => $logo,
- logo_position => 'TL',
- logo_resize => 0.5,
+ #logo => $logo,
+ #logo_position => 'TL',
+ #logo_resize => 0.5,
show_values => 1,
);
push @pics,
{ file => "pie.$vcol.$sub_graph.$format",
- name => $settings->{columns}->[$vcol].' (Pie)',
+ name => $r->{column_labels}->[$vcol].' (Pie)',
} unless ($forgetit);
last if ($sub_graph == $split);
sub draw_bars {
my $r = shift;
- my $p = shift;
my $file = shift;
my $data = $r->{data};
- my $settings = $r->{sql};
- my $logo = $doc->findvalue('/reporter/setup/files/chart_logo');
+ #my $logo = $doc->findvalue('/reporter/setup/files/chart_logo');
- my @groups = (map { ($_ - 1) } @{ $settings->{groupby} });
+ my @groups = $r->{resultset}->group_by_list(0);
- my @values = (0 .. (scalar(@{$settings->{columns}}) - 1));
+ my @values = (0 .. (scalar(@{$r->{column_labels}}) - 1));
splice(@values,$_,1) for (reverse @groups);
my @pic_data;
return [] unless ($new_data[0] && @{$new_data[0]});
for my $col (@use_me) {
- push @leg, $settings->{columns}->[$col + @groups - 1] if (map { 1 } grep { $col == $_ } @values);
+ push @leg, $r->{column_labels}->[$col + @groups - 1] if (map { 1 } grep { $col == $_ } @values);
}
my $w = 100 + 10 * scalar(@{$new_data[0]});
my $pic = new GD::Graph::bars3d ($w + 250, $h + 500);
$pic->set(
- title => $p->{reportname},
+ title => $r->{report}{name},
x_labels_vertical => 1,
shading => 1,
bar_depth => 5,
y_max_value => $max_y,
legend_placement => 'TR',
boxclr => 'lgray',
- logo => $logo,
- logo_position => 'R',
- logo_resize => 0.5,
+ #logo => $logo,
+ #logo_position => 'R',
+ #logo_resize => 0.5,
show_values => 1,
overwrite => 1,
);
close IMG;
return [{ file => "bar.$format",
- name => $p->{reportname}.' (Bar)',
+ name => $r->{report}{name}.' (Bar)',
}];
}
sub draw_lines {
my $r = shift;
- my $p = shift;
my $file = shift;
my $data = $r->{data};
- my $settings = $r->{sql};
-
- my $logo = $doc->findvalue('/reporter/setup/files/chart_logo');
- my @groups = (map { ($_ - 1) } @{ $settings->{groupby} });
+ #my $logo = $doc->findvalue('/reporter/setup/files/chart_logo');
+ my @groups = $r->{resultset}->group_by_list(0);
- my @values = (0 .. (scalar(@{$settings->{columns}}) - 1));
+ my @values = (0 .. (scalar(@{$r->{column_labels}}) - 1));
splice(@values,$_,1) for (reverse @groups);
my @pic_data;
}
for my $col (@use_me) {
- push @leg, $settings->{columns}->[$col + @groups - 1] if (map { 1 } grep { $col == $_ } @values);
+ push @leg, $r->{column_labels}->[$col + @groups - 1] if (map { 1 } grep { $col == $_ } @values);
}
my $w = 100 + 10 * scalar(@{$new_data[0]});
my $pic = new GD::Graph::lines3d ($w + 250, $h + 500);
$pic->set(
- title => $p->{reportname},
+ title => $r->{report}{name},
x_labels_vertical => 1,
shading => 1,
line_depth => 5,
y_max_value => $max_y,
legend_placement => 'TR',
boxclr => 'lgray',
- logo => $logo,
- logo_position => 'R',
- logo_resize => 0.5,
+ #logo => $logo,
+ #logo_position => 'R',
+ #logo_resize => 0.5,
show_values => 1,
overwrite => 1,
);
close IMG;
return [{ file => "line.$format",
- name => $p->{reportname}.' (Bar)',
+ name => $r->{report}{name}.' (Bar)',
}];
}
-sub table_by_id {
- my $id = shift;
- my ($node) = $doc->findnodes("//*[\@id='$id']");
- if ($node && $node->findvalue('@table')) {
- ($node) = $doc->findnodes("//*[\@id='".$node->getAttribute('table')."']");
- }
- return $node;
-}
-sub generate_query {
- my $r = shift;
+sub pivot_data {
+ my $blob = shift;
+ my $pivot_label = shift;
+ my $pivot_data = shift;
+ my $default = shift;
+ $default = 0 unless (defined $default);
- my $p = JSON->JSON2perl( $r->{stage3}->{params} );
+ my $data = $$blob{data};
+ my $cols = $$blob{columns};
- my @group_by = ();
- my @aggs = ();
- my $core = $r->{stage3}->{stage2}->{stage1};
- my @dims = ();
+ my @keep_labels = @$cols;
+ splice(@keep_labels, $_ - 1, 1) for (reverse sort ($pivot_label, $pivot_data));
- for my $t (keys %{$$p{filter}}) {
- if ($t ne $core) {
- push @dims, $t;
- }
- }
+ my @keep_cols = (0 .. @$cols - 1);
+ splice(@keep_cols, $_ - 1, 1) for (reverse sort ($pivot_label, $pivot_data));
- for my $t (keys %{$$p{output}}) {
- if ($t ne $core && !(grep { $t eq $_ } @dims) ) {
- push @dims, $t;
- }
- }
-
- my @dim_select = ();
- my @dim_from = ();
- for my $d (@dims) {
- my $t = table_by_id($d);
- my $t_name = $t->findvalue('tablename');
- push @dim_from, "$t_name AS \"$d\""
- unless ( grep {$_ eq "$t_name AS \"$d\""} @dim_from );
-
- my $k = $doc->findvalue("//*[\@id='$d']/\@key");
- push @dim_select, "\"$d\".\"$k\" AS \"${d}_${k}\""
- unless ( grep {$_ eq "\"$d\".\"$k\" AS \"${d}_${k}\""} @dim_select );
-
- for my $c ( keys %{$$p{output}{$d}} ) {
- push @dim_select, "\"$d\".\"$c\" AS \"${d}_${c}\""
- unless ( grep {$_ eq "\"$d\".\"$c\" AS \"${d}_${c}\""} @dim_select );
- }
-
- for my $c ( keys %{$$p{filter}{$d}} ) {
- next if (exists $$p{output}{$d}{$c});
- push @dim_select, "\"$d\".\"$c\" AS \"${d}_${c}\""
- unless ( grep {$_ eq "\"$d\".\"$c\" AS \"${d}_${c}\""} @dim_select );
- }
+ #first, find the unique list of pivot values
+ my %tmp;
+ for my $row (@$data) {
+ $tmp{ $$row[$pivot_label - 1] } = 1;
}
+ my @new_cols = sort keys %tmp;
- my $d_select =
- '(SELECT ' . join(',', @dim_select) .
- ' FROM ' . join(',', @dim_from) . ') AS dims';
-
- my @opord = ();
- if (ref $$p{output_order}) {
- @opord = @{ $$p{output_order} };
- } else {
- @opord = ( $$p{output_order} );
- }
- my @output_order = map { { (split ':')[1] => (split ':')[2] } } @opord;
- my @p_col = split(':',$p->{pivot_col}) if $p->{pivot_col};
- my $pivot = undef;
-
- my $col = 1;
- my @groupby = ();
- my @output = ();
- my @dim_col_names = ();
- my @columns = ();
- my @join = ();
- 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 ( values %$pair ) {
- my $label = $t_node->findvalue("fields/field[\@name='$c']/label");
-
- my $full_col = $c;
- $full_col = "${t}_${c}" if ($t ne $t_name);
- $full_col = "\"$t_name\".\"$full_col\"";
-
- if (my $xform_type = $$p{xform}{type}{$t}{$c}) {
- my $xform = $$OpenILS::WWW::Reporter::dtype_xforms{$xform_type};
- if ($xform->{group}) {
- push @groupby, $col;
- }
- $label = "$$xform{label} -- $label";
-
- my $tmp = $xform->{'select'};
- $tmp =~ s/\?COLNAME\?/$full_col/gs;
- $tmp =~ s/\?PARAM\?/$$p{xform}{param}{$t}{$c}/gs;
- $full_col = $tmp;
- } else {
- push @groupby, $col;
- }
+ tie my %split_data, 'Tie::IxHash';
+ for my $row (@$data) {
- push @output, "$full_col AS \"$label\"";
- push @columns, $label;
- $pivot = scalar(@columns) - 1 if (@p_col && $t eq $p_col[1] && $c eq $p_col[2]);
- $col++;
- }
+ my $row_fp = ''. join('', map { defined($$row[$_]) ? $$row[$_] : '' } @keep_cols);
+ $split_data{$row_fp} ||= [];
- 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;
- }
+ push @{ $split_data{$row_fp} }, $row;
}
- my @where = ();
- my @bind = ();
- 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 %{$$p{filter}{$t}} ) {
- my $label = $t_node->findvalue("fields/field[\@name='$c']/label");
- my $full_col = $c;
- $full_col = "${t}_${c}" if ($t ne $t_name);
- $full_col = "\"$t_name\".\"$full_col\"";
+ #now loop over the data, building a new result set
+ tie my %new_data, 'Tie::IxHash';
- my ($fam) = keys %{ $$p{filter}{$t}{$c} };
- my ($w) = keys %{ $$p{filter}{$t}{$c}{$fam} };
- my $val = $$p{filter}{$t}{$c}{$fam}{$w};
+ for my $fp ( keys %split_data ) {
- my $filter_code_xpath = "/reporter/widgets/widget-family[\@name='$fam']/widget[\@name='$w']/filter-code[\@type='perl']";
- if (my $widget_code = $doc->findvalue($filter_code_xpath)) { # widget supplys it's own filter code
- my ($where_clause, $bind_list) = ('',[]);
+ $new_data{$fp} = [];
- eval $widget_code;
-
- die "$@\n\n$widget_code" if ($@);
-
- push @where, $where_clause;
- push @bind, @$bind_list;
-
- } elsif (ref $val) {
- push @where, "$full_col IN (".join(",",map {'?'}@$val).")";
- push @bind, @$val;
- } else {
- push @where, "$full_col = ?";
- push @bind, $val;
- }
+ for my $col (@keep_cols) {
+ push @{ $new_data{$fp} }, $split_data{$fp}[0][$col];
}
- 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;
+ for my $col (@new_cols) {
+
+ my ($datum) = map { $_->[$pivot_data - 1] } grep { $_->[$pivot_label - 1] eq $col } @{ $split_data{$fp} };
+ $datum ||= $default;
+ push @{ $new_data{$fp} }, $datum;
}
}
- my $t = table_by_id($core)->findvalue('tablename');
-
- my $from = " FROM $t AS \"$core\" ";
- $from .= "RIGHT JOIN $d_select ON (". join(' AND ', @join).")" if ( @join );
-
- my $select =
- "SELECT ".join(',', @output). $from;
+ push @keep_labels, @new_cols;
- $select .= ' WHERE '.join(' AND ', @where) if (@where);
- $select .= ' GROUP BY '.join(',',@groupby) if (@groupby);
-
- $r->{sql}->{'pivot'} = $pivot;
- $r->{sql}->{'select'} = $select;
- $r->{sql}->{'bind'} = \@bind;
- $r->{sql}->{columns} = \@columns;
- $r->{sql}->{groupby} = \@groupby;
-
+ return { columns => \@keep_labels, data => [ values %new_data ] };
}
-
-
-
-
projects / evergreen / pines.git / commitdiff