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