Dump of bugs.webkit.org's Bugzilla instance.
[WebKit-https.git] / BugsSite / reports.cgi
1 #!/usr/bin/perl -wT
2 # -*- Mode: perl; indent-tabs-mode: nil -*-
3 #
4 # The contents of this file are subject to the Mozilla Public
5 # License Version 1.1 (the "License"); you may not use this file
6 # except in compliance with the License. You may obtain a copy of
7 # the License at http://www.mozilla.org/MPL/
8 #
9 # Software distributed under the License is distributed on an "AS
10 # IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
11 # implied. See the License for the specific language governing
12 # rights and limitations under the License.
13 #
14 # The Original Code is the Bugzilla Bug Tracking System.
15 #
16 # The Initial Developer of the Original Code is Netscape Communications
17 # Corporation. Portions created by Netscape are
18 # Copyright (C) 1998 Netscape Communications Corporation. All
19 # Rights Reserved.
20 #
21 # Contributor(s): Harrison Page <harrison@netscape.com>,
22 # Terry Weissman <terry@mozilla.org>,
23 # Dawn Endico <endico@mozilla.org>
24 # Bryce Nesbitt <bryce@nextbus.COM>,
25 # Joe Robins <jmrobins@tgix.com>,
26 # Gervase Markham <gerv@gerv.net> and Adam Spiers <adam@spiers.net>
27 #    Added ability to chart any combination of resolutions/statuses.
28 #    Derive the choice of resolutions/statuses from the -All- data file
29 #    Removed hardcoded order of resolutions/statuses when reading from
30 #    daily stats file, so now works independently of collectstats.pl
31 #    version
32 #    Added image caching by date and datasets
33 # Myk Melez <myk@mozilla.org):
34 #    Implemented form field validation and reorganized code.
35
36 use strict;
37
38 use lib qw(.);
39
40 use Bugzilla::Config qw(:DEFAULT $datadir);
41
42 require "CGI.pl";
43
44 require "globals.pl";
45 use vars qw(@legal_product); # globals from er, globals.pl
46
47 eval "use GD";
48 $@ && ThrowCodeError("gd_not_installed");
49 eval "use Chart::Lines";
50 $@ && ThrowCodeError("chart_lines_not_installed");
51
52 my $dir = "$datadir/mining";
53 my $graph_dir = "graphs";
54
55 use Bugzilla;
56
57 # If we're using bug groups for products, we should apply those restrictions
58 # to viewing reports, as well.  Time to check the login in that case.
59 Bugzilla->login();
60
61 GetVersionTable();
62
63 Bugzilla->switch_to_shadow_db();
64
65 my $cgi = Bugzilla->cgi;
66
67 # We only want those products that the user has permissions for.
68 my @myproducts;
69 push( @myproducts, "-All-");
70 push( @myproducts, GetSelectableProducts());
71
72 if (! defined $cgi->param('product')) {
73
74     choose_product(@myproducts);
75     PutFooter();
76
77 } else {
78     my $product = $cgi->param('product');
79
80     # For security and correctness, validate the value of the "product" form variable.
81     # Valid values are those products for which the user has permissions which appear
82     # in the "product" drop-down menu on the report generation form.
83     grep($_ eq $product, @myproducts)
84       || ThrowUserError("invalid_product_name", {product => $product});
85
86     # We've checked that the product exists, and that the user can see it
87     # This means that is OK to detaint
88     trick_taint($product);
89
90     print $cgi->header(-Content_Disposition=>'inline; filename=bugzilla_report.html');
91
92     PutHeader("Bug Charts");
93
94     show_chart($product);
95
96     PutFooter();
97 }
98
99
100 ##################################
101 # user came in with no form data #
102 ##################################
103
104 sub choose_product {
105     my @myproducts = (@_);
106     
107     my $datafile = daily_stats_filename('-All-');
108
109     # Can we do bug charts?  
110     (-d $dir && -d $graph_dir) 
111       || ThrowCodeError("chart_dir_nonexistent", 
112                         {dir => $dir, graph_dir => $graph_dir});
113       
114     open(DATA, "$dir/$datafile")
115       || ThrowCodeError("chart_file_open_fail", {filename => "$dir/$datafile"});
116  
117     print $cgi->header();
118     PutHeader("Bug Charts");
119
120     print <<FIN;
121 <center>
122 <h1>Welcome to the Bugzilla Charting Kitchen</h1>
123 <form method=get action=reports.cgi>
124 <table border=1 cellpadding=5>
125 <tr>
126 <td align=center><b>Product:</b></td>
127 <td align=center>
128 <select name="product">
129 FIN
130 foreach my $product (@myproducts) {
131     $product = html_quote($product);
132     print qq{<option value="$product">$product</option>};
133 }
134 print <<FIN;
135 </select>
136 </td>
137 </tr>
138 <tr>
139   <td align=center><b>Chart datasets:</b></td>
140   <td align=center>
141   <select name="datasets" multiple size=5>
142 FIN
143
144       my @datasets = ();
145
146       while (<DATA>) {
147           if (/^# fields?: (.+)\s*$/) {
148               @datasets = grep ! /date/i, (split /\|/, $1);
149               last;
150           }
151       }
152
153       close(DATA);
154
155       my %default_sel = map { $_ => 1 }
156                             qw/UNCONFIRMED NEW ASSIGNED REOPENED/;
157       foreach my $dataset (@datasets) {
158           my $sel = $default_sel{$dataset} ? ' selected' : '';
159           print qq{<option value="$dataset:"$sel>$dataset</option>\n};
160       }
161
162       print <<FIN;
163       </select>
164       </td>
165       </tr>
166 <tr>
167 <td colspan=2 align=center>
168 <input type=submit value=Continue>
169 </td>
170 </tr>
171 </table>
172 </center>
173 </form>
174 <p>
175 FIN
176 }
177
178 sub daily_stats_filename {
179     my ($prodname) = @_;
180     $prodname =~ s/\//-/gs;
181     return $prodname;
182 }
183
184 sub show_chart {
185     my ($product) = @_;
186
187     if (! defined $cgi->param('datasets')) {
188         ThrowUserError("missing_datasets");
189     }
190     my $datasets = join('', $cgi->param('datasets'));
191
192   print <<FIN;
193 <center>
194 FIN
195
196     my $type = chart_image_type();
197     my $data_file = daily_stats_filename($product);
198     my $image_file = chart_image_name($data_file, $type, $datasets);
199     my $url_image = "$graph_dir/" . url_quote($image_file);
200
201     if (! -e "$graph_dir/$image_file") {
202         generate_chart("$dir/$data_file", "$graph_dir/$image_file", $type,
203                        $product, $datasets);
204     }
205     
206     print <<FIN;
207 <img src="$url_image">
208 <br clear=left>
209 <br>
210 FIN
211 }
212
213 sub chart_image_type {
214     # what chart type should we be generating?
215     my $testimg = Chart::Lines->new(2,2);
216     my $type = $testimg->can('gif') ? "gif" : "png";
217
218     undef $testimg;
219     return $type;
220 }
221
222 sub chart_image_name {
223     my ($data_file, $type, $datasets) = @_;
224
225     # This routine generates a filename from the requested fields. The problem
226     # is that we have to check the safety of doing this. We can't just require
227     # that the fields exist, because what stats were collected could change
228     # over time (eg by changing the resolutions available)
229     # Instead, just require that each field name consists only of letters
230     # and number
231
232     if ($datasets !~ m/^[A-Za-z0-9:]+$/) {
233         die "Invalid datasets $datasets";
234     }
235
236     # Since we pass the tests, consider it OK
237     trick_taint($datasets);
238
239     # Cache charts by generating a unique filename based on what they
240     # show. Charts should be deleted by collectstats.pl nightly.
241     my $id = join ("_", split (":", $datasets));
242
243     return "${data_file}_${id}.$type";
244 }
245
246 sub day_of_year {
247     my ($mday, $month, $year) = (localtime())[3 .. 5];
248     $month += 1;
249     $year += 1900;
250     my $date = sprintf "%02d%02d%04d", $mday, $month, $year;
251 }
252
253 sub generate_chart {
254     my ($data_file, $image_file, $type, $product, $datasets) = @_;
255     
256     if (! open FILE, $data_file) {
257         ThrowCodeError("chart_data_not_generated");
258     }
259
260     my @fields;
261     my @labels = qw(DATE);
262     my %datasets = map { $_ => 1 } split /:/, $datasets;
263
264     my %data = ();
265     while (<FILE>) {
266         chomp;
267         next unless $_;
268         if (/^#/) {
269             if (/^# fields?: (.*)\s*$/) {
270                 @fields = split /\||\r/, $1;
271                 ThrowCodeError("chart_datafile_corrupt", {file => $data_file})
272                   unless $fields[0] =~ /date/i;
273                 push @labels, grep($datasets{$_}, @fields);
274             }
275             next;
276         }
277
278         ThrowCodeError("chart_datafile_corrupt", {file => $data_file})
279           unless @fields;
280         
281         my @line = split /\|/;
282         my $date = $line[0];
283         my ($yy, $mm, $dd) = $date =~ /^\d{2}(\d{2})(\d{2})(\d{2})$/;
284         push @{$data{DATE}}, "$mm/$dd/$yy";
285         
286         for my $i (1 .. $#fields) {
287             my $field = $fields[$i];
288             if (! defined $line[$i] or $line[$i] eq '') {
289                 # no data point given, don't plot (this will probably
290                 # generate loads of Chart::Base warnings, but that's not
291                 # our fault.)
292                 push @{$data{$field}}, undef;
293             }
294             else {
295                 push @{$data{$field}}, $line[$i];
296             }
297         }
298     }
299     
300     shift @labels;
301
302     close FILE;
303
304     if (! @{$data{DATE}}) {
305         ThrowUserError("insufficient_data_points");
306     }
307     
308     my $img = Chart::Lines->new (800, 600);
309     my $i = 0;
310
311     my $MAXTICKS = 20;      # Try not to show any more x ticks than this.
312     my $skip = 1;
313     if (@{$data{DATE}} > $MAXTICKS) {
314         $skip = int((@{$data{DATE}} + $MAXTICKS - 1) / $MAXTICKS);
315     }
316
317     my %settings =
318         (
319          "title" => "Status Counts for $product",
320          "x_label" => "Dates",
321          "y_label" => "Bug Counts",
322          "legend_labels" => \@labels,
323          "skip_x_ticks" => $skip,
324          "y_grid_lines" => "true",
325          "grey_background" => "false",
326          "colors" => {
327                       # default dataset colours are too alike
328                       dataset4 => [0, 0, 0], # black
329                      },
330         );
331     
332     $img->set (%settings);
333     $img->$type($image_file, [ @data{('DATE', @labels)} ]);
334 }