Open-ILS/src/reporter/clark-kent.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use diagnostics;
   5 use DBI;
   6 use FileHandle;
   7 use XML::LibXML;
   8 use Getopt::Long;
   9 use DateTime;
  10 use DateTime::Format::ISO8601;
  11 use JSON;
  12 use Data::Dumper;
  13 use Text::CSV_XS;
  14 use Spreadsheet::WriteExcel::Big;
  15 use OpenSRF::EX qw/:try/;
  16 use OpenSRF::Utils qw/:daemon/;
  17 #use OpenSRF::Utils::Logger qw/:level/;
  18 use OpenSRF::System;
  19 use OpenSRF::AppSession;
  20 use OpenSRF::Utils::SettingsClient;
  21 use OpenILS::Reporter::SQLBuilder;
  22 use POSIX;
  23 use GD::Graph::pie;
  24 use GD::Graph::bars3d;
  25 use GD::Graph::lines3d;
  26 use Tie::IxHash;
  27
  28 use open ':utf8';
  29
  30
  31 my ($count, $config, $lockfile, $daemon) = (1, '/openils/conf/bootstrap.conf', '/tmp/reporter-LOCK');
  32
  33 GetOptions(
  34         "daemon"        => \$daemon,
  35         "concurrency=i" => \$count,
  36         "boostrap=s"    => \$config,
  37         "lockfile=s"    => \$lockfile,
  38 );
  39
  40 if (-e $lockfile) {
  41         die "I seem to be running already. If not remove $lockfile, try again\n";
  42 }
  43
  44 OpenSRF::System->bootstrap_client( config_file => $config );
  45
  46 # XXX Get this stuff from the settings server
  47 my $sc = OpenSRF::Utils::SettingsClient->new;
  48 my $db_driver = $sc->config_value( reporter => setup => database => 'driver' );
  49 my $db_host = $sc->config_value( reporter => setup => database => 'host' );
  50 my $db_port = $sc->config_value( reporter => setup => database => 'port' );
  51 my $db_name = $sc->config_value( reporter => setup => database => 'name' );
  52 my $db_user = $sc->config_value( reporter => setup => database => 'user' );
  53 my $db_pw = $sc->config_value( reporter => setup => database => 'password' );
  54
  55 my $output_base = $sc->config_value( reporter => setup => files => 'output_base' );
  56
  57 my $dsn = "dbi:" . $db_driver . ":dbname=" . $db_name .';host=' . $db_host . ';port=' . $db_port;
  58
  59 my ($dbh,$running,$sth,@reports,$run, $current_time);
  60
  61 if ($daemon) {
  62         open(F, ">$lockfile");
  63         print F $$;
  64         close F;
  65         daemonize("Clark Kent, waiting for trouble");
  66 }
  67
  68
  69 DAEMON:
  70
  71 $dbh = DBI->connect($dsn,$db_user,$db_pw, {pg_enable_utf8 => 1, RaiseError => 1});
  72
  73 $current_time = DateTime->from_epoch( epoch => time() )->strftime('%FT%T%z');
  74
  75 # make sure we're not already running $count reports
  76 ($running) = $dbh->selectrow_array(<<SQL);
  77 SELECT  count(*)
  78   FROM  reporter.schedule
  79   WHERE start_time IS NOT NULL AND complete_time IS NULL;
  80 SQL
  81
  82 if ($count <= $running) {
  83         if ($daemon) {
  84                 $dbh->disconnect;
  85                 sleep 1;
  86                 POSIX::waitpid( -1, POSIX::WNOHANG );
  87                 sleep 60;
  88                 goto DAEMON;
  89         }
  90         print "Already running maximum ($running) concurrent reports\n";
  91         exit 1;
  92 }
  93
  94 # if we have some open slots then generate the sql
  95 $run = $count - $running;
  96
  97 $sth = $dbh->prepare(<<SQL);
  98 SELECT  *
  99   FROM  reporter.schedule
 100   WHERE start_time IS NULL AND run_time < NOW()
 101   ORDER BY run_time
 102   LIMIT $run;
 103 SQL
 104
 105 $sth->execute;
 106
 107 @reports = ();
 108 while (my $r = $sth->fetchrow_hashref) {
 109         my $s3 = $dbh->selectrow_hashref(<<"    SQL", {}, $r->{report});
 110                 SELECT * FROM reporter.report WHERE id = ?;
 111         SQL
 112
 113         my $s2 = $dbh->selectrow_hashref(<<"    SQL", {}, $s3->{template});
 114                 SELECT * FROM reporter.template WHERE id = ?;
 115         SQL
 116
 117         $s3->{template} = $s2;
 118         $r->{report} = $s3;
 119
 120         my $b = OpenILS::Reporter::SQLBuilder->new;
 121         $b->register_params( JSON->JSON2perl( $r->{report}->{data} ) );
 122
 123         $r->{resultset} = $b->parse_report( JSON->JSON2perl( $r->{report}->{template}->{data} ) );
 124         $r->{resultset}->relative_time($r->{run_time});
 125         push @reports, $r;
 126 }
 127
 128 $sth->finish;
 129
 130 $dbh->disconnect;
 131
 132 # Now we spaun the report runners
 133
 134 for my $r ( @reports ) {
 135         next if (safe_fork());
 136
 137         # This is the child (runner) process;
 138         daemonize("Clark Kent reporting: $r->{report}->{name}");
 139
 140         $dbh = DBI->connect($dsn,$db_user,$db_pw, {pg_enable_utf8 => 1, RaiseError => 1});
 141
 142         try {
 143                 $dbh->do(<<'            SQL',{}, $r->{id});
 144                         UPDATE  reporter.schedule
 145                           SET   start_time = now()
 146                           WHERE id = ?;
 147                 SQL
 148
 149                 $sth = $dbh->prepare($r->{resultset}->toSQL);
 150
 151                 $sth->execute;
 152                 $r->{data} = $sth->fetchall_arrayref;
 153
 154                 $r->{column_labels} = [$r->{resultset}->column_label_list];
 155
 156                 if ($r->{resultset}->pivot_data && $r->{resultset}->pivot_label) {
 157                         my @labels = $r->{resultset}->column_label_list;
 158                         my $newdata = pivot_data(
 159                                 { columns => $r->{column_labels}, data => $r->{data}},
 160                                 $r->{resultset}->pivot_label,
 161                                 $r->{resultset}->pivot_data,
 162                                 $r->{resultset}->pivot_default
 163                         );
 164
 165                         $r->{column_labels} = $newdata->{columns};
 166                         $r->{data} = $newdata->{data};
 167                 }
 168
 169                 my $s2 = $r->{report}->{template}->{id};
 170                 my $s3 = $r->{report}->{id};
 171                 my $output = $r->{id};
 172
 173                 mkdir($output_base);
 174                 mkdir("$output_base/$s2");
 175                 mkdir("$output_base/$s2/$s3");
 176                 mkdir("$output_base/$s2/$s3/$output");
 177
 178                 my $output_dir = "$output_base/$s2/$s3/$output";
 179
 180                 if ( $r->{csv_format} ) {
 181                         build_csv("$output_dir/report-data.csv", $r);
 182                 }
 183
 184                 if ( $r->{excel_format} ) {
 185                         build_excel("$output_dir/report-data.xls", $r);
 186                 }
 187
 188                 if ( $r->{html_format} ) {
 189                         mkdir("$output_dir/html");
 190                         build_html("$output_dir/report-data.html", $r);
 191                 }
 192
 193                 $dbh->begin_work;
 194
 195                 if ($r->{report}->{recur} ) {
 196                         my $sql = <<'                   SQL';
 197                                 INSERT INTO reporter.schedule (
 198                                                 report,
 199                                                 folder,
 200                                                 runner,
 201                                                 run_time,
 202                                                 email,
 203                                                 csv_format,
 204                                                 excel_format,
 205                                                 html_format,
 206                                                 chart_pie,
 207                                                 chart_bar,
 208                                                 chart_line )
 209                                         VALUES ( ?, ?, ?, ?::TIMESTAMPTZ + ?, ?, ?, ?, ?, ?, ?, ? );
 210                         SQL
 211
 212                         $dbh->do(
 213                                 $sql,
 214                                 {},
 215                                 $r->{report}->{id},
 216                                 $r->{folder},
 217                                 $r->{runner},
 218                                 $r->{run_time},
 219                                 $r->{report}->{recurance},
 220                                 $r->{email},
 221                                 $r->{csv_format},
 222                                 $r->{excel_format},
 223                                 $r->{html_format},
 224                                 $r->{chart_pie},
 225                                 $r->{chart_bar},
 226                                 $r->{chart_line},
 227                         );
 228                 }
 229
 230                 $dbh->do(<<'            SQL',{}, $r->{id});
 231                         UPDATE  reporter.schedule
 232                           SET   complete_time = now()
 233                           WHERE id = ?;
 234                 SQL
 235
 236                 $dbh->commit;
 237
 238
 239         } otherwise {
 240                 my $e = shift;
 241                 $dbh->rollback;
 242                 $dbh->do(<<'            SQL',{}, $e, $r->{id});
 243                         UPDATE  reporter.schedule
 244                           SET   error_text = ?,
 245                                 complete_time = now(),
 246                                 error_code = 1
 247                           WHERE id = ?;
 248                 SQL
 249         };
 250
 251         $dbh->disconnect;
 252
 253         exit; # leave the child
 254 }
 255
 256 if ($daemon) {
 257         sleep 1;
 258         POSIX::waitpid( -1, POSIX::WNOHANG );
 259         sleep 60;
 260         goto DAEMON;
 261 }
 262
 263 #-------------------------------------------------------------------
 264
 265 sub build_csv {
 266         my $file = shift;
 267         my $r = shift;
 268
 269         my $csv = Text::CSV_XS->new({ always_quote => 1, eol => "\015\012" });
 270
 271         return unless ($csv);
 272
 273         my $f = new FileHandle (">$file");
 274
 275         $csv->print($f, $r->{column_labels});
 276         $csv->print($f, $_) for (@{$r->{data}});
 277
 278         $f->close;
 279 }
 280 sub build_excel {
 281         my $file = shift;
 282         my $r = shift;
 283         my $xls = Spreadsheet::WriteExcel::Big->new($file);
 284
 285         my $sheetname = substr($r->{report}->{name},1,31);
 286         $sheetname =~ s/\W/_/gos;
 287
 288         my $sheet = $xls->add_worksheet($sheetname);
 289
 290         $sheet->write_row('A1', $r->{column_labels});
 291
 292         $sheet->write_col('A2', $r->{data});
 293
 294         $xls->close;
 295 }
 296
 297 sub build_html {
 298         my $file = shift;
 299         my $r = shift;
 300
 301         my $index = new FileHandle (">$file");
 302         my $raw = new FileHandle (">$file.raw.html");
 303
 304         # index header
 305         print $index <<"        HEADER";
 306 <html>
 307         <head>
 308                 <title>$$r{report}{name}</title>
 309                 <style>
 310                         table { border-collapse: collapse; }
 311                         th { background-color: lightgray; }
 312                         td,th { border: solid black 1px; }
 313                         * { font-family: sans-serif; font-size: 10px; }
 314                 </style>
 315         </head>
 316         <body>
 317                 <center>
 318                 <h2><u>$$r{report}{name}</u></h2>
 319                 $$r{report}{description}<br/><br/><br/>
 320         HEADER
 321
 322
 323         # add a link to the raw output html
 324         print $index "<a href='report-data.html.raw.html'>Tabular Output</a>";
 325
 326         # add a link to the CSV output
 327         print $index " -- <a href='report-data.csv'>CSV Output</a>" if ($r->{csv_format});
 328
 329         # add a link to the CSV output
 330         print $index " -- <a href='report-data.xls'>Excel Output</a>" if ($r->{excel_format});
 331
 332         print $index "<br/><br/><br/><br/></center>";
 333
 334         # create the raw output html file
 335         print $raw "<html><head><title>$$r{report}{name}</title>";
 336
 337         print $raw <<'  CSS';
 338                 <style>
 339                         table { border-collapse: collapse; }
 340                         th { background-color: lightgray; }
 341                         td,th { border: solid black 1px; }
 342                         * { font-family: sans-serif; font-size: 10px; }
 343                 </style>
 344         CSS
 345
 346         print $raw "</head><body><table>";
 347
 348         {       no warnings;
 349                 print $raw "<tr><th>".join('</th><th>',@{$r->{column_labels}}).'</th></tr>';
 350                 print $raw "<tr><td>".join('</td><td>',@$_                   ).'</td></tr>' for (@{$r->{data}});
 351         }
 352
 353         print $raw '</table></body></html>';
 354
 355         $raw->close;
 356
 357         # Time for a pie chart
 358         if ($r->{chart_pie}) {
 359                 my $pics = draw_pie($r, $file);
 360                 for my $pic (@$pics) {
 361                         print $index "<img src='report-data.html.$pic->{file}' alt='$pic->{name}'/><br/><br/><br/><br/>";
 362                 }
 363         }
 364
 365         print $index '<br/><br/><br/><br/>';
 366         # Time for a bar chart
 367         if ($r->{chart_bar}) {
 368                 my $pics = draw_bars($r, $file);
 369                 for my $pic (@$pics) {
 370                         print $index "<img src='report-data.html.$pic->{file}' alt='$pic->{name}'/><br/><br/><br/><br/>";
 371                 }
 372         }
 373
 374         print $index '<br/><br/><br/><br/>';
 375         # Time for a bar chart
 376         if ($r->{chart_line}) {
 377                 my $pics = draw_lines($r, $file);
 378                 for my $pic (@$pics) {
 379                         print $index "<img src='report-data.html.$pic->{file}' alt='$pic->{name}'/><br/><br/><br/><br/>";
 380                 }
 381         }
 382
 383         # and that's it!
 384         print $index '</body></html>';
 385
 386         $index->close;
 387 }
 388
 389 sub draw_pie {
 390         my $r = shift;
 391         my $file = shift;
 392
 393         my $data = $r->{data};
 394
 395         my @groups = $r->{resultset}->group_by_list(0);
 396
 397         my @values = (0 .. (scalar(@{$r->{column_labels}}) - 1));
 398         delete @values[@groups];
 399
 400         #my $logo = $doc->findvalue('/reporter/setup/files/chart_logo');
 401
 402         my @pics;
 403         for my $vcol (@values) {
 404                 next unless (defined $vcol);
 405
 406                 my @pic_data = ([],[]);
 407                 for my $row (@$data) {
 408                         next if (!defined($$row[$vcol]) || $$row[$vcol] == 0);
 409                         my $val = $$row[$vcol];
 410                         push @{$pic_data[0]}, join(" -- ", @$row[@groups])." ($val)";
 411                         push @{$pic_data[1]}, $val;
 412                 }
 413
 414                 next unless (@{$pic_data[0]});
 415
 416                 my $size = 300;
 417                 my $split = int(scalar(@{$pic_data[0]}) / $size);
 418                 my $last = scalar(@{$pic_data[0]}) % $size;
 419
 420                 for my $sub_graph (0 .. $split) {
 421
 422                         if ($sub_graph == $split) {
 423                                 $size = $last;
 424                         }
 425
 426                         my @sub_data;
 427                         for my $set (@pic_data) {
 428                                 push @sub_data, [ splice(@$set,0,$size) ];
 429                         }
 430
 431                         my $pic = new GD::Graph::pie;
 432
 433                         $pic->set(
 434                                 label                   => $r->{column_labels}->[$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.$sub_graph.$format");
 446                         binmode IMG;
 447
 448                         my $forgetit = 0;
 449                         try {
 450                                 $pic->plot(\@sub_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.$sub_graph.$format : $e";
 455                                 $forgetit = 1;
 456                         };
 457
 458                         close IMG;
 459
 460
 461                         push @pics,
 462                                 { file => "pie.$vcol.$sub_graph.$format",
 463                                   name => $r->{column_labels}->[$vcol].' (Pie)',
 464                                 } unless ($forgetit);
 465
 466                         last if ($sub_graph == $split);
 467                 }
 468
 469         }
 470
 471         return \@pics;
 472 }
 473
 474 sub draw_bars {
 475         my $r = shift;
 476         my $file = shift;
 477         my $data = $r->{data};
 478
 479         #my $logo = $doc->findvalue('/reporter/setup/files/chart_logo');
 480
 481         my @groups = $r->{resultset}->group_by_list(0);
 482
 483
 484         my @values = (0 .. (scalar(@{$r->{column_labels}}) - 1));
 485         splice(@values,$_,1) for (reverse @groups);
 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
 504                 my $pos = 0;
 505                 for my $row (@$data) {
 506                         my $val = $$row[$vcol] ? $$row[$vcol] : 0;
 507                         push @{$pic_data[$set]}, $val;
 508                         $max_y = $val if ($val > $max_y);
 509                         $trim_candidates{$pos}++ if ($val == 0);
 510                         $pos++;
 511                 }
 512
 513                 $set++;
 514         }
 515         my $set_count = scalar(@pic_data) - 1;
 516         my @trim_cols = grep { $trim_candidates{$_} == $set_count } keys %trim_candidates;
 517
 518         my @new_data;
 519         my @use_me;
 520         my @no_use;
 521         my $set_index = 0;
 522         for my $dataset (@pic_data) {
 523                 splice(@$dataset,$_,1) for (sort { $b <=> $a } @trim_cols);
 524
 525                 if (grep { $_ } @$dataset) {
 526                         push @new_data, $dataset;
 527                         push @use_me, $set_index;
 528                 } else {
 529                         push @no_use, $set_index;
 530                 }
 531                 $set_index++;
 532
 533         }
 534
 535         return [] unless ($new_data[0] && @{$new_data[0]});
 536
 537         for my $col (@use_me) {
 538                 push @leg, $r->{column_labels}->[$col + @groups - 1] if (map { 1 } grep { $col == $_ } @values);
 539         }
 540
 541         my $w = 100 + 10 * scalar(@{$new_data[0]});
 542         $w = 400 if ($w < 400);
 543
 544         my $h = 10 * (scalar(@new_data) / 2);
 545
 546         $h = 0 if ($h < 0);
 547
 548         my $pic = new GD::Graph::bars3d ($w + 250, $h + 500);
 549
 550         $pic->set(
 551                 title                   => $r->{report}{name},
 552                 x_labels_vertical       => 1,
 553                 shading                 => 1,
 554                 bar_depth               => 5,
 555                 bar_spacing             => 2,
 556                 y_max_value             => $max_y,
 557                 legend_placement        => 'TR',
 558                 boxclr                  => 'lgray',
 559                 #logo                   => $logo,
 560                 #logo_position          => 'R',
 561                 #logo_resize            => 0.5,
 562                 show_values             => 1,
 563                 overwrite               => 1,
 564         );
 565         $pic->set_legend(@leg);
 566
 567         my $format = $pic->export_format;
 568
 569         open(IMG, ">$file.bar.$format");
 570         binmode IMG;
 571
 572         try {
 573                 $pic->plot(\@new_data) or die $pic->error;
 574                 print IMG $pic->gd->$format;
 575         } otherwise {
 576                 my $e = shift;
 577                 warn "Couldn't draw $file.bar.$format : $e";
 578         };
 579
 580         close IMG;
 581
 582         return [{ file => "bar.$format",
 583                   name => $r->{report}{name}.' (Bar)',
 584                 }];
 585
 586 }
 587
 588 sub draw_lines {
 589         my $r = shift;
 590         my $file = shift;
 591         my $data = $r->{data};
 592
 593         #my $logo = $doc->findvalue('/reporter/setup/files/chart_logo');
 594
 595         my @groups = $r->{resultset}->group_by_list(0);
 596
 597         my @values = (0 .. (scalar(@{$r->{column_labels}}) - 1));
 598         splice(@values,$_,1) for (reverse @groups);
 599
 600         my @pic_data;
 601         {       no warnings;
 602                 for my $row (@$data) {
 603                         push @{$pic_data[0]}, join(' -- ', @$row[@groups]);
 604                 }
 605         }
 606
 607         my @leg;
 608         my $set = 1;
 609
 610         my $max_y = 0;
 611         for my $vcol (@values) {
 612                 next unless (defined $vcol);
 613
 614
 615                 for my $row (@$data) {
 616                         my $val = $$row[$vcol] ? $$row[$vcol] : 0;
 617                         push @{$pic_data[$set]}, $val;
 618                         $max_y = $val if ($val > $max_y);
 619                 }
 620
 621                 $set++;
 622         }
 623         my $set_count = scalar(@pic_data) - 1;
 624
 625         my @new_data;
 626         my @use_me;
 627         my @no_use;
 628         my $set_index = 0;
 629         for my $dataset (@pic_data) {
 630
 631                 if (grep { $_ } @$dataset) {
 632                         push @new_data, $dataset;
 633                         push @use_me, $set_index;
 634                 } else {
 635                         push @no_use, $set_index;
 636                 }
 637                 $set_index++;
 638
 639         }
 640
 641         for my $col (@use_me) {
 642                 push @leg, $r->{column_labels}->[$col + @groups - 1] if (map { 1 } grep { $col == $_ } @values);
 643         }
 644
 645         my $w = 100 + 10 * scalar(@{$new_data[0]});
 646         $w = 400 if ($w < 400);
 647
 648         my $h = 10 * (scalar(@new_data) / 2);
 649
 650         $h = 0 if ($h < 0);
 651
 652         my $pic = new GD::Graph::lines3d ($w + 250, $h + 500);
 653
 654         $pic->set(
 655                 title                   => $r->{report}{name},
 656                 x_labels_vertical       => 1,
 657                 shading                 => 1,
 658                 line_depth              => 5,
 659                 y_max_value             => $max_y,
 660                 legend_placement        => 'TR',
 661                 boxclr                  => 'lgray',
 662                 #logo                   => $logo,
 663                 #logo_position          => 'R',
 664                 #logo_resize            => 0.5,
 665                 show_values             => 1,
 666                 overwrite               => 1,
 667         );
 668         $pic->set_legend(@leg);
 669
 670         my $format = $pic->export_format;
 671
 672         open(IMG, ">$file.line.$format");
 673         binmode IMG;
 674
 675         try {
 676                 $pic->plot(\@new_data) or die $pic->error;
 677                 print IMG $pic->gd->$format;
 678         } otherwise {
 679                 my $e = shift;
 680                 warn "Couldn't draw $file.line.$format : $e";
 681         };
 682
 683         close IMG;
 684
 685         return [{ file => "line.$format",
 686                   name => $r->{report}{name}.' (Bar)',
 687                 }];
 688
 689 }
 690
 691
 692 sub pivot_data {
 693         my $blob = shift;
 694         my $pivot_label = shift;
 695         my $pivot_data = shift;
 696         my $default = shift;
 697         $default = 0 unless (defined $default);
 698
 699         my $data = $$blob{data};
 700         my $cols = $$blob{columns};
 701
 702         my @keep_labels =  @$cols;
 703         splice(@keep_labels, $_ - 1, 1) for (reverse sort ($pivot_label, $pivot_data));
 704
 705         my @keep_cols = (0 .. @$cols - 1);
 706         splice(@keep_cols, $_ - 1, 1) for (reverse sort ($pivot_label, $pivot_data));
 707
 708         #first, find the unique list of pivot values
 709         my %tmp;
 710         for my $row (@$data) {
 711                 $tmp{ $$row[$pivot_label - 1] } = 1;
 712         }
 713         my @new_cols = sort keys %tmp;
 714
 715         tie my %split_data, 'Tie::IxHash';
 716         for my $row (@$data) {
 717
 718                 my $row_fp = ''. join('', map { defined($$row[$_]) ? $$row[$_] : '' } @keep_cols);
 719                 $split_data{$row_fp} ||= [];
 720
 721                 push @{ $split_data{$row_fp} }, $row;
 722         }
 723
 724
 725         #now loop over the data, building a new result set
 726         tie my %new_data, 'Tie::IxHash';
 727
 728         for my $fp ( keys %split_data ) {
 729
 730                 $new_data{$fp} = [];
 731
 732                 for my $col (@keep_cols) {
 733                         push @{ $new_data{$fp} }, $split_data{$fp}[0][$col];
 734                 }
 735
 736                 for my $col (@new_cols) {
 737
 738                         my ($datum) = map { $_->[$pivot_data - 1] } grep { $_->[$pivot_label - 1] eq $col } @{ $split_data{$fp} };
 739                         $datum ||= $default;
 740                         push @{ $new_data{$fp} }, $datum;
 741                 }
 742         }
 743
 744         push @keep_labels, @new_cols;
 745
 746         return { columns => \@keep_labels, data => [ values %new_data ] };
 747 }
 748
 749