+++ /dev/null
-#!/usr/bin/perl
-#
-# Lintian reporting harness -- Create and maintain Lintian reports automatically
-#
-# Copyright (C) 1998 Christian Schwarz and Richard Braakman
-#
-# This program is free software. It is distributed under the terms of
-# the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any
-# later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program. If not, you can find it on the World Wide
-# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
-# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
-# MA 02110-1301, USA.
-
-use strict;
-use Getopt::Std;
-
-use vars qw($opt_c $opt_f $opt_i $opt_r);
-unless (getopts('cfir')) {
- print <<END;
-Lintian reporting harness
-Create and maintain Lintian reports automatically
-
-Usage: harness [ -i | -c [-f] ] [ -r ]
-
-Options:
- -c clean mode, erase everything and start from scratch
- -f full mode, blithely overwrite lintian.log
- -i incremental mode, use old lintian.log data, process changes only
- -r generate HTML reports only
-
-Incremental mode is the default if you have a lintian.log;
-otherwise, it's full.
-
-Report bugs to <lintian-maint\@debian.org>.
-END
- exit;
-}
-
-die "Can't use both incremental and full/clean." if ($opt_i && ($opt_f || $opt_c));
-$opt_f = 1 if $opt_c;
-die "Can't use other modes with reports only." if ($opt_r && ($opt_i || $opt_f || $opt_c));
-
-# read configuration
-require './config';
-use vars qw($LINTIAN_ROOT $LINTIAN_LAB $LINTIAN_ARCHIVEDIR $LINTIAN_DIST
- $LINTIAN_SECTION $LINTIAN_ARCH $LINTIAN_UNPACK_LEVEL $LINTIAN_CFG
- $lintian_cmd $html_reports_cmd
- $log_file $lintian_log $old_lintian_log
- $changes_file $list_file $html_reports_log
- $LOG_DIR $statistics_file
- $HTML_DIR $HTML_TMP_DIR);
-
-# import perl libraries
-unshift @INC, "$LINTIAN_ROOT/lib";
-require Read_pkglists;
-use vars qw(%binary_info %source_info %udeb_info); # from the above
-require Util;
-
-# turn file buffering off
-$| = 1;
-
-# rotate log files
-system("savelog $log_file $changes_file $list_file $html_reports_log >/dev/null") == 0
- or Die("cannot rotate log files");
-
-# create new log file
-open(LOG, '>', $log_file)
- or Die("cannot open log file $log_file for writing: $!");
-
-# export Lintian's configuration
-$ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT;
-$ENV{'LINTIAN_CFG'} = $LINTIAN_CFG;
-$ENV{'LINTIAN_LAB'} = $LINTIAN_LAB;
-$ENV{'LINTIAN_ARCHIVEDIR'} = $LINTIAN_ARCHIVEDIR;
-$ENV{'LINTIAN_DIST'} = $LINTIAN_DIST;
-$ENV{'LINTIAN_UNPACK_LEVEL'} = $LINTIAN_UNPACK_LEVEL;
-$ENV{'LINTIAN_SECTION'} = $LINTIAN_SECTION;
-$ENV{'LINTIAN_ARCH'} = $LINTIAN_ARCH;
-
-if ($opt_c) { # purge the old packages
- system("rm -rf $LINTIAN_LAB/binary") == 0 || die "$!";
- system("mkdir -m 2775 $LINTIAN_LAB/binary") == 0 || die "$!";
- system("rm -rf $LINTIAN_LAB/udeb") == 0 || die "$!";
- system("mkdir -m 2775 $LINTIAN_LAB/udeb") == 0 || die "$!";
- system("rm -rf $LINTIAN_LAB/source") == 0 || die "$!";
- system("mkdir -m 2775 $LINTIAN_LAB/source") == 0 || die "$!";
- system("rm -f $LINTIAN_LAB/info/*") == 0 || die "$!";
-}
-
-unless ($opt_r) {
- # make lintian update its packages files and save output
- run("$lintian_cmd -v --setup-lab >$changes_file")
- or Die("cannot run lintian --setup-lab");
- Log("");
-}
-
-unless ($opt_f || $opt_c) {
- unless ($opt_r) {
- if (-f $lintian_log) {
- $opt_i = 1;
- } else {
- $opt_f = 1;
- }
- }
-}
-
-if ($opt_f) { # check all packages
- Log("Running Lintian over all packages...");
- my $cmd = "$lintian_cmd -I -E -v -a --show-overrides -U changelog-file >$lintian_log";
- Log("Executing $cmd");
- my $res = (system($cmd) >> 8);
- (($res == 0) or ($res == 1))
- or Log("warning: executing lintian returned $res");
- Log("");
-}
-
-if ($opt_i) { # process changes only
-
- die "Old Lintian log file $lintian_log not found!\n" unless -f $lintian_log;
-
- my $pkgfile;
- my %skip_binary;
- my %skip_udeb;
- my %skip_source;
-
- # read binary packages files
- $pkgfile = "$LINTIAN_LAB/info/binary-packages";
- (-f $pkgfile) or Die("cannot find list of binary packages $pkgfile");
- read_bin_list($pkgfile);
-
- # read udeb packages files
- $pkgfile = "$LINTIAN_LAB/info/udeb-packages";
- (-f $pkgfile) or Die("cannot find list of udeb packages $pkgfile");
- read_udeb_list($pkgfile);
-
- # read source packages files
- $pkgfile = "$LINTIAN_LAB/info/source-packages";
- (-f $pkgfile) or Die("cannot find list of source packages $pkgfile");
- read_src_list($pkgfile);
-
- # process changes file and create list of packages to process
- Log("Reading changes file...");
- open(IN, '<', $changes_file)
- or Die("cannot open changes file $changes_file for reading: $!");
- open(OUT, '>', $list_file)
- or Die("cannot open list file $list_file for writing: $!");
- while (<IN>) {
- chop;
-
- if (/^N: Listed (changed|new) (binary|udeb|source) package (\S+) (\S+)/o) {
- my ($type,$binsrc,$pkg,$ver) = ($1,$2,$3,$4);
-
- Log("$type $binsrc package $pkg $ver");
-
- if ($binsrc eq 'binary') {
- my $data = $binary_info{$pkg};
- $data or Die("cannot find binary package $pkg in binary-packages file");
- print OUT "b $binary_info{$pkg}->{'package'} $binary_info{$pkg}->{'version'} $LINTIAN_ARCHIVEDIR/$binary_info{$pkg}->{'file'}\n";
- $skip_binary{$pkg} = 1;
- } elsif ($binsrc eq 'udeb') {
- my $data = $udeb_info{$pkg};
- $data or Die("cannot find udeb package $pkg in udeb-packages file");
- print OUT "u $udeb_info{$pkg}->{'package'} $udeb_info{$pkg}->{'version'} $LINTIAN_ARCHIVEDIR/$udeb_info{$pkg}->{'file'}\n";
- $skip_udeb{$pkg} = 1;
- } else {
- my $data = $source_info{$pkg};
- $data or Die("cannot find source package $pkg in source-packages file");
- print OUT "s $source_info{$pkg}->{'source'} $source_info{$pkg}->{'version'} $LINTIAN_ARCHIVEDIR/$source_info{$pkg}->{'file'}\n";
- $skip_source{$pkg} = 1;
- }
- } elsif (/^N: Removed (binary|udeb|source) package (\S+)/o) {
- my ($binsrc,$pkg) = ($1,$2);
-
- Log("removed $binsrc package $pkg");
- run("rm -r -- \"$LINTIAN_LAB/$binsrc/$pkg\"")
- or Log("could not remove $binsrc package $pkg");
- if ($binsrc eq 'binary') {
- $skip_binary{$pkg} = 1;
- } elsif ($binsrc eq 'udeb') {
- $skip_udeb{$pkg} = 1;
- } else {
- $skip_source{$pkg} = 1;
- }
- } elsif (/^N/o) {
- # ignore other notes
- } else {
- Log("skipping changes line: $_");
- }
- }
- close(OUT);
- close(IN);
- Log("");
-
- # update lintian.log
- Log("Updating lintian.log...");
- rename $lintian_log, $old_lintian_log;
- open(IN, '<', $old_lintian_log)
- or Die("cannot open old lintian.log $old_lintian_log for reading: $!");
- open(OUT, '>', $lintian_log)
- or Die("cannot open lintian.log $lintian_log for writing: $!");
- my $copy_mode = 1;
- while (<IN>) {
- if (/^N: Processing (binary|udeb|source) package (\S+)/o) {
- my ($type,$pkg) = ($1,$2);
-
- if ($type eq 'binary') {
- $copy_mode = not exists $skip_binary{$pkg};
- } elsif ($type eq 'udeb') {
- $copy_mode = not exists $skip_udeb{$pkg};
- } else {
- $copy_mode = not exists $skip_source{$pkg};
- }
- }
-
- if ($copy_mode) {
- print OUT $_;
- }
- }
- print OUT "N: ---end-of-old-lintian-log-file---\n";
- close(OUT);
- close(IN);
- Log("");
-
- # run Lintian over the newly introduced or changed packages
- Log("Running Lintian over newly introduced and changed packages...");
- my $cmd = "$lintian_cmd -I -E -v --show-overrides -p $list_file -U changelog-file >>$lintian_log";
- Log("Executing $cmd");
- my $res = (system($cmd) >> 8);
- (($res == 0) or ($res == 1))
- or Log("warning: executing lintian returned $res");
- Log("");
-}
-
-# create html reports
-Log("Creating HTML reports...");
-run("$html_reports_cmd $lintian_log >$html_reports_log 2>&1")
- or Log("warning: executing $html_reports_cmd returned $?");
-Log("");
-
-# rotate the statistics file updated by $html_reports_cmd
-if (-f $statistics_file) {
- system("cp $statistics_file $LOG_DIR/stats/statistics-`date +%Y%m%d`") == 0
- or Log("warning: couldn't rotate the statistics file");
-}
-
-#Log("Creating depcheck pages...");
-#run("$LINTIAN_ROOT/depcheck/deppages.pl >>$html_reports_log")
-# or Log("warning: executing deppages.pl returned $?");
-#Log("");
-
-# install new html directory
-Log("Installing HTML reports...");
-system("rm -rf $HTML_DIR") == 0
- or Die("error removing $HTML_DIR");
-# a tiny bit of race right here
-rename($HTML_TMP_DIR,$HTML_DIR)
- or Die("error renaming $HTML_TMP_DIR into $HTML_DIR");
-Log("");
-
-# ready!!! :-)
-Log("All done.");
-exit 0;
-
-# -------------------------------
-
-sub Log {
- print LOG $_[0],"\n";
-}
-
-sub run {
- Log("Executing $_[0]");
- return (system($_[0]) == 0);
-}
-
-sub Die {
- Log("fatal error: $_[0]");
- exit 1;
-}
projects / maemian / blobdiff