vcs.maemo.org Git - maemian/blob - nokia-lintian/depcheck/deppages.pl

   1 #!/usr/bin/perl
   2
   3 # Create HTML pages describing the results of dependency-integrity checks
   4 # over the Debian archive.
   5 #
   6 # Copyright (C) 1998 Richard Braakman
   7 #
   8 # This program is free software.  It is distributed under the terms of
   9 # the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any
  11 # later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program.  If not, you can find it on the World Wide
  20 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  21 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  22 # MA 02110-1301, USA.
  23
  24 require './config';
  25
  26 # comes from './config'
  27 use vars qw( $LOG_DIR );
  28
  29 # lintian binary will define these
  30 use vars qw($LINTIAN_DIST $HTML_TMP_DIR $LINTIAN_ARCHIVEDIR $LINTIAN_ROOT);
  31
  32 my @archs = ('i386', 'alpha', 'm68k', 'powerpc', 'sparc', 'arm', 'hurd-i386');
  33
  34 my @logfiles = map { "$LOG_DIR/Depcheck-" . $_ } @archs;
  35 system("savelog @logfiles >/dev/null") == 0
  36     or die("cannot rotate logfiles");
  37
  38 # this stuff is most likely broken
  39 my $BINARY = "$LINTIAN_ARCHIVEDIR/dists/$LINTIAN_DIST/main";
  40
  41 my $libdir   = defined $LINTIAN_ROOT ? "$LINTIAN_ROOT/" : "";
  42 my $DEPCHECKDIR = "${libdir}depcheck";
  43 my $DEPCHECK    = "$DEPCHECKDIR/dependencies.py";
  44
  45 $ENV{'PYTHONPATH'} = $DEPCHECKDIR;
  46
  47 system("$DEPCHECK $BINARY/binary-i386/Packages >$LOG_DIR/Depcheck-i386") == 0
  48     or die("depcheck failed for i386 architecture");
  49
  50 for my $arch (@archs) {
  51     next if $arch eq 'i386';
  52
  53     system("$DEPCHECK $BINARY/binary-$arch/Packages $LOG_DIR/Depcheck-i386 >$LOG_DIR/Depcheck-$arch") == 0
  54         or die("depcheck failed for $arch architecture");
  55 }
  56
  57 my %bug_used = ();
  58 my %bugs = ();
  59
  60 open(BUGS, '<', "$LINTIAN_ROOT/depcheck/buglist") or die("buglist");
  61 while (<BUGS>) {
  62     chop;
  63     my $bugline = $_;
  64     my @b;
  65     while ($bugline =~ s/^(\d+)\s//) {
  66         push(@b, &make_bugref($1));
  67     }
  68     $bugs{$bugline} = join(", ", @b);
  69 }
  70 close(BUGS);
  71
  72 open(HTML, '>', "$HTML_TMP_DIR/depcheck.html") or die("depcheck.html");
  73
  74 print HTML <<EOT;
  75 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 2.0//EN">
  76 <HTML>
  77 <HEAD>
  78   <TITLE>Debian: Dependency integrity check for the main distribution</TITLE>
  79 </HEAD>
  80 <BODY>
  81 <H1>Dependency checks</H1>
  82 This page summarizes the results of a scan that checks the following
  83 two bits of Debian policy:<P>
  84 <UL>
  85 <LI>From section 2.1.2: The main section<P>
  86     <blockquote>
  87     The packages in "main" must not require a package outside of
  88     "main" for compilation or execution (thus, the package may not
  89     declare a "Depends" or "Recommends" relationship on a non-main package).
  90     </blockquote><P>
  91 <LI>From section 2.2: Priorities<P>
  92     <blockquote>
  93     Packages may not depend on packages with lower priority values.
  94     If this should happen, one of the priority values will have to be
  95     adapted.
  96     </blockquote><P>
  97 </UL>
  98
  99 The scan also looks for packages in the "base" section that depend on
 100 packages not in the "base" section, and for packages that depend on
 101 packages in "oldlibs" that are not themselves in "oldlibs".<P>
 102
 103 The scan checks the Recommends, Depends, and Pre-Depends headers in
 104 all cases.<P>
 105 EOT
 106
 107 for my $arch (@archs) {
 108     genarch($arch);
 109 }
 110
 111 close(HTML);
 112
 113 for my $bug (keys %bugs) {
 114     unless ($bug_used{$bug}) {
 115         print STDERR "Unused bugnumber: $bug\n";
 116     }
 117 }
 118
 119 exit 0;
 120
 121 sub genarch {
 122     my $arch = shift;
 123
 124     print HTML "<HR>\n";
 125     print HTML "<A NAME=$arch>\n";
 126     print HTML "<H2>Dependency check for the $arch architecture</H2>\n\n";
 127
 128     print HTML "<P>This list was generated from the $arch Packages file,<BR>\n"
 129         . "dated: " . &filetime("$BINARY/binary-$arch/Packages") . ".\n";
 130
 131     if ($arch ne 'i386') {
 132         print HTML "<P>It excludes the checks which were already " .
 133             "reported for the i386 architecture.\n";
 134     }
 135
 136     print HTML "\n";
 137
 138     open(REPORT, '<', "$LOG_DIR/Depcheck-$arch") or die("Depcheck-$arch");
 139     &genreport;
 140     close(REPORT);
 141 }
 142
 143 sub genreport {
 144     my $inlist = 0;
 145     my $brokendep;
 146     my $bug;
 147
 148     while (<REPORT>) {
 149         chop;
 150         if (s/^\s+//) {
 151             $brokendep = $_;
 152             $bug = $bugs{$brokendep};
 153             if (defined $bug) {
 154                 $bug_used{$brokendep} = 1;
 155                 $brokendep = quotehtml($brokendep) . '  [' . $bug . ']';
 156             } else {
 157                 $brokendep = quotehtml($brokendep);
 158             }
 159             print(HTML "  <LI>$brokendep\n");
 160         } elsif (m/^$/) {
 161             next;
 162         } else {
 163             if ($inlist) {
 164                 print(HTML "</UL>\n\n");
 165             }
 166             $_ = &quotehtml($_);
 167             print(HTML "<H3>$_</H3>\n");
 168             print(HTML "<UL>\n");
 169             $inlist = 1;
 170         }
 171     }
 172
 173     if ($inlist) {
 174         print(HTML "</UL>\n");
 175     }
 176 }
 177
 178 sub make_bugref {
 179     my $bugnum = shift;
 180     my $bugdir = substr($bugnum, 0, 2);
 181
 182     return "<A HREF=\"http://www.debian.org/Bugs/db/$bugdir/$bugnum.html\">"
 183         . "\#$bugnum</A>";
 184 }
 185
 186 sub quotehtml {
 187     $_ = $_[0] . '';
 188     s/&/\&amp;/g;
 189     s/</\&lt;/g;
 190     s/>/\&gt;/g;
 191     return $_;
 192 }
 193
 194 sub filetime {
 195     my $time = (stat(shift))[9]; # mtime
 196     return scalar(gmtime($time));
 197 }