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;
  67 my $report_title;
  68 my $reports_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     'reports_xml:s'       => \$reports_xml,
  84     'tags:s'              => \$tags,
  85     'added_page_title:s'  => \$added_page_title,
  86     'added_page_file:s'   => \$added_page_file,
  87     'captions:s'          => \$captions,
  88         'debug:s'             => \$debug
  89 );
  90
  91 if (!defined $tags) {$tags = 'circs.holds.actors.bibs.assets.money.notices'};
  92 if (!defined $report_title) { abort('--report_title must be supplied'); }
  93 if (!defined $analyst) { abort('--analyst must be supplied'); }
  94
  95 my $mig_path = abs_path($0);
  96 $mig_path =~ s|[^/]+$||;
  97 $reports_xml = find_xml($reports_xml,$mig_path);
  98 if (!defined $reports_xml) { abort("Can not find xml reports file."); }
  99 my $dom = $parser->parse_file($reports_xml);
 100
 101 if (defined $added_page_file or defined $added_page_title) {
 102     abort('must specify --added_page_file and --added_page_title') unless defined $added_page_file and defined $added_page_title;
 103     }
 104 if (defined $added_page_file) { $added_page_file = $MIGGITDIR . $added_page_file; }
 105
 106 my $dbh = Mig::db_connect();
 107 my $report_file = create_report_name($report_title);
 108 $report_file = $MIGGITDIR . $report_file;
 109
 110 open($fh, '>', $report_file) or abort("Could not open output file $report_file!");
 111 write_title_page($report_title,$fh,$analyst,$captions);
 112
 113 if (defined $added_page_file and defined $added_page_title) {
 114     print $fh "<<<\n";
 115     print $fh "== $added_page_title\n";
 116     print "$added_page_file\t$added_page_title\n";
 117     open(my $an,'<:encoding(UTF-8)', $added_page_file) or abort("Could not open $added_page_file!");
 118     while ( my $line = <$an> ) {
 119         print $fh $line;
 120     }
 121     print $fh "\n";
 122     close $an;
 123 }
 124
 125 foreach my $func ($dom->findnodes('//function')) {
 126     my $fdrop = $func->findvalue('./drop');
 127     my $fcreate = $func->findvalue('./create');
 128     my $fname = $func->findvalue('./name');
 129     my $sdrop = $dbh->prepare($fdrop);
 130     my $screate = $dbh->prepare($fcreate);
 131     print "dropping function $fname ... ";
 132     $sdrop->execute();
 133     print "creating function $fname\n\n";
 134     $screate->execute();
 135 }
 136
 137 $tags = lc($tags);
 138 my @report_tags = split(/\./,$tags);
 139 foreach my $t (@report_tags) {
 140     print "\n\n=========== Starting to process tag $t\n";
 141     print   "==========================================\n\n";
 142
 143     my @asset_files;
 144     foreach my $asset ($dom->findnodes('//asset')) {
 145         if (index($asset->findvalue('./tag'),$t) != -1) {
 146             push @asset_files, $asset->findvalue('./file');
 147         }
 148     }
 149
 150     foreach my $fname (@asset_files) {
 151         my $asset_path = $mig_path . '../mig-asc/' . $fname;
 152         open my $a, $asset_path or abort("Could not open $fname.");
 153         while ( my $l = <$a> ) {
 154             print $fh $l;
 155         }
 156     print $fh "<<<\n";
 157     }
 158
 159     print_section_header(ucfirst($t),$fh);
 160     my $linecount = $lines_per_page;
 161     my $r;
 162
 163     undef @asset_files;
 164     foreach my $asset ($dom->findnodes('//asset')) {
 165         if (index($asset->findvalue('./tag'),$t) != -1) {
 166             push @asset_files, $asset->findvalue('./file');
 167         }
 168     }
 169
 170     my @report_names;
 171     foreach my $report ($dom->findnodes('//report')) {
 172         if (index($report->findvalue('./tag'),$t) != -1 and $report->findvalue('./iteration') eq '0') {
 173             push @report_names, $report->findvalue('./name');
 174         }
 175     }
 176
 177     #only has one level of failover now but could change to array of hashes and loops
 178     #but this keeps it simple and in practice I haven't needed more than two
 179
 180
 181     foreach my $rname (@report_names) {
 182         my %report0;
 183         my %report1;
 184         my $check_tables0;
 185         my $check_tables1;
 186
 187         if ($debug eq 'on') {print "\nchecking for $rname ... ";}
 188         %report0 = find_report($dom,$t,$rname,'0',$debug);
 189         $check_tables0 = check_table($report0{query},$MIGSCHEMA,$debug,$rname);
 190         if ($check_tables0 == 1) { $r =  print_query($fh,%report0); } else {
 191                 %report1 = find_report($dom,$t,$rname,'1',$debug);
 192             if (defined $report1{query}) {
 193                 $check_tables1 = check_table($report1{query},$MIGSCHEMA,$debug,$rname);
 194                 if ($check_tables1 == 1) { $r = print_query($fh,%report1); }
 195             }
 196         }
 197     }
 198
 199 }
 200
 201 print "\n";
 202
 203 close $fh;
 204
 205 ############ end of main logic
 206
 207 sub find_xml {
 208     my $reports_xml = shift;
 209     my $mig_path = shift;
 210
 211     if ($reports_xml =~ m/\//) { return $reports_xml; }
 212
 213     my $mig_test_file =  $mig_path . '/../mig-xml/' . $reports_xml;
 214     my $working_test_dir = getcwd();
 215     my $working_test_file = $working_test_dir . '/' . $reports_xml;
 216
 217     if (-e $mig_test_file) { return $mig_test_file; }
 218     if (-e $working_test_file) { return $working_test_file; }
 219
 220     return undef;
 221 }
 222
 223 sub find_report {
 224     my $dom = shift;
 225     my $tag = shift;
 226     my $name = shift;
 227     my $iteration = shift;
 228     my $debug = shift;
 229     my %report;
 230
 231     if ($debug eq 'on') {print "iteration $iteration ";}
 232     foreach my $node ($dom->findnodes('//report')) {
 233         if ($node->findvalue('./tag') =~ $tag and $node->findvalue('./iteration') eq $iteration and $node->findvalue('./name') eq $name) {
 234             if ($debug eq 'on') {print "succeeded ... \n";}
 235             %report = (
 236                 name => $node->findvalue('./name'),
 237                 report_title => $node->findvalue('./report_title'),
 238                 query => $node->findvalue('./query'),
 239                 heading => $node->findvalue('./heading'),
 240                 tag => $node->findvalue('./tag'),
 241                 iteration => $node->findvalue('./iteration'),
 242                 note => $node->findvalue('./note'),
 243             );
 244             return %report;
 245         }
 246     }
 247     if ($debug eq 'on') {print "failed ... \n";}
 248     return %report = (
 249         name => "eaten by grue"
 250     );
 251 }
 252
 253 sub print_section_header {
 254     my $t = shift;
 255     my $fh = shift;
 256
 257     $t =~ s/_/ /g;
 258     #$t =~ s/(\w+)/\u$1/g;;
 259     print $fh "<<<\n";
 260     print $fh "== $t Reports\n";
 261     return;
 262 }
 263
 264 sub create_report_name {
 265     my $rt = shift;
 266
 267     my @abbr = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 268     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 269     $year += 1900;
 270     my $date = $year . '_' . $abbr[$mon] . '_' . $mday;
 271     my $report_file;
 272     $report_file = $rt . ' ' . $date . '.asciidoc';
 273     $report_file =~ s/ /_/g;
 274     return $report_file;
 275 }
 276
 277 sub write_title_page {
 278     my $rt = shift;
 279     my $fh = shift;
 280     my $a = shift;
 281     my $captions = shift;
 282
 283     my @abbr = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 284     my $l = length($report_title);
 285     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 286     $year += 1900;
 287     print $fh "= $rt\n";
 288     print $fh "$mday $abbr[$mon] $year\n";
 289     print $fh "$a\n";
 290     #print $fh ":title-logo-image: image::eolilogosmall.png[pdfwidth=3in]\n";
 291     print $fh ":toc:\n";
 292     if ($captions eq 'on') { print $fh ":caption:\n"; }
 293     print $fh "\n";
 294 }
 295
 296 sub check_table {
 297     my $query = shift;
 298     my $MIGSCHEMA = shift;
 299     my $debug = shift;
 300     my $report_name = shift;
 301
 302     if ($debug eq 'on') {print "$query\n";}
 303
 304     my $i;
 305     my $return_flag = 1;
 306     my @qe = split(/ /,$query);
 307     $i = @qe;
 308     $i--;
 309     my @tables;
 310     while ($i > -1) {
 311         if ($qe[$i] eq 'FROM' or $qe[$i] eq 'JOIN') {
 312             my $q = $i + 1;
 313             if ($qe[$q] ne '(SELECT') {
 314                 push @tables, $qe[$q];
 315             }
 316         }
 317         $i--;
 318     }
 319     if ($debug eq 'on') {print "checking tables ... ";}
 320
 321     $i = 0;
 322     foreach my $table (@tables) {
 323         my $sql;
 324         my $schema;
 325         if (index($table,'.') != -1) {
 326             $schema = (split /\./,$table)[0];
 327             $table = (split /\./,$table)[1];
 328         }
 329         $table = clean_query_string($table);
 330         if (defined $schema) {
 331             $schema = clean_query_string($schema);
 332             $sql = 'SELECT EXISTS (SELECT 1 FROM information_schema.tables WHERE table_schema = \'' . $schema . '\' AND table_name = \'' . $table . '\');';
 333         } else {
 334             $sql = 'SELECT EXISTS (SELECT 1 FROM information_schema.tables WHERE table_schema = \'' . $MIGSCHEMA . '\' AND table_name = \'' . $table . '\');';
 335         }
 336         my $sth = $dbh->prepare($sql);
 337         $sth->execute();
 338         while (my @row = $sth->fetchrow_array) {
 339             if ($row[0] eq '1') {
 340                     next;
 341                 } else {
 342                     $return_flag = 0;
 343                     if ($debug eq 'on') {print "detecting $table failed...\n";}
 344                 }
 345             if ($row[0] eq '0') {$return_flag = 0;}
 346         }
 347     }
 348     if ($return_flag == 1 and $debug eq 'on') {print "succeeded ...\n";}
 349     if ($return_flag == 0) {print "! a table failed the find test for report $report_name\n\n";}
 350     return $return_flag;
 351 }
 352
 353 sub clean_query_string {
 354     my $str = shift;
 355
 356     $str =~ s/(?!_)[[:punct:]]//g; #remove punct except underscores
 357     $str =~ s/\n//g;
 358     $str =~ s/\r//g;
 359     return $str;
 360 }
 361
 362 sub print_query {
 363     my $fh = shift;
 364     my %report = @_;
 365     my $query = $report{query};
 366     my $sth = $dbh->prepare($query);
 367     $sth->execute();
 368
 369     my $header_flag = 0;
 370
 371     while (my @row = $sth->fetchrow_array) {
 372             if ($header_flag == 0) {
 373                 print $fh "\n.*$report{report_title}*\n";
 374                 print $fh "|===\n";
 375                 my @h = split(/\./,$report{heading});
 376                 my $h_length = @h;
 377                 my $h_count = 1;
 378                 while ($h_count <= $h_length) {
 379                     print $fh "|*$h[$h_count-1]* ";
 380                     $h_count++;
 381                 }
 382                 print $fh "\n";
 383                 $header_flag = 1;
 384             }
 385             my $row_length = @row;
 386             my $r = 1;
 387             while ($r <= $row_length) {
 388                 if (! defined $row[$r-1] ) {
 389                     $row[$r-1] = 'none';
 390                 }
 391                 print $fh "|$row[$r-1] ";
 392                 $r++;
 393             }
 394             print $fh "\n";
 395         }
 396     if ($header_flag == 1) {
 397         print $fh "|===\n\n";
 398         print $fh $report{note};
 399         print $fh "\n\n";
 400     }
 401     print "successfully wrote output for $report{name}.\n\n";
 402 }
 403
 404 sub give_column {
 405     my $i = shift;
 406     my $col = "";
 407
 408     do {
 409         $col .= chr( ( $i % 26 ) + ord('A') );
 410         $i = int( $i / 26 ) - 1;
 411     } while ( $i >= 0 );
 412
 413     return scalar reverse $col;
 414 }
 415
 416 sub abort {
 417     my $msg = shift;
 418     print STDERR "$0: $msg", "\n";
 419     exit 1;
 420 }
 421
 422