3 ###############################################################################
6 =item B<reporter> --analyst "Analyst Name" --report_title "Report Title"
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.
11 Optional parameters are :
13 --added_page_title and --added_page_file
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.
20 This will define a set of tags to use, if not set it will default to Circs,
21 Holds, Actors, Bibs, Assets & Money.
25 Gives more information about what is happening. Defaults to off.
29 Allows you to override the default evergreen_staged_report.xml in the mig-xml folder.
31 --captions on OR --captions off
33 Adds the captions tag to asciidoc header to turn off captions in generated output.
40 ###############################################################################
49 HOME PGHOST PGPORT PGUSER PGDATABASE MIGSCHEMA
50 MIGBASEWORKDIR MIGBASEGITDIR MIGGITDIR MIGWORKDIR
58 my $mig_bin = "$FindBin::Bin/";
59 use lib "$FindBin::Bin/";
61 use open ':encoding(utf8)';
63 pod2usage(-verbose => 2) if defined $ARGV[0] && $ARGV[0] eq '--help';
64 pod2usage(-verbose => 1) if ! $ARGV[1];
74 my $parser = XML::LibXML->new();
75 my $lines_per_page = 42;
81 'analyst:s' => \$analyst,
82 'report_title:s' => \$report_title,
83 'reports_xml:s' => \$reports_xml,
85 'added_page_title:s' => \$added_page_title,
86 'added_page_file:s' => \$added_page_file,
87 'captions:s' => \$captions,
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'); }
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);
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;
104 if (defined $added_page_file) { $added_page_file = $MIGGITDIR . $added_page_file; }
106 my $dbh = Mig::db_connect();
107 my $report_file = create_report_name($report_title);
108 $report_file = $MIGGITDIR . $report_file;
110 open($fh, '>', $report_file) or abort("Could not open output file $report_file!");
111 write_title_page($report_title,$fh,$analyst,$captions);
113 if (defined $added_page_file and defined $added_page_title) {
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> ) {
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 ... ";
133 print "creating function $fname\n\n";
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";
144 foreach my $asset ($dom->findnodes('//asset')) {
145 if (index($asset->findvalue('./tag'),$t) != -1) {
146 push @asset_files, $asset->findvalue('./file');
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> ) {
159 print_section_header(ucfirst($t),$fh);
160 my $linecount = $lines_per_page;
164 foreach my $asset ($dom->findnodes('//asset')) {
165 if (index($asset->findvalue('./tag'),$t) != -1) {
166 push @asset_files, $asset->findvalue('./file');
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');
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
181 foreach my $rname (@report_names) {
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); }
205 ############ end of main logic
208 my $reports_xml = shift;
209 my $mig_path = shift;
211 if ($reports_xml =~ m/\//) { return $reports_xml; }
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;
217 if (-e $mig_test_file) { return $mig_test_file; }
218 if (-e $working_test_file) { return $working_test_file; }
227 my $iteration = shift;
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";}
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'),
247 if ($debug eq 'on') {print "failed ... \n";}
249 name => "eaten by grue"
253 sub print_section_header {
258 #$t =~ s/(\w+)/\u$1/g;;
260 print $fh "== $t Reports\n";
264 sub create_report_name {
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);
270 my $date = $year . '_' . $abbr[$mon] . '_' . $mday;
272 $report_file = $rt . ' ' . $date . '.asciidoc';
273 $report_file =~ s/ /_/g;
277 sub write_title_page {
281 my $captions = shift;
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);
288 print $fh "$mday $abbr[$mon] $year\n";
290 #print $fh ":title-logo-image: image::eolilogosmall.png[pdfwidth=3in]\n";
292 if ($captions eq 'on') { print $fh ":caption:\n"; }
298 my $MIGSCHEMA = shift;
300 my $report_name = shift;
302 if ($debug eq 'on') {print "$query\n";}
306 my @qe = split(/ /,$query);
311 if ($qe[$i] eq 'FROM' or $qe[$i] eq 'JOIN') {
313 if ($qe[$q] ne '(SELECT') {
314 push @tables, $qe[$q];
319 if ($debug eq 'on') {print "checking tables ... ";}
322 foreach my $table (@tables) {
325 if (index($table,'.') != -1) {
326 $schema = (split /\./,$table)[0];
327 $table = (split /\./,$table)[1];
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 . '\');';
334 $sql = 'SELECT EXISTS (SELECT 1 FROM information_schema.tables WHERE table_schema = \'' . $MIGSCHEMA . '\' AND table_name = \'' . $table . '\');';
336 my $sth = $dbh->prepare($sql);
338 while (my @row = $sth->fetchrow_array) {
339 if ($row[0] eq '1') {
343 if ($debug eq 'on') {print "detecting $table failed...\n";}
345 if ($row[0] eq '0') {$return_flag = 0;}
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";}
353 sub clean_query_string {
356 $str =~ s/(?!_)[[:punct:]]//g; #remove punct except underscores
365 my $query = $report{query};
366 my $sth = $dbh->prepare($query);
371 while (my @row = $sth->fetchrow_array) {
372 if ($header_flag == 0) {
373 print $fh "\n.*$report{report_title}*\n";
375 my @h = split(/\./,$report{heading});
378 while ($h_count <= $h_length) {
379 print $fh "|*$h[$h_count-1]* ";
385 my $row_length = @row;
387 while ($r <= $row_length) {
388 if (! defined $row[$r-1] ) {
391 print $fh "|$row[$r-1] ";
396 if ($header_flag == 1) {
397 print $fh "|===\n\n";
398 print $fh $report{note};
401 print "successfully wrote output for $report{name}.\n\n";
409 $col .= chr( ( $i % 26 ) + ord('A') );
410 $i = int( $i / 26 ) - 1;
413 return scalar reverse $col;
418 print STDERR "$0: $msg", "\n";