Merged BugsSite to Bugzilla-3.0.3
[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 # Frédéric Buclin <LpSolit@gmail.com>:
36 #    Templatization.
37
38 use strict;
39
40 use lib qw(.);
41
42 use Bugzilla;
43 use Bugzilla::Constants;
44 use Bugzilla::Util;
45 use Bugzilla::Error;
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       = bz_locations()->{'datadir'} . "/mining";
53 my $graph_url = 'graphs';
54 my $graph_dir = bz_locations()->{'libpath'} . '/' .$graph_url;
55
56 # If we're using bug groups for products, we should apply those restrictions
57 # to viewing reports, as well.  Time to check the login in that case.
58 my $user = Bugzilla->login();
59
60 Bugzilla->switch_to_shadow_db();
61
62 my $cgi = Bugzilla->cgi;
63 my $template = Bugzilla->template;
64 my $vars = {};
65
66 # We only want those products that the user has permissions for.
67 my @myproducts;
68 push( @myproducts, "-All-");
69 # Extract product names from objects and add them to the list.
70 push( @myproducts, map { $_->name } @{$user->get_selectable_products} );
71
72 if (! defined $cgi->param('product')) {
73     # Can we do bug charts?
74     (-d $dir && -d $graph_dir) 
75       || ThrowCodeError('chart_dir_nonexistent',
76                         {dir => $dir, graph_dir => $graph_dir});
77
78     my %default_sel = map { $_ => 1 } qw/UNCONFIRMED NEW ASSIGNED REOPENED/;
79
80     my @datasets;
81     my @data = get_data($dir);
82
83     foreach my $dataset (@data) {
84         my $datasets = {};
85         $datasets->{'value'} = $dataset;
86         $datasets->{'selected'} = $default_sel{$dataset} ? 1 : 0;
87         push(@datasets, $datasets);
88     }
89
90     $vars->{'datasets'} = \@datasets;
91     $vars->{'products'} = \@myproducts;
92
93     print $cgi->header();
94
95     $template->process('reports/old-charts.html.tmpl', $vars)
96       || ThrowTemplateError($template->error());
97     exit;
98 }
99 else {
100     my $product = $cgi->param('product');
101
102     # For security and correctness, validate the value of the "product" form variable.
103     # Valid values are those products for which the user has permissions which appear
104     # in the "product" drop-down menu on the report generation form.
105     grep($_ eq $product, @myproducts)
106       || ThrowUserError("invalid_product_name", {product => $product});
107
108     # We've checked that the product exists, and that the user can see it
109     # This means that is OK to detaint
110     trick_taint($product);
111
112     defined($cgi->param('datasets')) || ThrowUserError('missing_datasets');
113
114     my $datasets = join('', $cgi->param('datasets'));
115
116     my $type = chart_image_type();
117     my $data_file = daily_stats_filename($product);
118     my $image_file = chart_image_name($data_file, $type, $datasets);
119     my $url_image = correct_urlbase() . "$graph_url/$image_file";
120
121     if (! -e "$graph_dir/$image_file") {
122         generate_chart("$dir/$data_file", "$graph_dir/$image_file", $type,
123                        $product, $datasets);
124     }
125
126     $vars->{'url_image'} = $url_image;
127
128     print $cgi->header(-Content_Disposition=>'inline; filename=bugzilla_report.html');
129
130     $template->process('reports/old-charts.html.tmpl', $vars)
131       || ThrowTemplateError($template->error());
132     exit;
133 }
134
135 #####################
136 #    Subroutines    #
137 #####################
138
139 sub get_data {
140     my $dir = shift;
141
142     my @datasets;
143     my $datafile = daily_stats_filename('-All-');
144     open(DATA, '<', "$dir/$datafile")
145       || ThrowCodeError('chart_file_open_fail', {filename => "$dir/$datafile"});
146
147     while (<DATA>) {
148         if (/^# fields?: (.+)\s*$/) {
149             @datasets = grep ! /date/i, (split /\|/, $1);
150             last;
151         }
152     }
153     close(DATA);
154     return @datasets;
155 }
156
157 sub daily_stats_filename {
158     my ($prodname) = @_;
159     $prodname =~ s/\//-/gs;
160     return $prodname;
161 }
162
163 sub chart_image_type {
164     # what chart type should we be generating?
165     my $testimg = Chart::Lines->new(2,2);
166     my $type = $testimg->can('gif') ? "gif" : "png";
167
168     undef $testimg;
169     return $type;
170 }
171
172 sub chart_image_name {
173     my ($data_file, $type, $datasets) = @_;
174
175     # This routine generates a filename from the requested fields. The problem
176     # is that we have to check the safety of doing this. We can't just require
177     # that the fields exist, because what stats were collected could change
178     # over time (eg by changing the resolutions available)
179     # Instead, just require that each field name consists only of letters,
180     # numbers, underscores and hyphens.
181
182     if ($datasets !~ m/^[A-Za-z0-9:_-]+$/) {
183         ThrowUserError('invalid_datasets', {'datasets' => $datasets});
184     }
185
186     # Since we pass the tests, consider it OK
187     trick_taint($datasets);
188
189     # Cache charts by generating a unique filename based on what they
190     # show. Charts should be deleted by collectstats.pl nightly.
191     my $id = join ("_", split (":", $datasets));
192
193     return "${data_file}_${id}.$type";
194 }
195
196 sub generate_chart {
197     my ($data_file, $image_file, $type, $product, $datasets) = @_;
198
199     if (! open FILE, $data_file) {
200         if ($product eq '-All-') {
201             $product = '';
202         }
203         ThrowCodeError('chart_data_not_generated', {'product' => $product});
204     }
205
206     my @fields;
207     my @labels = qw(DATE);
208     my %datasets = map { $_ => 1 } split /:/, $datasets;
209
210     my %data = ();
211     while (<FILE>) {
212         chomp;
213         next unless $_;
214         if (/^#/) {
215             if (/^# fields?: (.*)\s*$/) {
216                 @fields = split /\||\r/, $1;
217                 unless ($fields[0] =~ /date/i) {
218                     ThrowCodeError('chart_datafile_corrupt', {'file' => $data_file});
219                 }
220                 push @labels, grep($datasets{$_}, @fields);
221             }
222             next;
223         }
224
225         unless (@fields) {
226             ThrowCodeError('chart_datafile_corrupt', {'file' => $data_file});
227         }
228
229         my @line = split /\|/;
230         my $date = $line[0];
231         my ($yy, $mm, $dd) = $date =~ /^\d{2}(\d{2})(\d{2})(\d{2})$/;
232         push @{$data{DATE}}, "$mm/$dd/$yy";
233         
234         for my $i (1 .. $#fields) {
235             my $field = $fields[$i];
236             if (! defined $line[$i] or $line[$i] eq '') {
237                 # no data point given, don't plot (this will probably
238                 # generate loads of Chart::Base warnings, but that's not
239                 # our fault.)
240                 push @{$data{$field}}, undef;
241             }
242             else {
243                 push @{$data{$field}}, $line[$i];
244             }
245         }
246     }
247     
248     shift @labels;
249
250     close FILE;
251
252     if (! @{$data{DATE}}) {
253         ThrowUserError('insufficient_data_points');
254     }
255
256     my $img = Chart::Lines->new (800, 600);
257     my $i = 0;
258
259     my $MAXTICKS = 20;      # Try not to show any more x ticks than this.
260     my $skip = 1;
261     if (@{$data{DATE}} > $MAXTICKS) {
262         $skip = int((@{$data{DATE}} + $MAXTICKS - 1) / $MAXTICKS);
263     }
264
265     my %settings =
266         (
267          "title" => "Status Counts for $product",
268          "x_label" => "Dates",
269          "y_label" => "Bug Counts",
270          "legend_labels" => \@labels,
271          "skip_x_ticks" => $skip,
272          "y_grid_lines" => "true",
273          "grey_background" => "false",
274          "colors" => {
275                       # default dataset colours are too alike
276                       dataset4 => [0, 0, 0], # black
277                      },
278         );
279     
280     $img->set (%settings);
281     $img->$type($image_file, [ @data{('DATE', @labels)} ]);
282 }