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