emig.d/bin/mig-reporter

   1 #!/usr/bin/perl
   2 # -*- coding: iso-8859-15 -*-
   3 ###############################################################################
   4 =pod
   5
   6 =item B<reporter> --title "Report Title"
   7
   8 Generates an asciidoc file in the git working directory that can be converted to
   9 any appropriate format.  The analyst and report parameters are required.
  10
  11 Optional parameters are :
  12
  13 -- analyst
  14
  15 Default to "Equinox Open Library Initiative"
  16
  17 --added_page_title and --added_page_file
  18
  19 If one is used both must be.  The added page file can be plain text or asciidoc.  This
  20 adds an extra arbitrary page of notes to the report.  Mig assumes the page file is in the mig git directory.
  21
  22 --tags
  23
  24 This will define a set of tags to use, if not set it will default to Circs,
  25 Holds, Actors, Bibs, Assets & Money.
  26
  27 --debug on
  28
  29 Gives more information about what is happening. Defaults to off.
  30
  31 --reports_xml
  32
  33 Allows you to override the default evergreen_staged_report.xml in the mig-xml folder.
  34
  35 --captions on OR --captions off
  36
  37 Adds the captions tag to asciidoc header to turn off captions in generated output.
  38 Defaults to off.
  39
  40 =back
  41
  42 =cut
  43
  44 ###############################################################################
  45
  46 use strict;
  47 use warnings;
  48
  49 use DBI;
  50 use Data::Dumper;
  51 use XML::LibXML;
  52 use Env qw(
  53     HOME PGHOST PGPORT PGUSER PGDATABASE MIGSCHEMA
  54     MIGBASEWORKDIR MIGBASEGITDIR MIGGITDIR MIGWORKDIR
  55 );
  56 use Pod::Usage;
  57 use Switch;
  58 use Getopt::Long;
  59 use Cwd 'abs_path';
  60 use Cwd qw(getcwd);
  61 use FindBin;
  62 my $mig_bin = "$FindBin::Bin/";
  63 use lib "$FindBin::Bin/";
  64 use EMig;
  65 use open ':encoding(utf8)';
  66
  67 pod2usage(-verbose => 2) if defined $ARGV[0] && $ARGV[0] eq '--help';
  68 pod2usage(-verbose => 1) if ! $ARGV[1];
  69
  70 my $analyst = 'Equinox Open Library Initiative';;
  71 my $report_title;
  72 my $reports_xml = 'evergreen_staged_report.xml';
  73 my $tags;
  74 my $added_page_title;
  75 my $added_page_file;
  76 my $captions = 'off';
  77 my $i = 0;
  78 my $parser = XML::LibXML->new();
  79 my $lines_per_page = 42;
  80 my $debug = 'off';
  81 my $workbook;
  82 my $fh;
  83
  84 my $ret = GetOptions(
  85     'analyst:s'           => \$analyst,
  86     'report_title:s'      => \$report_title,
  87     'title:s'             => \$report_title,
  88     'reports_xml:s'       => \$reports_xml,
  89     'tags:s'              => \$tags,
  90     'added_page_title:s'  => \$added_page_title,
  91     'added_page_file:s'   => \$added_page_file,
  92     'captions:s'          => \$captions,
  93         'debug:s'             => \$debug
  94 );
  95
  96 if (!defined $tags) {$tags = 'circs.holds.actors.bibs.assets.money.notices'};
  97 if (!defined $report_title) { abort('--report_title or --title must be supplied'); }
  98 if (!defined $analyst) { abort('--analyst must be supplied'); }
  99
 100 my $mig_path = abs_path($0);
 101 $mig_path =~ s|[^/]+$||;
 102 $reports_xml = find_xml($reports_xml,$mig_path);
 103 if (!defined $reports_xml) { abort("Can not find xml reports file."); }
 104 my $dom = $parser->parse_file($reports_xml);
 105
 106 if (defined $added_page_file or defined $added_page_title) {
 107     abort('must specify --added_page_file and --added_page_title') unless defined $added_page_file and defined $added_page_title;
 108     }
 109 if (defined $added_page_file) { $added_page_file = $MIGGITDIR . $added_page_file; }
 110
 111 my $dbh = EMig::db_connect();
 112 my $report_file = create_report_name($report_title);
 113 $report_file = $MIGGITDIR . $report_file;
 114
 115 open($fh, '>', $report_file) or abort("Could not open output file $report_file!");
 116 write_title_page($report_title,$fh,$analyst,$captions);
 117 load_javascript($fh);
 118
 119 if (defined $added_page_file and defined $added_page_title) {
 120     print $fh "<<<\n";
 121     print $fh "== $added_page_title\n";
 122     print "$added_page_file\t$added_page_title\n";
 123     open(my $an,'<:encoding(UTF-8)', $added_page_file) or abort("Could not open $added_page_file!");
 124     while ( my $line = <$an> ) {
 125         print $fh $line;
 126     }
 127     print $fh "\n";
 128     close $an;
 129 }
 130
 131 foreach my $func ($dom->findnodes('//function')) {
 132     my $fdrop = $func->findvalue('./drop');
 133     my $fcreate = $func->findvalue('./create');
 134     my $fname = $func->findvalue('./name');
 135     my $sdrop = $dbh->prepare($fdrop);
 136     my $screate = $dbh->prepare($fcreate);
 137     print "dropping function $fname ... ";
 138     $sdrop->execute();
 139     print "creating function $fname\n\n";
 140     $screate->execute();
 141 }
 142
 143 foreach my $table ($dom->findnodes('//table')) {
 144     my $tdrop = $table->findvalue('./drop');
 145     my $tcreate = $table->findvalue('./create');
 146     my $tname = $table->findvalue('./name');
 147     my $sdrop = $dbh->prepare($tdrop);
 148     my $screate = $dbh->prepare($tcreate);
 149     print "dropping table $tname ... ";
 150     $sdrop->execute();
 151     print "creating table $tname\n\n";
 152     $screate->execute();
 153 }
 154
 155 $tags = lc($tags);
 156 my @report_tags = split(/\./,$tags);
 157 foreach my $t (@report_tags) {
 158     print "\n\n=========== Starting to process tag $t\n";
 159     print   "==========================================\n\n";
 160
 161     my @asset_files;
 162     foreach my $asset ($dom->findnodes('//asset')) {
 163         if (index($asset->findvalue('./tag'),$t) != -1) {
 164             push @asset_files, $asset->findvalue('./file');
 165         }
 166     }
 167
 168     foreach my $fname (@asset_files) {
 169         my $asset_path = $mig_path . '../asc/' . $fname;
 170         open my $a, $asset_path or abort("Could not open $fname.");
 171         while ( my $l = <$a> ) {
 172             print $fh $l;
 173         }
 174     print $fh "<<<\n";
 175     }
 176
 177     print_section_header(ucfirst($t),$fh);
 178     my $linecount = $lines_per_page;
 179     my $r;
 180
 181     undef @asset_files;
 182     foreach my $asset ($dom->findnodes('//asset')) {
 183         if (index($asset->findvalue('./tag'),$t) != -1) {
 184             push @asset_files, $asset->findvalue('./file');
 185         }
 186     }
 187
 188     my @report_names;
 189     foreach my $report ($dom->findnodes('//report')) {
 190         if (index($report->findvalue('./tag'),$t) != -1 and $report->findvalue('./iteration') eq '0') {
 191             push @report_names, $report->findvalue('./name');
 192         }
 193     }
 194
 195     #only has one level of failover now but could change to array of hashes and loops
 196     #but this keeps it simple and in practice I haven't needed more than two
 197
 198
 199     foreach my $rname (@report_names) {
 200         my %report0;
 201         my %report1;
 202         my $check_tables0;
 203         my $check_tables1;
 204
 205         if ($debug eq 'on') {print "\nchecking for $rname ... ";}
 206         %report0 = find_report($dom,$t,$rname,'0',$debug);
 207         $check_tables0 = check_table($report0{query},$MIGSCHEMA,$debug,$rname);
 208         if ($check_tables0 == 1) { $r = print_query($fh,%report0); } else {
 209                 %report1 = find_report($dom,$t,$rname,'1',$debug);
 210             if (defined $report1{query}) {
 211                 $check_tables1 = check_table($report1{query},$MIGSCHEMA,$debug,$rname);
 212                 if ($check_tables1 == 1) { $r = print_query($fh,%report1); }
 213             }
 214         }
 215     }
 216
 217 }
 218
 219 print "\n";
 220
 221 foreach my $table ($dom->findnodes('//table')) {
 222     my $tdrop = $table->findvalue('./drop');
 223     my $tname = $table->findvalue('./name');
 224     my $sdrop = $dbh->prepare($tdrop);
 225     print "cleaning up table $tname ... \n";
 226     $sdrop->execute();
 227 }
 228
 229 close $fh;
 230
 231 ############ end of main logic
 232
 233 sub find_xml {
 234     my $reports_xml = shift;
 235     my $mig_path = shift;
 236
 237     if ($reports_xml =~ m/\//) { return $reports_xml; }
 238
 239     my $mig_test_file =  $mig_path . '/../xml/' . $reports_xml;
 240     my $working_test_dir = getcwd();
 241     my $working_test_file = $working_test_dir . '/' . $reports_xml;
 242
 243     if (-e $mig_test_file) { return $mig_test_file; }
 244     if (-e $working_test_file) { return $working_test_file; }
 245
 246     return undef;
 247 }
 248
 249 sub find_report {
 250     my $dom = shift;
 251     my $tag = shift;
 252     my $name = shift;
 253     my $iteration = shift;
 254     my $debug = shift;
 255     my %report;
 256
 257     if ($debug eq 'on') {print "iteration $iteration ";}
 258     foreach my $node ($dom->findnodes('//report')) {
 259         if ($node->findvalue('./tag') =~ $tag and $node->findvalue('./iteration') eq $iteration and $node->findvalue('./name') eq $name) {
 260             if ($debug eq 'on') {print "succeeded ... \n";}
 261             %report = (
 262                 name => $node->findvalue('./name'),
 263                 report_title => $node->findvalue('./report_title'),
 264                 query => $node->findvalue('./query'),
 265                 heading => $node->findvalue('./heading'),
 266                 tag => $node->findvalue('./tag'),
 267                 iteration => $node->findvalue('./iteration'),
 268                 note => $node->findvalue('./note'),
 269                                 display => $node->findvalue('./display'),
 270                         chart_labels => $node->findvalue('./chart_labels'),
 271                                 divwidth => $node->findvalue('./divwidth'),
 272                                 divheight => $node->findvalue('./divheight'),
 273                 );
 274             return %report;
 275         }
 276     }
 277     if ($debug eq 'on') {print "failed ... \n";}
 278     return %report = (
 279         name => "eaten by grue"
 280     );
 281 }
 282
 283 sub print_section_header {
 284     my $t = shift;
 285     my $fh = shift;
 286
 287     $t =~ s/_/ /g;
 288     #$t =~ s/(\w+)/\u$1/g;;
 289     print $fh "<<<\n";
 290     print $fh "== $t Reports\n";
 291     return;
 292 }
 293
 294 sub create_report_name {
 295     my $rt = shift;
 296
 297     my @abbr = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 298     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 299     $year += 1900;
 300     my $date = $year . '_' . $abbr[$mon] . '_' . $mday;
 301     my $report_file;
 302     $report_file = $rt . ' ' . $date . '.asciidoc';
 303     $report_file =~ s/ /_/g;
 304     return $report_file;
 305 }
 306
 307 sub write_title_page {
 308     my $rt = shift;
 309     my $fh = shift;
 310     my $a = shift;
 311     my $captions = shift;
 312
 313     my @abbr = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 314     my $l = length($report_title);
 315     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 316     $year += 1900;
 317     print $fh "= $rt\n";
 318     print $fh "$mday $abbr[$mon] $year\n";
 319     print $fh "$a\n";
 320     #print $fh ":title-logo-image: image::eolilogosmall.png[pdfwidth=3in]\n";
 321     print $fh ":toc:\n";
 322     if ($captions eq 'on') { print $fh ":caption:\n"; }
 323     print $fh "\n";
 324 }
 325
 326 sub load_javascript {
 327         my $fh = shift;
 328
 329         print $fh "++++\n";
 330         print $fh "<script type=\"text/javascript\" src=\"https://www.gstatic.com/charts/loader.js\"></script>\n";
 331         print $fh "++++\n";
 332 }
 333
 334 sub check_table {
 335     my $query = shift;
 336     my $MIGSCHEMA = shift;
 337     my $debug = shift;
 338     my $report_name = shift;
 339
 340     if ($debug eq 'on') {print "$query\n";}
 341
 342     my $i;
 343     my $return_flag = 1;
 344     my @qe = split(/ /,$query);
 345     $i = @qe;
 346     $i--;
 347     my @tables;
 348     while ($i > -1) {
 349         if ($qe[$i] eq 'FROM' or $qe[$i] eq 'JOIN') {
 350             my $q = $i + 1;
 351             if ($qe[$q] ne '(SELECT') {
 352                 push @tables, $qe[$q];
 353             }
 354         }
 355         $i--;
 356     }
 357     if ($debug eq 'on') {print "checking tables ... ";}
 358
 359     $i = 0;
 360     foreach my $table (@tables) {
 361         my $sql;
 362         my $schema;
 363         if (index($table,'.') != -1) {
 364             $schema = (split /\./,$table)[0];
 365             $table = (split /\./,$table)[1];
 366         }
 367         $table = clean_query_string($table);
 368         if (defined $schema) {
 369             $schema = clean_query_string($schema);
 370             $sql = 'SELECT EXISTS (SELECT 1 FROM information_schema.tables WHERE table_schema = \'' . $schema . '\' AND table_name = \'' . $table . '\');';
 371         } else {
 372             $sql = 'SELECT EXISTS (SELECT 1 FROM information_schema.tables WHERE table_schema = \'' . $MIGSCHEMA . '\' AND table_name = \'' . $table . '\');';
 373         }
 374         my $sth = $dbh->prepare($sql);
 375         $sth->execute();
 376         while (my @row = $sth->fetchrow_array) {
 377             if ($row[0] eq '1') {
 378                     next;
 379                 } else {
 380                     $return_flag = 0;
 381                     if ($debug eq 'on') {print "detecting $table failed...\n";}
 382                 }
 383             if ($row[0] eq '0') {$return_flag = 0;}
 384         }
 385     }
 386     if ($return_flag == 1 and $debug eq 'on') {print "succeeded ...\n";}
 387     if ($return_flag == 0) {print "! a table failed the find test for report $report_name\n\n";}
 388     return $return_flag;
 389 }
 390
 391 sub clean_query_string {
 392     my $str = shift;
 393
 394     $str =~ s/(?!_)[[:punct:]]//g; #remove punct except underscores
 395     $str =~ s/\n//g;
 396     $str =~ s/\r//g;
 397     return $str;
 398 }
 399
 400 sub print_query {
 401     my $fh = shift;
 402     my %report = @_;
 403
 404         my $display = $report{display};
 405         my $height = $report{divheight};
 406         my $width = $report{divwidth};
 407         if (!defined $display or length $display == 0) { $display = 'table'; }
 408         my $rname = $report{name};
 409     my $query = $report{query};
 410         my $title = $report{report_title};
 411     my $sth = $dbh->prepare($query);
 412     $sth->execute();
 413
 414         if ($height) { $height = $height . 'px'; }
 415         if ($width)  { $width = $width . 'px'; }
 416     my $header_flag = 0;
 417
 418         #print asciidoc
 419         if ($display eq 'table') {
 420         while (my @row = $sth->fetchrow_array) {
 421             if ($header_flag == 0) {
 422                 print $fh "\n.*$report{report_title}*\n";
 423                 print $fh "|===\n";
 424                 my @h = split(/\./,$report{heading});
 425                 my $h_length = @h;
 426                 my $h_count = 1;
 427                 while ($h_count <= $h_length) {
 428                     print $fh "|*$h[$h_count-1]* ";
 429                     $h_count++;
 430                 }
 431                 print $fh "\n";
 432                 $header_flag = 1;
 433             }
 434             my $row_length = @row;
 435             my $r = 1;
 436             while ($r <= $row_length) {
 437                 if (! defined $row[$r-1] ) {
 438                     $row[$r-1] = 'none';
 439                 }
 440                 print $fh "|$row[$r-1] ";
 441                 $r++;
 442             }
 443             print $fh "\n";
 444         }
 445         if ($header_flag == 1) {
 446                 print $fh "|===\n\n";
 447                 print $fh $report{note};
 448                 print $fh "\n\n";
 449         }
 450         }
 451
 452     #print chart
 453         if ($display eq 'pie_chart' or $display eq 'donut_chart') {
 454                 my @h = split(/\./,$report{heading});
 455             my @l = split(/\./,$report{chart_labels});
 456
 457                 print $fh "++++\n";
 458                 if (defined $height and defined $width) { print $fh "<div id=\"$rname\" style=\"width: $width; height: $height;\"></div>\n"; }
 459                         else { print $fh "<div id=\"$rname\"></div>\n"; }
 460                 print $fh "<script type=\"text/javascript\">\n";
 461                 print $fh "google.charts.load('current', {'packages':['corechart']});\n";
 462                 print $fh "google.charts.setOnLoadCallback(drawChart);\n";
 463                 print $fh "function drawChart() {\n";
 464                 print $fh "  var data = google.visualization.arrayToDataTable([\n";
 465                 #loop through data here
 466                 print $fh "['$l[0]', '$l[1]' ],\n";
 467                 while (my @row = $sth->fetchrow_array) {
 468                         my $row_length = @row;
 469                         my $r = 1;
 470                         while ($r < $row_length) {
 471                 print $fh "['$h[$r-1]', $row[$r-1] ],\n";
 472                 $r++;
 473             }
 474                         if ($r = $row_length) { print $fh "['$h[$r-1]', $row[$r-1] ]\n"; }
 475                 }
 476                 print $fh "]);\n";
 477                 if ($display eq 'pie_chart') { print $fh "var options = {'title':'$title'};\n"; }
 478         if ($display eq 'donut_chart') { print $fh "var options = {'title':'$title', pieHole: 0.4};\n"; }
 479                 print $fh "var chart = new google.visualization.PieChart(document.getElementById('$rname'));\n";
 480         print $fh "chart.draw(data, options);\n";
 481                 print $fh "}\n";
 482                 print $fh "</script>\n";
 483                 print $fh "++++\n";
 484         }
 485
 486     print "successfully wrote output for $report{name}.\n\n";
 487 }
 488
 489 sub give_column {
 490     my $i = shift;
 491     my $col = "";
 492
 493     do {
 494         $col .= chr( ( $i % 26 ) + ord('A') );
 495         $i = int( $i / 26 ) - 1;
 496     } while ( $i >= 0 );
 497
 498     return scalar reverse $col;
 499 }
 500
 501 sub abort {
 502     my $msg = shift;
 503     print STDERR "$0: $msg", "\n";
 504     exit 1;
 505 }
 506
 507