438efb6cca2ea5a1dcc75f7fcee4375847f74f85
[Evergreen.git] / Open-ILS / src / reporter / clark-kent.pl
1 #!/usr/bin/perl -w
2
3 use strict;
4 use DBI;
5 use XML::LibXML;
6 use Getopt::Long;
7 use DateTime;
8 use DateTime::Format::ISO8601;
9 use JSON;
10 use Data::Dumper;
11 use OpenILS::WWW::Reporter::transforms;
12
13 my $current_time = DateTime->from_epoch( epoch => time() )->strftime('%FT%T%z');
14
15 my ($base_xml, $count) = ('/openils/conf/reporter.xml', 1);
16
17 GetOptions(
18         "file=s"        => \$base_xml,
19         "concurrency=i" => \$count,
20 );
21
22 my $parser = XML::LibXML->new;
23 $parser->expand_xinclude(1);
24
25 my $doc = $parser->parse_file($base_xml);
26
27 warn $doc->toString;
28
29 my $db_driver = $doc->findvalue('/reporter/setup/database/driver');
30 my $db_host = $doc->findvalue('/reporter/setup/database/host');
31 my $db_name = $doc->findvalue('/reporter/setup/database/name');
32 my $db_user = $doc->findvalue('/reporter/setup/database/user');
33 my $db_pw = $doc->findvalue('/reporter/setup/database/password');
34
35 my $dsn = "dbi:" . $db_driver . ":dbname=" . $db_name .';host=' . $db_host;
36
37 my $dbh = DBI->connect($dsn,$db_user,$db_pw);
38
39 # make sure we're not already running $count reports
40 my ($running) = $dbh->selectrow_array(<<SQL);
41 SELECT  count(*)
42   FROM  reporter.run_queue
43   WHERE state = 'running';
44 SQL
45
46 if ($count <= $running) {
47         print "Already running maximum ($running) concurrent reports\n";
48         exit 1;
49 }
50
51 # if we have some open slots then generate the sql
52 my $run = $count - $running;
53 my $sth = $dbh->prepare(<<SQL);
54 SELECT  *
55   FROM  reporter.stage3
56   WHERE runtime <= ?
57   ORDER BY runtime
58   LIMIT $run
59 SQL
60
61 $sth->execute($current_time);
62
63 my @reports;
64 while (my $r = $sth->fetchrow_hashref) {
65         $r->{sql} = generate_query( $r );
66         push @reports, $r;
67 }
68 $sth->finish;
69
70 for my $r ( @reports ) {
71         my $sql = shift @{ $r->{sql} };
72
73         $sth = $dbh->prepare($sql);
74
75         $sth->execute(@{ $r->{sql} });
76         while (my $row = $sth->fetchrow_hashref) {
77                 print join(', ', map {"$_\t=> $$row{$_}"} keys %$row)."\n";
78         }
79 }
80
81
82 #-------------------------------------------------------------------
83
84 sub table_by_id {
85         my $id = shift;
86         my ($node) = $doc->findnodes("//*[\@id='$id']");
87         if ($node && $node->findvalue('@table')) {
88                 ($node) = $doc->findnodes("//*[\@id='".$node->getAttribute('table')."']");
89         }
90         return $node;
91 }
92
93 sub generate_query {
94         my $s3 = shift;
95         warn Dumper($s3);
96
97         my $r = JSON->JSON2perl( $s3->{params} );
98         warn Dumper($r);
99
100         my $s2 = $dbh->selectrow_hashref(<<"    SQL", {}, $s3->{stage2});
101                 SELECT  *
102                   FROM  reporter.stage2
103                   WHERE id = ?
104         SQL
105         warn Dumper($s2);
106
107         my @group_by;
108         my @aggs;
109         my $core = $s2->{stage1};
110         my @dims;
111
112         for my $t (keys %{$$r{filter}}) {
113                 if ($t ne $core) {
114                         push @dims, $t;
115                 }
116         }
117
118         for my $t (keys %{$$r{output}}) {
119                 if ($t ne $core && !grep { $t } @dims ) {
120                         push @dims, $t;
121                 }
122         }
123         warn Dumper(\@dims);
124
125         my @dim_select;
126         my @dim_from;
127         for my $d (@dims) {
128                 my $t = table_by_id($d);
129                 my $t_name = $t->findvalue('tablename');
130                 push @dim_from, "$t_name AS \"$d\"";
131
132                 my $k = $doc->findvalue("//*[\@id='$d']/\@key");
133                 push @dim_select, "\"$d\".\"$k\" AS \"${d}_${k}\"";
134
135                 for my $c ( keys %{$$r{output}{$d}} ) {
136                         push @dim_select, "\"$d\".\"$c\" AS \"${d}_${c}\"";
137                 }
138
139                 for my $c ( keys %{$$r{filter}{$d}} ) {
140                         next if (exists $$r{output}{$d}{$c});
141                         push @dim_select, "\"$d\".\"$c\" AS \"${d}_${c}\"";
142                 }
143         }
144
145         my $d_select =
146                 '(SELECT ' . join(',', @dim_select) .
147                 '  FROM ' . join(',', @dim_from) . ') AS dims';
148         
149         warn "*** [$d_select]\n";
150
151         my $col = 1;
152         my @groupby;
153         my @output;
154         my @join;
155         for my $t ( keys %{$$r{output}} ) {
156                 my $t_name = $t;
157                 $t_name = "dims" if ($t ne $core);
158
159                 my $t_node = table_by_id($t);
160
161                 for my $c ( keys %{$$r{output}{$t}} ) {
162                         my $label = $t_node->findvalue("fields/field[\@name='$c']/label");
163
164                         my $full_col = $c;
165                         $full_col = "${t}_${c}" if ($t ne $t_name);
166                         $full_col = "\"$t_name\".\"$full_col\"";
167
168                         
169                         if (my $xform_type = $$r{xform}{type}{$t}{$c}) {
170                                 my $xform = $$OpenILS::WWW::Reporter::dtype_xforms{$xform_type};
171                                 if ($xform->{group}) {
172                                         push @groupby, $col;
173                                 }
174                                 $label = "$$xform{label} -- $label";
175
176                                 my $tmp = $xform->{'select'};
177                                 $tmp =~ s/\?COLNAME\?/$full_col/gs;
178                                 $tmp =~ s/\?PARAM\?/$$r{xform}{param}{$t}{$c}/gs;
179                                 $full_col = $tmp;
180                         } else {
181                                 push @groupby, $col;
182                         }
183
184                         push @output, "$full_col AS \"$label\"";
185                         $col++;
186                 }
187
188                 if ($t ne $t_name) {
189                         my $k = $doc->findvalue("//*[\@id='$t']/\@key");
190                         my $f = $doc->findvalue("//*[\@id='$t']/\@field");
191                         push @join, "dims.\"${t}_${k}\" = \"$core\".\"$f\"";
192                 }
193         }
194
195         my @where;
196         my @bind;
197         for my $t ( keys %{$$r{filter}} ) {
198                 my $t_name = $t;
199                 $t_name = "dims" if ($t ne $core);
200
201                 my $t_node = table_by_id($t);
202
203                 for my $c ( keys %{$$r{filter}{$t}} ) {
204                         my $label = $t_node->findvalue("fields/field[\@name='$c']/label");
205
206                         my $full_col = $c;
207                         $full_col = "${t}_${c}" if ($t ne $t_name);
208                         $full_col = "\"$t_name\".\"$full_col\"";
209
210                         # XXX make this use widget specific code
211
212                         my ($fam) = keys %{ $$r{filter}{$t}{$c} };
213                         my ($w) = keys %{ $$r{filter}{$t}{$c}{$fam} };
214                         my $val = $$r{filter}{$t}{$c}{$fam}{$w};
215
216                         if (ref $val) {
217                                 push @where, "$full_col IN (".join(",",map {'?'}@$val).")";
218                                 push @bind, @$val;
219                         } else {
220                                 push @where, "$full_col = ?";
221                                 push @bind, $val;
222                         }
223                 }
224         }
225
226         my $t = table_by_id($core)->findvalue('tablename');
227         my $from = " FROM $t AS \"$core\" RIGHT JOIN $d_select ON (". join(' AND ', @join).")";
228         my $select =
229                 "SELECT ".join(',', @output).
230                   $from.
231                   ' WHERE '.join(' AND ', @where).
232                   ' GROUP BY '.join(',',@groupby);
233
234         warn " !!! [$select]\n";
235         warn " !!! [".join(', ',@bind)."]\n";
236
237         return [ $select, @bind ];
238 }
239
240
241
242
243
244