mig-bin/mig-reporter

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