2002-01-20 01:44:52 +00:00
|
|
|
#!/usr/bonsaitools/bin/perl -wT
|
2000-10-23 21:44:30 +00:00
|
|
|
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
|
|
|
#
|
|
|
|
# The contents of this file are subject to the Mozilla Public
|
|
|
|
# License Version 1.1 (the "License"); you may not use this file
|
|
|
|
# except in compliance with the License. You may obtain a copy of
|
|
|
|
# the License at http://www.mozilla.org/MPL/
|
|
|
|
#
|
|
|
|
# Software distributed under the License is distributed on an "AS
|
|
|
|
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
|
|
|
# implied. See the License for the specific language governing
|
|
|
|
# rights and limitations under the License.
|
|
|
|
#
|
|
|
|
# The Original Code is the Bugzilla Bug Tracking System.
|
|
|
|
#
|
|
|
|
# The Initial Developer of the Original Code is Netscape Communications
|
|
|
|
# Corporation. Portions created by Netscape are
|
|
|
|
# Copyright (C) 1998 Netscape Communications Corporation. All
|
|
|
|
# Rights Reserved.
|
|
|
|
#
|
|
|
|
# Contributor(s): Gervase Markham <gerv@gerv.net>
|
|
|
|
#
|
|
|
|
# Generates mostfreq list from data collected by collectstats.pl.
|
|
|
|
|
2001-04-19 17:35:23 +00:00
|
|
|
|
2000-10-23 21:44:30 +00:00
|
|
|
use diagnostics;
|
|
|
|
use strict;
|
2002-04-10 22:30:00 +00:00
|
|
|
|
2001-04-06 18:19:47 +00:00
|
|
|
use AnyDBM_File;
|
2002-01-20 01:44:52 +00:00
|
|
|
|
|
|
|
use lib qw(.);
|
|
|
|
|
2000-10-23 21:44:30 +00:00
|
|
|
require "globals.pl";
|
|
|
|
require "CGI.pl";
|
|
|
|
|
2002-04-10 22:30:00 +00:00
|
|
|
# Use global templatisation variables.
|
|
|
|
use vars qw($template $vars);
|
|
|
|
|
2001-04-06 18:19:47 +00:00
|
|
|
ConnectToDatabase(1);
|
2000-10-23 21:44:30 +00:00
|
|
|
GetVersionTable();
|
|
|
|
|
2001-10-23 15:44:53 +00:00
|
|
|
quietly_check_login();
|
|
|
|
|
2002-04-10 22:30:00 +00:00
|
|
|
use vars qw (%FORM $userid $usergroupset @legal_product);
|
2001-10-23 15:44:53 +00:00
|
|
|
|
2001-04-06 18:19:47 +00:00
|
|
|
my %dbmcount;
|
2000-10-23 21:44:30 +00:00
|
|
|
my %count;
|
|
|
|
my %before;
|
|
|
|
|
2001-04-06 18:19:47 +00:00
|
|
|
# Get params from URL
|
2002-04-10 22:30:00 +00:00
|
|
|
sub formvalue {
|
|
|
|
my ($name, $default) = (@_);
|
|
|
|
return $FORM{$name} || $default || "";
|
2000-10-23 21:44:30 +00:00
|
|
|
}
|
2001-04-06 18:19:47 +00:00
|
|
|
|
2002-04-10 22:30:00 +00:00
|
|
|
my $sortby = formvalue("sortby");
|
|
|
|
my $changedsince = formvalue("changedsince", 7);
|
|
|
|
my $maxrows = formvalue("maxrows", 100);
|
|
|
|
my $openonly = formvalue("openonly");
|
|
|
|
my $reverse = formvalue("reverse");
|
|
|
|
my $product = formvalue("product");
|
|
|
|
my $sortvisible = formvalue("sortvisible");
|
|
|
|
my @buglist = (split(/[:,]/, formvalue("bug_id")));
|
2000-10-23 21:44:30 +00:00
|
|
|
|
2002-04-10 22:30:00 +00:00
|
|
|
# Small backwards-compatibility hack, dated 2002-04-10.
|
|
|
|
$sortby = "count" if $sortby eq "dup_count";
|
2000-10-23 21:44:30 +00:00
|
|
|
|
2001-04-06 18:19:47 +00:00
|
|
|
# Open today's record of dupes
|
2002-04-10 22:30:00 +00:00
|
|
|
my $today = days_ago(0);
|
|
|
|
my $yesterday = days_ago(1);
|
2001-04-06 18:19:47 +00:00
|
|
|
|
2002-04-16 08:25:52 +00:00
|
|
|
# We don't know the exact file name, because the extention depends on the
|
|
|
|
# underlying dbm library, which could be anything. We can't glob, because
|
|
|
|
# perl < 5.6 considers if (<*>) { ... } to be tainted
|
|
|
|
# Instead, just check the return value for today's data and yesterday's,
|
|
|
|
# and ignore file not found errors
|
|
|
|
|
|
|
|
use Errno;
|
|
|
|
use Fcntl;
|
|
|
|
|
|
|
|
if (!tie(%dbmcount, 'AnyDBM_File', "data/duplicates/dupes$today",
|
|
|
|
O_RDONLY, 0644)) {
|
|
|
|
if ($!{ENOENT}) {
|
|
|
|
if (!tie(%dbmcount, 'AnyDBM_File', "data/duplicates/dupes$yesterday",
|
|
|
|
O_RDONLY, 0644)) {
|
|
|
|
if ($!{ENOENT}) {
|
|
|
|
ThrowUserError("There are no duplicate statistics for today " .
|
|
|
|
"($today) or yesterday.",
|
|
|
|
"Cannot find duplicate statistics");
|
|
|
|
} else {
|
|
|
|
ThrowUserError("There are no duplicate statistics for today " .
|
|
|
|
"($today), and an error occurred when " .
|
|
|
|
"accessing yesterday's dupes file: $!.",
|
|
|
|
"Error reading yesterday's dupes file");
|
|
|
|
}
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
ThrowUserError("An error occurred when accessing today ($today)'s " .
|
|
|
|
"dupes file: $!.",
|
|
|
|
"Error reading today's dupes file");
|
|
|
|
}
|
2001-04-06 18:19:47 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
# Copy hash (so we don't mess up the on-disk file when we remove entries)
|
|
|
|
%count = %dbmcount;
|
2002-04-10 22:30:00 +00:00
|
|
|
|
|
|
|
# Remove all those dupes under the threshold parameter.
|
|
|
|
# We do this, before the sorting, for performance reasons.
|
2001-04-06 18:19:47 +00:00
|
|
|
my $threshold = Param("mostfreqthreshold");
|
2000-10-23 21:44:30 +00:00
|
|
|
|
2002-04-10 22:30:00 +00:00
|
|
|
while (my ($key, $value) = each %count) {
|
|
|
|
delete $count{$key} if ($value < $threshold);
|
2000-10-23 21:44:30 +00:00
|
|
|
}
|
|
|
|
|
2001-04-06 18:19:47 +00:00
|
|
|
# Try and open the database from "changedsince" days ago
|
2002-04-10 22:30:00 +00:00
|
|
|
my $dobefore = 0;
|
2001-04-06 18:19:47 +00:00
|
|
|
my %delta;
|
2002-04-10 22:30:00 +00:00
|
|
|
my $whenever = days_ago($changedsince);
|
|
|
|
|
2002-04-16 08:25:52 +00:00
|
|
|
if (!tie(%before, 'AnyDBM_File', "data/duplicates/dupes$whenever",
|
|
|
|
O_RDONLY, 0644)) {
|
|
|
|
# Ignore file not found errors
|
|
|
|
if (!$!{ENOENT}) {
|
|
|
|
ThrowUserError("Can't open $changedsince days ago ($whenever)'s " .
|
|
|
|
"dupes file: $!",
|
|
|
|
"Error reading previous dupes file");
|
|
|
|
}
|
|
|
|
} else {
|
2002-04-10 22:30:00 +00:00
|
|
|
# Calculate the deltas
|
|
|
|
($delta{$_} = $count{$_} - $before{$_}) foreach (keys(%count));
|
|
|
|
|
|
|
|
$dobefore = 1;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Don't add CLOSED, and don't add VERIFIED unless they are INVALID or
|
|
|
|
# WONTFIX. We want to see VERIFIED INVALID and WONTFIX because common
|
|
|
|
# "bugs" which aren't bugs end up in this state.
|
|
|
|
my $generic_query = "
|
|
|
|
SELECT component, bug_severity, op_sys, target_milestone,
|
|
|
|
short_desc, bug_status, resolution
|
|
|
|
FROM bugs
|
|
|
|
WHERE (bug_status != 'CLOSED')
|
|
|
|
AND ((bug_status = 'VERIFIED' AND resolution IN ('INVALID', 'WONTFIX'))
|
|
|
|
OR (bug_status != 'VERIFIED'))
|
|
|
|
AND ";
|
|
|
|
|
|
|
|
# Limit to a single product if requested
|
|
|
|
$generic_query .= (" product = " . SqlQuote($product) . " AND ") if $product;
|
|
|
|
|
|
|
|
my @bugs;
|
|
|
|
my @bug_ids;
|
|
|
|
my $loop = 0;
|
|
|
|
|
|
|
|
foreach my $id (keys(%count)) {
|
|
|
|
# Maximum row count is dealt with in the template.
|
|
|
|
# If there's a buglist, restrict the bugs to that list.
|
|
|
|
next if $sortvisible && $buglist[0] && (lsearch(\@buglist, $id) == -1);
|
|
|
|
|
|
|
|
SendSQL(SelectVisible("$generic_query bugs.bug_id = $id",
|
|
|
|
$userid,
|
|
|
|
$usergroupset));
|
|
|
|
|
|
|
|
next unless MoreSQLData();
|
|
|
|
my ($component, $bug_severity, $op_sys, $target_milestone,
|
|
|
|
$short_desc, $bug_status, $resolution) = FetchSQLData();
|
|
|
|
|
|
|
|
# Limit to open bugs only if requested
|
|
|
|
next if $openonly && ($resolution ne "");
|
|
|
|
|
|
|
|
push (@bugs, { id => $id,
|
|
|
|
count => $count{$id},
|
|
|
|
delta => $delta{$id},
|
|
|
|
component => $component,
|
|
|
|
bug_severity => $bug_severity,
|
|
|
|
op_sys => $op_sys,
|
|
|
|
target_milestone => $target_milestone,
|
|
|
|
short_desc => $short_desc,
|
|
|
|
bug_status => $bug_status,
|
|
|
|
resolution => $resolution });
|
|
|
|
push (@bug_ids, $id);
|
|
|
|
$loop++;
|
|
|
|
}
|
|
|
|
|
|
|
|
$vars->{'bugs'} = \@bugs;
|
|
|
|
$vars->{'bug_ids'} = \@bug_ids;
|
|
|
|
|
|
|
|
$vars->{'dobefore'} = $dobefore;
|
|
|
|
$vars->{'sortby'} = $sortby;
|
|
|
|
$vars->{'sortvisible'} = $sortvisible;
|
|
|
|
$vars->{'changedsince'} = $changedsince;
|
|
|
|
$vars->{'maxrows'} = $maxrows;
|
|
|
|
$vars->{'openonly'} = $openonly;
|
|
|
|
$vars->{'reverse'} = $reverse;
|
|
|
|
$vars->{'product'} = $product;
|
|
|
|
$vars->{'products'} = \@::legal_product;
|
|
|
|
|
|
|
|
print "Content-type: text/html\n\n";
|
|
|
|
|
|
|
|
# Generate and return the UI (HTML page) from the appropriate template.
|
|
|
|
$template->process("report/duplicates.html.tmpl", $vars)
|
|
|
|
|| DisplayError("Template process failed: " . $template->error())
|
|
|
|
&& exit;
|
|
|
|
|
|
|
|
|
|
|
|
sub days_ago {
|
|
|
|
my ($dom, $mon, $year) = (localtime(time - ($_[0]*24*60*60)))[3, 4, 5];
|
|
|
|
return sprintf "%04d-%02d-%02d", 1900 + $year, ++$mon, $dom;
|
2001-04-06 18:19:47 +00:00
|
|
|
}
|