Removed executable flag from COPYING
[nautilus.git] / check-FIXME.pl
blob91fccf40437e9669b49f0dc2b3ff511ebbf91d2b
1 #!/usr/bin/perl -w
2 # -*- Mode: perl; indent-tabs-mode: nil -*-
5 # Nautilus
7 # Copyright (C) 2000 Eazel, Inc.
9 # This library is free software; you can redistribute it and/or
10 # modify it under the terms of the GNU General Public License as
11 # published by the Free Software Foundation; either version 2 of the
12 # License, or (at your option) any later version.
14 # This library is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 # General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with this library; if not, write to the Free Software
21 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23 # Author: Darin Adler <darin@bentspoon.com>,
26 # check-FIXME.pl: Search for FIXMEs in the sources and correlate them
27 # with bugs in the bug database.
29 use diagnostics;
30 use strict;
32 # default to all the files starting from the current directory
33 my %skip_files;
34 if (!@ARGV)
36 @ARGV = `find . \\( \\( -name po -prune -false \\) -or \\( -name CVS -prune -false \\) -or \\( -name macros -prune -false \\) -or \\( -name '*' -and -type f \\) \\) -and ! \\( -name '*~' -or -name '#*' -or -name 'ChangeLog*' -or -name Entries \\) -print`;
37 %skip_files =
39 "./HACKING" => 1,
40 "./TODO" => 1,
41 "./aclocal.m4" => 1,
42 "./check-FIXME.pl" => 1,
43 "./config.sub" => 1,
44 "./libtool" => 1,
45 "./ltconfig" => 1,
46 "./ltmain.sh" => 1,
50 #locate all of the open FIXMEs in the bug database
51 my $pwd=`pwd`;
52 chomp $pwd;
54 my $repository_file = $pwd."/CVS/Repository";
55 open FILE, " cat $repository_file | ";
57 my $product = <FILE>;
58 chomp $product;
60 close FILE;
62 print "Searching the bugzilla database's product $product for open FIXME bugs\n";
64 if (!grep /$product/, ( "nautilus", "gnome-vfs", "medusa", "oaf")) {
65 print "Can't find your product in the bugzilla.gnome.org database\n";
68 my $bugzilla_query_bug_url = "http://bugzilla.gnome.org/buglist.cgi?";
70 $product =~ s/\-/\+/g;
71 my @cgi_options = ("bug_status=NEW",
72 "bug_status=ASSIGNED",
73 "bug_status=REOPENED",
74 "long_desc=fixme",
75 "long_desc_type=substring",
76 "product=$product");
78 my $open_fixmes_url = $bugzilla_query_bug_url.join "&", @cgi_options;
80 `wget -q -O - "$open_fixmes_url"` =~ /<INPUT TYPE\=HIDDEN NAME\=buglist VALUE\=([0-9:]+)>/;
81 my $buglist_text = $1;
83 my %bugs_in_bugzilla;
84 foreach my $bug (split /:/, $buglist_text) {
85 $bugs_in_bugzilla{$bug} = "UNFOUND";
88 print "Locating all of the FIXME's listed in source\n";
89 # locate all of the target lines
90 my $no_bug_lines = "";
91 my %bug_lines;
92 foreach my $file (@ARGV)
94 chomp $file;
95 next if $skip_files{$file};
96 next unless -T $file;
97 open(FILE, $file) || die "can't open $file";
98 while (<FILE>)
100 next if !/FIXME/;
101 if (/FIXME\s*:?\s*bugzilla.gnome.org\s+(\d+)/)
103 $bug_lines{$1} .= "$file:$.:$_";
105 else
107 $no_bug_lines .= "$file:$.:$_";
110 close(FILE);
113 # list database bugs we can't find in nautilus
114 printf "%d FIXMES in the database still in $product\n", keys %bug_lines;
116 foreach my $bug_number (keys %bug_lines) {
117 $bugs_in_bugzilla{$bug_number} = "FOUND";
120 print "\n";
121 foreach my $bug_number (keys %bugs_in_bugzilla) {
122 if ($bugs_in_bugzilla{$bug_number} eq "UNFOUND") {
123 # Also check that the
124 my $bug_url = "http://bugzilla.gnome.org/show_bug.cgi?id=".$bug_number;
125 my $bug_page = `wget -q -O - $bug_url`;
126 if (!($bug_page =~ /This is not a FIXME bug/i)) {
127 $bug_page =~ /<A HREF=\"bug_status.html\#assigned_to\">Assigned To:<\/A><\/B><\/TD>\s+<TD>([^<]+)<\/TD>/s;
128 print "Bug $bug_number isn't in the source anymore. Contact owner $1.\n";
134 # list the ones without bug numbers
135 if ($no_bug_lines ne "")
137 my @no_bug_list = sort split /\n/, $no_bug_lines;
138 print "\n", scalar(@no_bug_list), " FIXMEs don't have bug numbers:\n\n";
139 foreach my $line (@no_bug_list)
141 print $line, "\n";
145 # list the ones with bugs that are not open
146 print "\n", scalar(keys %bug_lines), " FIXMEs with bug numbers.\n";
147 sub numerically { $a <=> $b; }
148 foreach my $bug (sort numerically keys %bug_lines)
150 # Check and see if the bug is open.
151 my $page = `wget -q -O - http://bugzilla.gnome.org/show_bug.cgi?id=$bug`;
152 $page =~ tr/\n/ /;
153 my $status = "unknown";
154 $status = $1 if $page =~ m|Status:.*</TD>\s*<TD>([A-Z]+)</TD>|;
155 next if $status eq "NEW" || $status eq "ASSIGNED" || $status eq "REOPENED";
157 # This a bug that is not open, so report it.
158 my @bug_line_list = sort split /\n/, $bug_lines{$bug};
159 print "\nBug $bug is $status:\n\n";
160 foreach my $line (@bug_line_list)
162 print $line, "\n";
165 print "\n";