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 use POSIX;
  19 use GD::Graph::pie;
  20 use GD::Graph::bars3d;
  21 use GD::Graph::lines;
  22
  23 use open ':utf8';
  24
  25 my $current_time = DateTime->from_epoch( epoch => time() )->strftime('%FT%T%z');
  26
  27 my ($base_xml, $count, $daemon) = ('/openils/conf/reporter.xml', 1);
  28
  29 GetOptions(
  30         "file=s"        => \$base_xml,
  31         "daemon"        => \$daemon,
  32         "concurrency=i" => \$count,
  33 );
  34
  35 my $parser = XML::LibXML->new;
  36 $parser->expand_xinclude(1);
  37
  38 my $doc = $parser->parse_file($base_xml);
  39
  40 my $db_driver = $doc->findvalue('/reporter/setup/database/driver');
  41 my $db_host = $doc->findvalue('/reporter/setup/database/host');
  42 my $db_name = $doc->findvalue('/reporter/setup/database/name');
  43 my $db_user = $doc->findvalue('/reporter/setup/database/user');
  44 my $db_pw = $doc->findvalue('/reporter/setup/database/password');
  45
  46 my $dsn = "dbi:" . $db_driver . ":dbname=" . $db_name .';host=' . $db_host;
  47
  48 my $dbh;
  49
  50 daemonize("Clark Kent, waiting for trouble") if ($daemon);
  51
  52 DAEMON:
  53
  54 $dbh = DBI->connect($dsn,$db_user,$db_pw, {pg_enable_utf8 => 1, RaiseError => 1});
  55
  56 # Move new reports into the run queue
  57 $dbh->do(<<'SQL', {}, $current_time);
  58 INSERT INTO reporter.output ( stage3, state )
  59         SELECT  id, 'wait'
  60           FROM  reporter.stage3
  61           WHERE runtime <= $1
  62                 AND (   (       recurrence = '0 seconds'::INTERVAL
  63                                 AND id NOT IN ( SELECT stage3 FROM reporter.output ) )
  64                         OR (    recurrence > '0 seconds'::INTERVAL
  65                                 AND id NOT IN (
  66                                         SELECT  stage3
  67                                           FROM  reporter.output
  68                                           WHERE state <> 'complete')
  69                         )
  70                 )
  71           ORDER BY runtime;
  72 SQL
  73
  74 # make sure we're not already running $count reports
  75 my ($running) = $dbh->selectrow_array(<<SQL);
  76 SELECT  count(*)
  77   FROM  reporter.output
  78   WHERE state = 'running';
  79 SQL
  80
  81 if ($count <= $running) {
  82         if ($daemon) {
  83                 $dbh->disconnect;
  84                 sleep 1;
  85                 POSIX::waitpid( -1, POSIX::WNOHANG );
  86                 sleep 60;
  87                 goto DAEMON;
  88         }
  89         print "Already running maximum ($running) concurrent reports\n";
  90         exit 1;
  91 }
  92
  93 # if we have some open slots then generate the sql
  94 my $run = $count - $running;
  95
  96 my $sth = $dbh->prepare(<<SQL);
  97 SELECT  *
  98   FROM  reporter.output
  99   WHERE state = 'wait'
 100   ORDER BY queue_time
 101   LIMIT $run;
 102 SQL
 103
 104 $sth->execute;
 105
 106 my @reports;
 107 while (my $r = $sth->fetchrow_hashref) {
 108         my $s3 = $dbh->selectrow_hashref(<<"    SQL", {}, $r->{stage3});
 109                 SELECT * FROM reporter.stage3 WHERE id = ?;
 110         SQL
 111
 112         my $s2 = $dbh->selectrow_hashref(<<"    SQL", {}, $s3->{stage2});
 113                 SELECT * FROM reporter.stage2 WHERE id = ?;
 114         SQL
 115
 116         $s3->{stage2} = $s2;
 117         $r->{stage3} = $s3;
 118
 119         generate_query( $r );
 120         push @reports, $r;
 121 }
 122
 123 $sth->finish;
 124
 125 $dbh->disconnect;
 126
 127 # Now we spaun the report runners
 128
 129 for my $r ( @reports ) {
 130         next if (safe_fork());
 131
 132         # This is the child (runner) process;
 133         my $p = JSON->JSON2perl( $r->{stage3}->{params} );
 134         daemonize("Clark Kent reporting: $p->{reportname}");
 135
 136         $dbh = DBI->connect($dsn,$db_user,$db_pw, {pg_enable_utf8 => 1, RaiseError => 1});
 137
 138         try {
 139                 $dbh->do(<<'            SQL',{}, $r->{sql}->{'select'}, $$, $r->{id});
 140                         UPDATE  reporter.output
 141                           SET   state = 'running',
 142                                 run_time = 'now',
 143                                 query = ?,
 144                                 run_pid = ?
 145                           WHERE id = ?;
 146                 SQL
 147
 148                 $sth = $dbh->prepare($r->{sql}->{'select'});
 149
 150                 $sth->execute(@{ $r->{sql}->{'bind'} });
 151                 $r->{data} = $sth->fetchall_arrayref;
 152
 153                 pivot_data($r, $p);
 154
 155                 my $base = $doc->findvalue('/reporter/setup/files/output_base');
 156                 my $s1 = $r->{stage3}->{stage2}->{stage1};
 157                 my $s2 = $r->{stage3}->{stage2}->{id};
 158                 my $s3 = $r->{stage3}->{id};
 159                 my $output = $r->{id};
 160
 161                 mkdir($base);
 162                 mkdir("$base/$s1");
 163                 mkdir("$base/$s1/$s2");
 164                 mkdir("$base/$s1/$s2/$s3");
 165                 mkdir("$base/$s1/$s2/$s3/$output");
 166
 167                 my @formats;
 168                 if (ref $p->{output_format}) {
 169                         @formats = @{ $p->{output_format} };
 170                 } else {
 171                         @formats = ( $p->{output_format} );
 172                 }
 173
 174                 if ( grep { $_ eq 'csv' } @formats ) {
 175                         build_csv("$base/$s1/$s2/$s3/$output/report-data.csv", $r);
 176                 }
 177
 178                 if ( grep { $_ eq 'excel' } @formats ) {
 179                         build_excel("$base/$s1/$s2/$s3/$output/report-data.xls", $r);
 180                 }
 181
 182                 if ( grep { $_ eq 'html' } @formats ) {
 183                         mkdir("$base/$s1/$s2/$s3/$output/html");
 184                         build_html("$base/$s1/$s2/$s3/$output/report-data.html", $r);
 185                 }
 186
 187
 188                 $dbh->begin_work;
 189                 $dbh->do(<<'            SQL',{}, $r->{stage3}->{id});
 190                         UPDATE  reporter.stage3
 191                           SET   runtime = runtime + recurrence
 192                           WHERE id = ? AND recurrence > '0 seconds'::INTERVAL;
 193                 SQL
 194                 $dbh->do(<<'            SQL',{}, $r->{id});
 195                         UPDATE  reporter.output
 196                           SET   state = 'complete',
 197                                 complete_time = 'now'
 198                           WHERE id = ?;
 199                 SQL
 200                 $dbh->commit;
 201
 202
 203         } otherwise {
 204                 my $e = shift;
 205                 $dbh->rollback;
 206                 $dbh->do(<<'            SQL',{}, $e, $r->{id});
 207                         UPDATE  reporter.output
 208                           SET   state = 'error',
 209                                 error_time = 'now',
 210                                 error = ?,
 211                                 run_pid = NULL
 212                           WHERE id = ?;
 213                 SQL
 214         };
 215
 216         $dbh->disconnect;
 217
 218         exit; # leave the child
 219 }
 220
 221 if ($daemon) {
 222         sleep 1;
 223         POSIX::waitpid( -1, POSIX::WNOHANG );
 224         sleep 60;
 225         goto DAEMON;
 226 }
 227
 228 #-------------------------------------------------------------------
 229
 230 sub pivot_data {
 231         my $r = shift;
 232         my $p = shift;
 233         my $settings = $r->{sql};
 234         my $data = $r->{data};
 235
 236         return unless (defined($settings->{pivot}));
 237
 238         my @groups = (map { ($_ - 1) } @{ $settings->{groupby} });
 239
 240         # remove pivot from group-by
 241         my $count = 0;
 242         my $pivot_groupby;
 243         while ($count < scalar(@{$settings->{groupby}})) {
 244                 if (defined $pivot_groupby) {
 245                         $settings->{groupby}->[$count] -= 1;
 246                 } elsif ($settings->{groupby}->[$count] == $settings->{pivot} + 1) {
 247                         $pivot_groupby = $count;
 248                 }
 249                 $count++;
 250         }
 251
 252
 253         # grab positions of non-group-bys
 254         my @values = (0 .. (scalar(@{$settings->{columns}}) - 1));
 255         splice(@values,$_,1) for (reverse @groups);
 256
 257         # we're only doing one "value" for now, so grab that and remove from headings
 258         my ($val_col) = @values;
 259
 260         my @remove_me = sort
 261                 { $b <=> $a }
 262                 ($val_col, $settings->{groupby}->[$pivot_groupby] - 1);
 263
 264         my %p_header;
 265         for my $row (@$data) {
 266                 $p_header{ $$row[$settings->{pivot}] }++;
 267                 push @values, $$row[$val_col];
 268                 splice(@$row,$_,1) for (@remove_me);
 269         }
 270         push @{ $settings->{columns} }, sort keys %p_header;
 271
 272         # remove from headings;
 273         splice(@{$settings->{columns}},$_,1) for (@remove_me);
 274
 275         # remove pivot from groupby
 276         splice(@{$settings->{groupby}}, $pivot_groupby, 1);
 277         @groups = (map { ($_ - 1) } @{ $settings->{groupby} });
 278
 279         $count = scalar(keys %p_header);
 280         my %seenit;
 281         my @new_data;
 282         for my $row (@$data) {
 283                 my $fingerprint = join('',@$row[@groups]);
 284                 next if $seenit{$fingerprint};
 285                 $seenit{$fingerprint}++;
 286                 push @$row, splice(@values,0,$count);
 287                 push @new_data, [@$row];
 288         }
 289
 290         #replace old data with new
 291         $r->{data} = \@new_data;
 292
 293 }
 294
 295 sub build_csv {
 296         my $file = shift;
 297         my $r = shift;
 298
 299         my $csv = Text::CSV_XS->new({ always_quote => 1, eol => "\015\012" });
 300         my $f = new FileHandle (">$file");
 301
 302         $csv->print($f, $r->{sql}->{columns});
 303         $csv->print($f, $_) for (@{$r->{data}});
 304
 305         $f->close;
 306 }
 307 sub build_excel {
 308         my $file = shift;
 309         my $r = shift;
 310         my $p = JSON->JSON2perl( $r->{stage3}->{params} );
 311
 312         my $xls = Spreadsheet::WriteExcel->new($file);
 313
 314         my $sheetname = substr($p->{reportname},1,31);
 315         $sheetname =~ s/\W/_/gos;
 316
 317         my $sheet = $xls->add_worksheet($sheetname);
 318
 319         $sheet->write_row('A1', $r->{sql}->{columns});
 320
 321         $sheet->write_col('A2', $r->{data});
 322
 323         $xls->close;
 324 }
 325
 326 sub build_html {
 327         my $file = shift;
 328         my $r = shift;
 329         my $p = JSON->JSON2perl( $r->{stage3}->{params} );
 330
 331         my $index = new FileHandle (">$file");
 332         my $raw = new FileHandle (">$file.raw.html");
 333
 334         # index header
 335         print $index <<"        HEADER";
 336 <html>
 337         <head>
 338                 <title>$$p{reportname}</title>
 339                 <style>
 340                         table { border-collapse: collapse; }
 341                         th { background-color: lightgray; }
 342                         td,th { border: solid black 1px; }
 343                         * { font-family: sans-serif; font-size: 10px; }
 344                 </style>
 345         </head>
 346         <body>
 347                 <h2><u>$$p{reportname}</u></h2>
 348         HEADER
 349
 350
 351         # add a link to the raw output html
 352         print $index "<a href='report-data.html.raw.html'>Raw output data</a><br/><br/><br/><br/>";
 353
 354         # create the raw output html file
 355         print $raw "<html><head><title>$$p{reportname}</title>";
 356
 357         print $raw <<'  CSS';
 358                 <style>
 359                         table { border-collapse: collapse; }
 360                         th { background-color: lightgray; }
 361                         td,th { border: solid black 1px; }
 362                         * { font-family: sans-serif; font-size: 10px; }
 363                 </style>
 364         CSS
 365
 366         print $raw "</head><body><table>";
 367         print $raw "<tr><th>".join('</th><th>',@{$r->{sql}->{columns}}).'</th></tr>';
 368
 369         print $raw "<tr><td>".join('</td><td>',@$_).'</td></tr>' for (@{$r->{data}});
 370
 371         print $raw '</table></body></html>';
 372
 373         $raw->close;
 374
 375         # get the graph types
 376         my @graphs;
 377         if (ref $$p{html_graph_type}) {
 378                 @graphs = @{ $$p{html_graph_type} };
 379         } else {
 380                 @graphs = ( $$p{html_graph_type} );
 381         }
 382
 383         # Time for a pie chart
 384         if (grep {$_ eq 'pie'} @graphs) {
 385                 my $pics = draw_pie($r, $p, $file);
 386                 for my $pic (@$pics) {
 387                         print $index "<img src='report-data.html.$pic->{file}' alt='$pic->{name}'/><br/><br/><br/><br/>";
 388                 }
 389         }
 390
 391         # Time for a bar chart
 392         if (grep {$_ eq 'bar'} @graphs) {
 393                 my $pics = draw_bars($r, $p, $file);
 394                 for my $pic (@$pics) {
 395                         print $index "<img src='report-data.html.$pic->{file}' alt='$pic->{name}'/><br/><br/><br/><br/>";
 396                 }
 397         }
 398
 399
 400         # and that's it!
 401         print $index '</body></html>';
 402
 403         $index->close;
 404 }
 405
 406 sub draw_pie {
 407         my $r = shift;
 408         my $p = shift;
 409         my $file = shift;
 410         my $data = $r->{data};
 411         my $settings = $r->{sql};
 412
 413         my @groups = (map { ($_ - 1) } @{ $settings->{groupby} });
 414
 415         my @values = (0 .. (scalar(@{$settings->{columns}}) - 1));
 416         delete @values[@groups];
 417
 418         my $logo = $doc->findvalue('/reporter/setup/files/chart_logo');
 419
 420         my @pics;
 421         for my $vcol (@values) {
 422                 next unless (defined $vcol);
 423
 424                 my @pic_data;
 425                 for my $row (@$data) {
 426                         next if (!defined($$row[$vcol]) || $$row[$vcol] == 0);
 427                         push @{$pic_data[0]}, join(' -- ', @$row[@groups]);
 428                         push @{$pic_data[1]}, $$row[$vcol];
 429                 }
 430
 431                 my $pic = new GD::Graph::pie;
 432
 433                 $pic->set(
 434                         label                   => $p->{reportname}." -- ".$settings->{columns}->[$vcol],
 435                         start_angle             => 180,
 436                         legend_placement        => 'R',
 437                         logo                    => $logo,
 438                         logo_position           => 'TL',
 439                         logo_resize             => 0.5,
 440                         show_values             => 1,
 441                 );
 442
 443                 my $format = $pic->export_format;
 444
 445                 open(IMG, ">$file.pie.$vcol.$format");
 446                 binmode IMG;
 447
 448                 my $forgetit = 0;
 449                 try {
 450                         $pic->plot(\@pic_data) or die $pic->error;
 451                         print IMG $pic->gd->$format;
 452                 } otherwise {
 453                         my $e = shift;
 454                         warn "Couldn't draw $file.pie.$vcol.$format : $e";
 455                         $forgetit = 1;
 456                 };
 457
 458                 close IMG;
 459
 460                 next if ($forgetit);
 461
 462                 push @pics,
 463                         { file => "pie.$vcol.$format",
 464                           name => $p->{reportname}." -- ".$settings->{columns}->[$vcol].' (Pie)',
 465                         };
 466
 467         }
 468
 469         return \@pics;
 470 }
 471
 472 sub draw_bars {
 473         my $r = shift;
 474         my $p = shift;
 475         my $file = shift;
 476         my $data = $r->{data};
 477         my $settings = $r->{sql};
 478
 479         my $logo = $doc->findvalue('/reporter/setup/files/chart_logo');
 480
 481         my @groups = (map { ($_ - 1) } @{ $settings->{groupby} });
 482
 483         my @values = (0 .. (scalar(@{$settings->{columns}}) - 1));
 484         delete @values[@groups];
 485         @values = grep {defined $_} @values;
 486
 487         my @pic_data;
 488         {       no warnings;
 489                 for my $row (@$data) {
 490                         push @{$pic_data[0]}, join(' -- ', @$row[@groups]);
 491                 }
 492         }
 493
 494         my @leg;
 495         my $set = 1;
 496
 497         my %trim_candidates;
 498
 499         my $max_y = 0;
 500         for my $vcol (@values) {
 501                 next unless (defined $vcol);
 502
 503                 push @leg, $settings->{columns}->[$vcol];
 504
 505                 my $pos = 0;
 506                 for my $row (@$data) {
 507                         my $val = $$row[$vcol] ? $$row[$vcol] : 0;
 508                         push @{$pic_data[$set]}, $val;
 509                         $max_y = $val if ($val > $max_y);
 510                         $trim_candidates{$pos}++ if ($val == 0);
 511                         $pos++;
 512                 }
 513
 514                 $set++;
 515         }
 516         my $set_count = scalar(@pic_data) - 1;
 517         my @trim_cols = grep { $trim_candidates{$_} == $set_count } keys %trim_candidates;
 518
 519         for my $dataset (@pic_data) {
 520                 for my $col (reverse sort { $a <=> $b } @trim_cols) {
 521                         splice(@$dataset,$col,1);
 522                 }
 523         }
 524
 525         my $w = 100 + 10 * scalar(@{$pic_data[0]});
 526         $w = 400 if ($w < 400);
 527
 528         my $h = 10 * (scalar(@pic_data) - 30);
 529
 530         $h = 0 if ($h < 0);
 531
 532         my $pic = new GD::Graph::bars3d ($w + 250, $h + 500);
 533
 534         $pic->set(
 535                 title                   => $p->{reportname},
 536                 x_labels_vertical       => 1,
 537                 shading                 => 1,
 538                 bar_depth               => 5,
 539                 bar_spacing             => 2,
 540                 y_max_value             => $max_y,
 541                 legend_placement        => 'TR',
 542                 boxclr                  => 'lgray',
 543                 logo                    => $logo,
 544                 logo_position           => 'R',
 545                 logo_resize             => 0.5,
 546                 show_values             => 1,
 547                 overwrite               => 1,
 548         );
 549         $pic->set_legend(@leg);
 550
 551         my $format = $pic->export_format;
 552
 553         open(IMG, ">$file.bar.$format");
 554         binmode IMG;
 555
 556         try {
 557                 $pic->plot(\@pic_data) or die $pic->error;
 558                 print IMG $pic->gd->$format;
 559         } otherwise {
 560                 my $e = shift;
 561                 warn "Couldn't draw $file.bar.$format : $e";
 562         };
 563
 564         close IMG;
 565
 566         return [{ file => "bar.$format",
 567                   name => $p->{reportname}.' (Bar)',
 568                 }];
 569
 570 }
 571
 572 sub table_by_id {
 573         my $id = shift;
 574         my ($node) = $doc->findnodes("//*[\@id='$id']");
 575         if ($node && $node->findvalue('@table')) {
 576                 ($node) = $doc->findnodes("//*[\@id='".$node->getAttribute('table')."']");
 577         }
 578         return $node;
 579 }
 580
 581 sub generate_query {
 582         my $r = shift;
 583
 584         my $p = JSON->JSON2perl( $r->{stage3}->{params} );
 585
 586         my @group_by;
 587         my @aggs;
 588         my $core = $r->{stage3}->{stage2}->{stage1};
 589         my @dims;
 590
 591         for my $t (keys %{$$p{filter}}) {
 592                 if ($t ne $core) {
 593                         push @dims, $t;
 594                 }
 595         }
 596
 597         for my $t (keys %{$$p{output}}) {
 598                 if ($t ne $core && !grep { $t } @dims ) {
 599                         push @dims, $t;
 600                 }
 601         }
 602
 603         my @dim_select;
 604         my @dim_from;
 605         for my $d (@dims) {
 606                 my $t = table_by_id($d);
 607                 my $t_name = $t->findvalue('tablename');
 608                 push @dim_from, "$t_name AS \"$d\"";
 609
 610                 my $k = $doc->findvalue("//*[\@id='$d']/\@key");
 611                 push @dim_select, "\"$d\".\"$k\" AS \"${d}_${k}\"";
 612
 613                 for my $c ( keys %{$$p{output}{$d}} ) {
 614                         push @dim_select, "\"$d\".\"$c\" AS \"${d}_${c}\"";
 615                 }
 616
 617                 for my $c ( keys %{$$p{filter}{$d}} ) {
 618                         next if (exists $$p{output}{$d}{$c});
 619                         push @dim_select, "\"$d\".\"$c\" AS \"${d}_${c}\"";
 620                 }
 621         }
 622
 623         my $d_select =
 624                 '(SELECT ' . join(',', @dim_select) .
 625                 '  FROM ' . join(',', @dim_from) . ') AS dims';
 626
 627         my @opord;
 628         if (ref $$p{output_order}) {
 629                 @opord = @{ $$p{output_order} };
 630         } else {
 631                 @opord = ( $$p{output_order} );
 632         }
 633         my @output_order = map { { (split ':')[1] => (split ':')[2] } } @opord;
 634         my @p_col = split(':',$p->{pivot_col}) if $p->{pivot_col};
 635         my $pivot;
 636
 637         my $col = 1;
 638         my @groupby;
 639         my @output;
 640         my @columns;
 641         my @join;
 642         my @join_base;
 643         for my $pair (@output_order) {
 644                 my ($t_name) = keys %$pair;
 645                 my $t = $t_name;
 646
 647                 $t_name = "dims" if ($t ne $core);
 648
 649                 my $t_node = table_by_id($t);
 650
 651                 for my $c ( values %$pair ) {
 652                         my $label = $t_node->findvalue("fields/field[\@name='$c']/label");
 653
 654                         my $full_col = $c;
 655                         $full_col = "${t}_${c}" if ($t ne $t_name);
 656                         $full_col = "\"$t_name\".\"$full_col\"";
 657
 658
 659                         if (my $xform_type = $$p{xform}{type}{$t}{$c}) {
 660                                 my $xform = $$OpenILS::WWW::Reporter::dtype_xforms{$xform_type};
 661                                 if ($xform->{group}) {
 662                                         push @groupby, $col;
 663                                 }
 664                                 $label = "$$xform{label} -- $label";
 665
 666                                 my $tmp = $xform->{'select'};
 667                                 $tmp =~ s/\?COLNAME\?/$full_col/gs;
 668                                 $tmp =~ s/\?PARAM\?/$$p{xform}{param}{$t}{$c}/gs;
 669                                 $full_col = $tmp;
 670                         } else {
 671                                 push @groupby, $col;
 672                         }
 673
 674                         push @output, "$full_col AS \"$label\"";
 675                         push @columns, $label;
 676                         $pivot = scalar(@columns) - 1 if (@p_col && $t eq $p_col[1] && $c eq $p_col[2]);
 677                         $col++;
 678                 }
 679
 680                 if ($t ne $t_name && (!@join_base || !grep{$t eq $_}@join_base)) {
 681                         my $k = $doc->findvalue("//*[\@id='$t']/\@key");
 682                         my $f = $doc->findvalue("//*[\@id='$t']/\@field");
 683                         push @join, "dims.\"${t}_${k}\" = \"$core\".\"$f\"";
 684                         push @join_base, $t;
 685                 }
 686         }
 687
 688         my @where;
 689         my @bind;
 690         for my $t ( keys %{$$p{filter}} ) {
 691                 my $t_name = $t;
 692                 $t_name = "dims" if ($t ne $core);
 693
 694                 my $t_node = table_by_id($t);
 695
 696                 for my $c ( keys %{$$p{filter}{$t}} ) {
 697                         my $label = $t_node->findvalue("fields/field[\@name='$c']/label");
 698
 699                         my $full_col = $c;
 700                         $full_col = "${t}_${c}" if ($t ne $t_name);
 701                         $full_col = "\"$t_name\".\"$full_col\"";
 702
 703                         # XXX make this use widget specific code
 704
 705                         my ($fam) = keys %{ $$p{filter}{$t}{$c} };
 706                         my ($w) = keys %{ $$p{filter}{$t}{$c}{$fam} };
 707                         my $val = $$p{filter}{$t}{$c}{$fam}{$w};
 708
 709                         if (ref $val) {
 710                                 push @where, "$full_col IN (".join(",",map {'?'}@$val).")";
 711                                 push @bind, @$val;
 712                         } else {
 713                                 push @where, "$full_col = ?";
 714                                 push @bind, $val;
 715                         }
 716                 }
 717
 718                 if ($t ne $t_name && (!@join_base || !grep{$t eq $_}@join_base)) {
 719                         my $k = $doc->findvalue("//*[\@id='$t']/\@key");
 720                         my $f = $doc->findvalue("//*[\@id='$t']/\@field");
 721                         push @join, "dims.\"${t}_${k}\" = \"$core\".\"$f\"";
 722                         push @join_base, $t;
 723                 }
 724         }
 725
 726         my $t = table_by_id($core)->findvalue('tablename');
 727         my $from = " FROM $t AS \"$core\" RIGHT JOIN $d_select ON (". join(' AND ', @join).")";
 728         my $select =
 729                 "SELECT ".join(',', @output). $from;
 730
 731         $select .= ' WHERE '.join(' AND ', @where) if (@where);
 732         $select .= ' GROUP BY '.join(',',@groupby) if (@groupby);
 733
 734         $r->{sql}->{'pivot'}    = $pivot;
 735         $r->{sql}->{'select'}   = $select;
 736         $r->{sql}->{'bind'}     = \@bind;
 737         $r->{sql}->{columns}    = \@columns;
 738         $r->{sql}->{groupby}    = \@groupby;
 739
 740 }
 741
 742
 743
 744
 745
 746