[SCM] Debian package checker branch, lab-refactor, updated. 2.5.3-166-g23ab336
The following commit has been merged in the lab-refactor branch:
commit 23ab336d3cb0cd5ffdd03218d80c1304b18aeb9a
Author: Niels Thykier <niels@thykier.net>
Date: Thu Oct 27 18:54:42 2011 +0200
Clean up: Removed unused files
frontend/lintian-harness is far from ready, PackageList{,Diff} has
been replaced by Manifest{,Diff} and the unpack/* are no longer used.
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/frontend/lintian-harness b/frontend/lintian-harness
deleted file mode 100755
index fe27b7f..0000000
--- a/frontend/lintian-harness
+++ /dev/null
@@ -1,255 +0,0 @@
-#!/usr/bin/perl
-# {{{ Legal stuff
-# Lintian-harness -- frontend for updating a Lintian website
-#
-# Copyright (C) 2011 Niels Thykier
-# Based on the work of Christian Schwarz and Richard Braakman, which
-# is 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 warnings;
-
-use Cwd();
-
-use Getopt::Long;
-
-# List of variables we accept/import for lintian; these may be
-# overriden by cmd-line options below.
-my @ENV_VARS = (qw(
- LINTIAN_ROOT
- LINTIAN_CFG
- LINTIAN_LAB
-));
-
-# List of variables that we export for lintian.
-# Among things, it saves us from passing a lot of command-line
-# options.
-my @EXPORT_VARS = @ENV_VARS;
-
-# Values of options from env/cmd-line
-# - pre-seed options, where we do not need to know
-# if the user explicitly set them via cmd-line or ENV
-my %opt = (
- 'LINTIAN_ROOT' => '/usr/share/lintian'
-);
-# Options accepted via command line.
-# - for the subs, search/look for "Argument Parser Subs" below
-my %opthash = (
- 'help|h' => \&usage,
- 'root=s' => \$opt{'LINTIAN_ROOT'},
- 'cfg' => \$opt{'LINTIAN_CFG'},
- 'lab' => \$opt{'LINTIAN_LAB'},
-);
-# Options accepted in the config file
-my %cfghash = (
-);
-
-my $conf;
-
-# Fill in the default values for environment variables.
-# - GetOptions(%opthash) will override them
-foreach my $var (@ENV_VARS) {
- $opt{$var} = $ENV{$var} if exists $ENV{$var};
-}
-
-# init commandline parser
-Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev');
-
-# process commandline options
-GetOptions(%opthash)
- or die("error parsing options\n");
-
-# At this point LINTIAN_ROOT and LINTIAN_CFG are known, so the config
-# file can be parsed.
-
-# If LINTIAN_ROOT is "", then we got it from the env or --root, so
-# translate it into cwd
-
-unless ($opt{'LINTIAN_ROOT'}) {
- $opt{'LINTIAN_ROOT'} = Cwd::cwd();
-}
-
-unshift @INC, "$opt{'LINTIAN_ROOT'}/lib";
-require Lintian::Lab;
-require Lintian::Config;
-require Lintian::Internal::PackageList;
-require Util;
-import Util qw(fail);
-
-$conf = Lintian::Config->new(\%cfghash);
-
-my $lab = Lintian::Lab->new($opt{'LINTIAN_LAB'});
-
-my ($nblist,$nulist, $nslist) = read_archive($opt{'LINTIAN_ARCHIVEDIR'}, trim($opt{'LINTIAN_DIST'}),
- trim($opt{'LINTIAN_AREA'}), trim($opt{'LINTIAN_ARCH'}));
-
-my ($bdiff, $udiff, $sdiff) = $lab->generate_diffs($nblist, $nulist, $nslist);
-
-exit 0;
-
-#### Argument Parser Subs ####
-
-sub usage {
- print <<EOF ;
-Syntax: lintian-harness ...
-Actions:
- TODO ...
-EOF
- exit 0;
-}
-
-#### Helper Subs ####
-
-# read_archive($arc_root, $dist, $area, $arch)
-#
-# $arc_root => the root of the archive dir
-# $dist => the dist
-# $area_str => comma separated list of areas.
-# $arch => the architecture
-#
-sub read_archive {
- my ($archive_root, $dist, $area_str, $arch) = @_;
- my @areas = split m/\s*,\s++/o, $area_str;
- my @pkgs = ();
- # Handle binary packages
- foreach my $type (qw(binary udeb)) {
- my $nlist = Lintian::Internal::PackageList->new($type);
- foreach my $area (@areas) {
- my $file;
- if ($type eq 'binary') {
- $file = "$archive_root/dists/$dist/$area/binary-$arch/Packages";
- } elsif ($type eq 'udeb') {
- $file = "$archive_root/dists/$dist/$area/debian-installer/binary-$arch/Packages";
- } elsif ($type eq 'source') {
- $file = "$archive_root/dists/$dist/$area/source/Sources";
- } else {
- fail("Assertion Error: unhandled type ($type).\n");
- }
-
- my $pkg_data = {
- dist => $dist,
- area => $area,
- arch => $arch,
- type => $type,
- };
- parse_packages_file($archive_root, $file, $pkg_data, $nlist);
- }
- }
-
-}
-
-sub run {
-
-}
-
-sub trim {
- my ($a) = @_;
- $a =~ s/^\s++//o;
- $a =~ s/\s++$//o;
- return $a;
-}
-
-sub open_data_file {
- my ($file) = @_;
- if (-e $file) {
- open my $fd, '<', $file or fail("opening $file: $!");
- return $fd;
- }
- foreach my $com (['gz', ['gzip', '-dc']] ){
- my ($ext, $cmd) = @$com;
- if ( -e "$file.$ext") {
- open my $c, '-|', @$cmd, "$file.$ext" or fail("running @$cmd $file.$ext");
- return $c;
- }
- }
- fail("Cannot find $file.\n");
-}
-
-sub parse_packages_file {
- my ($archive_root, $file, $pkg_data, $nlist) = @_;
- my $fd = open_data_file($file);
- my $helper = sub {
- my ($paragraph) = @_;
- _pkg_parser($paragraph, $archive_root, $pkg_data, $nlist);
- };
- Util::_parse_dpkg_control_iterative($helper, $fd, 0);
- close $fd;
-}
-
-sub _pkg_parser {
- my ($paragraph, $archive_root, $pkg_data, $nlist) = @_;
- my $file = "$archive_root/$paragraph->{'filename'}";
- my $type = $pkg_data->{'type'};
- my @stat;
- my $data;
- my $pkg;
- unless (@stat = stat $file) {
- print "E: general: cannot stat $file\n";
- return;
- }
- if ($type ne 'source') {
- $data = safe_get_deb_info($file, $type);
- } else {
- eval { $data = get_dsc_info($file); };
- if ($@) {
- # error!
- print STDERR "$@\n";
- print "E: general: bad-source-package $file\n";
- next;
- }
- }
- return unless $data;
-
- if ($type ne 'source') {
- unless (exists $data->{'source-version'}) {
- if ($data->{'source'} =~ /^([-+\.\w]+)\s+\((.+)\)$/) {
- $data->{'source'} = $1;
- $data->{'source-version'} = $2;
- } else {
- $data->{'source-version'} = $data->{'version'};
- }
- }
- }
- $pkg = $paragraph->{'package'};
- # Save entry for writing to output file.
- $data->{file} = $file;
- $data->{timestamp} = $stat[9];
- $data->{area} = $pkg_data->{area};
- $nlist->set($pkg, $data);
-}
-
-
-sub safe_get_deb_info {
- # use eval when calling get_deb_info, since we don't want to `die' just
- # because of a single broken package
- my ($file, $type) = @_;
- my $data;
- eval { $data = get_deb_info($file); };
- if ($@) {
- # error!
- print STDERR "$@\n";
- print "E: general: bad-$type-package $file\n";
- return;
- }
- $data->{'source'} or ($data->{'source'} = $data->{'package'});
- return $data;
-}
-
diff --git a/lib/Lintian/Internal/PackageList.pm b/lib/Lintian/Internal/PackageList.pm
deleted file mode 100644
index a7279cd..0000000
--- a/lib/Lintian/Internal/PackageList.pm
+++ /dev/null
@@ -1,372 +0,0 @@
-# Lintian::Internal::PackageList -- Handler for Lintian's Packages List for the Lab
-
-# Copyright (C) 2011 Niels Thykier
-#
-# This program is free software; you can redistribute it and/or modify
-# it 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.
-
-package Lintian::Internal::PackageList;
-
-use strict;
-use warnings;
-
-use base qw(Class::Accessor);
-
-use Carp qw(croak);
-use Lintian::Internal::PackageListDiff;
-
-=head1 NAME
-
-Lintian::Inernal::PackageList -- Handler for Lintian's Lab Package List files
-
-=head1 SYNOPSIS
-
- use Lintian::Internal::PackageList;
-
- my $plist = Lintian::Internal::PackageList->new('binary');
- # Read the file
- $plist->read_list('info/binary-packages');
- # fetch the entry for lintian (if any)
- my $entry = $plist->get('lintian');
- if ( $entry && exits $entry->{'version'} ) {
- print "Lintian has version $entry->{'version'}\n";
- }
- # delete lintian
- $plist->delete('lintian');
- # Write to file if changed
- if ($plist->dirty) {
- $plist->write_list('info/binary-packages');
- }
-
-=head1 DESCRIPTION
-
-Instances of this class provides access to the packages list used by
-the Lab as caches.
-
-=head1 METHODS
-
-=over 4
-
-=cut
-
-# these banner lines have to be changed with every incompatible change of the
-# binary and source list file formats
-## NB: If bumping the BINLIST_FORMAT, remember to kill the UDEB fall back
-## see read_bin_list
-use constant BINLIST_FORMAT => "Lintian's list of binary packages in the archive--V4";
-use constant SRCLIST_FORMAT => "Lintian's list of source packages in the archive--V4";
-use constant CHGLIST_FORMAT => "Lintian's list of changes packages in the archive--V1";
-
-# Previously udeb-files had a different format; allow parsing a udeb file as
-# a binary file V4, assuming that is still the binary format at the time.
-my $UDEBLIST_FORMAT = "Lintian's list of udeb packages in the archive--V3";
-
-# List of fields in the formats and the order they appear in
-# - for internal usage to read and write the files
-
-# source package lists
-my @SRC_FILE_FIELDS = (
- 'source',
- 'version',
- 'maintainer',
- 'uploaders',
- 'architecture',
- 'area',
- 'standards-version',
- 'binary',
- 'files',
- 'file',
- 'timestamp',
- );
-# binary/udeb package lists
-my @BIN_FILE_FIELDS = (
- 'package',
- 'version',
- 'source',
- 'source-version',
- 'file',
- 'timestamp',
- 'area',
- );
-# changes packages lists
-my @CHG_FILE_FIELDS = (
- 'source',
- 'version',
- 'architecture',
- 'file',
- 'timestamp',
- );
-
-=item Lintian::Internal::PackageList->new($pkg_type)
-
-Creates a new packages list for a certain type of packages. This type
-defines the format of the files.
-
-The known types are:
- * binary
- * changes
- * source
- * udeb
-
-=cut
-
-sub new {
- my ($class, $pkg_type) = @_;
- my $self = {
- 'type' => $pkg_type,
- 'dirty' => 0,
- 'state' => {},
- };
- bless $self, $class;
- return $self;
-}
-
-=item $plist->dirty()
-
-Returns a truth value if the packages list has changed since it was
-last written.
-
-=item $plist->type()
-
-Returns the type of this list. (one of binary, udeb, source or changes)
-
-=cut
-
-
-Lintian::Internal::PackageList->mk_ro_accessors(qw(dirty type));
-
-=item $plist->read_list($file)
-
-Replaces the current list with the one in $file. This will croak on errors.
-
-This will clear the L<dirty|/dirty> flag.
-
-=cut
-
-sub read_list {
- my ($self, $file) = @_;
- my $ehd;
- my $fields;
-
- # Accept a scalar (as an "in-memory file") - write_list does the same
- if (my $r = ref $file) {
- croak "Attempt to pass non-scalar ref to read_list.\n" unless $r eq 'SCALAR';
- } else {
- return unless -s $file;
- }
-
- if ($self->{'type'} eq 'source') {
- $ehd = SRCLIST_FORMAT;
- $fields = \@SRC_FILE_FIELDS;
- } elsif ($self->{'type'} eq 'binary' || $self->{'type'} eq 'udeb') {
- $ehd = BINLIST_FORMAT;
- $fields = \@BIN_FILE_FIELDS;
- } elsif ($self->{'type'} eq 'changes') {
- $ehd = CHGLIST_FORMAT;
- $fields = \@CHG_FILE_FIELDS;
- }
- $self->{'state'} = $self->_do_read_file($file, $ehd, $fields);
- $self->_mark_dirty(0);
- return 1;
-}
-
-=item $plist->write_list($file)
-
-Writes the packages list to $file. This will croak on errors.
-
-This will clear the L<dirty|/dirty> flag.
-
-=cut
-
-sub write_list {
- my ($self, $file) = @_;
- my $header;
- my $state = $self->{'state'};
- my $fields;
-
- if ($self->{'type'} eq 'source') {
- $header = SRCLIST_FORMAT;
- $fields = \@SRC_FILE_FIELDS;
- } elsif ($self->{'type'} eq 'binary' || $self->{'type'} eq 'udeb') {
- $header = BINLIST_FORMAT;
- $fields = \@BIN_FILE_FIELDS;
- } elsif ($self->{'type'} eq 'changes') {
- $header = CHGLIST_FORMAT;
- $fields = \@CHG_FILE_FIELDS;
- }
- open my $fd, '>', $file or croak "open $file: $!";
- print $fd "$header\n";
- foreach my $entry (sort keys %$state) {
- my %values = %{ $state->{$entry} };
- print $fd join(';', @values{@$fields}) . "\n";
- }
- close $fd or croak "close $file: $!";
- $self->_mark_dirty(0);
- return 1;
-}
-
-=item $plist->get($pkg_name);
-
-Fetches the entry for $pkg_name (if any). Returns C<undef> if the
-entry is not known.
-
-=cut
-
-sub get {
- my ($self, $pkg_name) = @_;
- return $self->{'state'}->{$pkg_name};
-}
-
-=item $plist->set($pkg_name, $data)
-
-Creates (or overwrites) the entry for $pkg_name.
-
-=cut
-
-sub set {
- my ($self, $pkg_name, $data) = @_;
- my $fields;
- my %pdata;
- my $pkg_type = $self->{'type'};
- if ($pkg_type eq 'source') {
- $fields = \@SRC_FILE_FIELDS;
- } elsif ($pkg_type eq 'binary' || $pkg_type eq 'udeb') {
- $fields = \@BIN_FILE_FIELDS;
- } else {
- $fields = \@CHG_FILE_FIELDS;
- }
-
- %pdata = map { $_ => $data->{$_} } @$fields;
- $pdata{$fields->[0]} = $pkg_name;
- $self->{'state'}->{$pkg_name} = \%pdata;
- return 1;
-}
-
-=item $plist->delete($pkg_name)
-
-Removes the entry for $pkg_name (if any). This will mark the list as
-dirty.
-
-=cut
-
-sub delete {
- my ($self, $pkg_name) = @_;
- delete $self->{'state'}->{$pkg_name};
- $self->_mark_dirty(1);
- return 1;
-}
-
-=item $plist->get_all
-
-Returns the all the entry names in the list
-
-=cut
-
-sub get_all {
- my ($self) = @_;
- return keys %{ $self->{'state'} };
-}
-
-sub diff {
- my ($self, $olist) = @_;
- croak "Diffing incompatible types" unless $self->{'type'} eq $olist->{'type'};
- my %ocopy = %{ $olist->{'state'} };
- my @changed;
- my @added;
- my @removed;
- my $sstate = $self->{'state'};
- foreach my $sen (keys %$sstate) {
- my $sentry = $sstate->{$sen};
- my $oentry = $ocopy{$sen};
- unless (defined $oentry) {
- push @added, $sen;
- next;
- }
- if ($sentry->{'version'} ne $oentry->{'version'} ||
- $sentry->{'timestamp'} ne $oentry->{'timestamp'}) {
- push @changed, $sen;
- }
- delete $ocopy{$sen}
- }
- @removed = keys %ocopy;
- return Lintian::Internal::PackageListDiff->_new($self->{'type'}, $self, $olist,
- \@added, \@removed, \@changed);
-}
-
-### Internal methods ###
-
-# $plist->_mark_dirty($val)
-#
-# Internal sub to alter the dirty flag. 1 for dirty, 0 for "not dirty"
-sub _mark_dirty {
- my ($self, $dirty) = @_;
- $self->{'dirty'} = $dirty;
-}
-
-# $plist->_do_read_file($file, $header, $fields)
-#
-# internal sub to actually load the pkg list from $file.
-# $header is the expected header (first line excl. newline)
-# $fields is a ref to the relevant field list (see @*_FILE_FIELDS)
-# - croaks on error
-sub _do_read_file {
- my ($self, $file, $header, $fields) = @_;
- my $count = scalar @$fields;
- my $res = {};
- open my $fd, '<', $file or croak "open $file: $!";
- my $hd = <$fd>;
- chop $hd;
- unless ($hd eq $header) {
- # accept the UDEB 3 header as alternative to the BIN 4 file
- if ($hd ne $UDEBLIST_FORMAT || BINLIST_FORMAT !~ m/archive--V4$/o) {
- close($fd);
- croak "Unknown/unsupported file format ($hd)";
- }
- # ok - was an UDEB 3 file, which is a BIN 4 file with a different header
- }
-
- while ( my $line = <$fd> ) {
- chop($line);
- next if $line =~ m/^\s*+$/o;
- my (@values) = split m/\;/o, $line, $count;
- my $entry = {};
- unless ($count == scalar @values) {
- close $fd;
- croak "Invalid line in $file at line $. ($_)"
- }
- for( my $i = 0 ; $i < $count ; $i++){
- $entry->{$fields->[$i]} = $values[$i];
- }
- $res->{$values[0]} = $entry;
- }
- close $fd;
- return $res;
-}
-
-=back
-
-=head1 AUTHOR
-
-Originally written by Niels Thykier <niels@thykier.net> for Lintian.
-
-=head1 SEE ALSO
-
-lintian(1)
-
-=cut
-
-1;
-
diff --git a/lib/Lintian/Internal/PackageListDiff.pm b/lib/Lintian/Internal/PackageListDiff.pm
deleted file mode 100644
index 07cf530..0000000
--- a/lib/Lintian/Internal/PackageListDiff.pm
+++ /dev/null
@@ -1,108 +0,0 @@
-# Lintian::Internal::PackageListDiff -- Representation of a diff between two PackageLists
-
-# Copyright (C) 2011 Niels Thykier
-#
-# This program is free software; you can redistribute it and/or modify
-# it 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.
-
-package Lintian::Internal::PackageListDiff;
-
-use strict;
-use warnings;
-
-use base qw(Class::Accessor);
-
-=head1 NAME
-
-Lintian::Inernal::PackageListDiff -- Difference representation between two PackageLists
-
-=head1 SYNOPSIS
-
- use Lintian::Internal::PackageList;
-
- my $olist = Lintian::Internal::PackageList->new('binary');
- my $nlist = Lintian::Internal::PackageList->new('binary');
- $olist->read_list('old/binary-packages');
- $nlist->read_list('new/binary-packages');
- my $diff = $nlist->diff($olist);
- foreach my $added (@{ $diff->added }) {
- my $entry = $nlist->get($added);
- # do something
- }
- foreach my $removed (@{ $diff->removed }) {
- my $entry = $olist->get($removed);
- # do something
- }
- foreach my $changed (@{ $diff->changed }) {
- my $oentry = $olist->get($changed);
- my $nentry = $nlist->get($changed);
- # use/diff $oentry and $nentry as needed
- }
-
-=head1 DESCRIPTION
-
-Instances of this class provides access to the packages list used by
-the Lab as caches.
-
-=head1 METHODS
-
-=over 4
-
-=cut
-
-# Private constructor (used by Lintian::Internal::PackageList
-sub _new {
- my ($class, $type, $nlist, $olist, $added, $removed, $changed) = @_;
- my $self = {
- 'added' => $added,
- 'removed' => $removed,
- 'changed' => $changed,
- 'type' => $type,
- 'olist' => $olist,
- 'nlist' => $nlist,
- };
- bless $self, $class;
- return $self;
-}
-
-=item $diff->added
-
-Returns a list ref containing the names of the elements that has been added.
-
-=item $diff->removed
-
-Returns a list ref containing the names of the elements that has been removed.
-
-=item $diff->changed
-
-Returns a list ref containing the names of the elements that has been changed.
-
-=item $diff->nlist
-
-Returns the "new" list used to create this diff. Note the list is not
-copied and may have been changed since the diff has been created.
-
-=item $diff->olist
-
-Returns the "old" list used to create this diff. Note the list is not
-copied and may have been changed since the diff has been created.
-
-=cut
-
-Lintian::Internal::PackageListDiff->mk_ro_accessors (qw(added removed changed type nlist olist));
-
-1;
-
diff --git a/t/scripts/Lintian/Internal/PackageList/01-basic.t b/t/scripts/Lintian/Internal/PackageList/01-basic.t
deleted file mode 100644
index 0072324..0000000
--- a/t/scripts/Lintian/Internal/PackageList/01-basic.t
+++ /dev/null
@@ -1,38 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 7;
-
-BEGIN { use_ok('Lintian::Internal::PackageList'); }
-
-my $plist = Lintian::Internal::PackageList->new('changes');
-my $input = {
- 'source' => 'src',
- 'version' => '0.10',
- 'file' => 'src_0.10.changes',
- 'timestamp' => '1264616563', # Release date of S-V 3.8.4 (according to our data files)
- 'random-field' => 'hallo world',
-};
-my $output;
-my @contents;
-my $orig_file = $input->{'file'}; # safe for later
-
-$plist->set($input->{'source'}, $input);
-@contents = $plist->get_all;
-
-is(@contents, 1, "Contents one element");
-is($contents[0], $input->{'source'}, "Element has the right name");
-
-# Change input, output should be unaffected
-$input->{'file'} = "lalalala";
-
-$output = $plist->get($input->{'source'});
-
-ok($output, "get returns a defined object");
-is($output->{'source'}, $input->{'source'}, "Input{source} eq Output{source}");
-
-isnt($output->{'random-field'}, "Output contains random-field");
-is($output->{'file'}, $orig_file, "Output{file} is unaffected by modification");
-
diff --git a/t/scripts/Lintian/Internal/PackageList/02-io.t b/t/scripts/Lintian/Internal/PackageList/02-io.t
deleted file mode 100644
index cd1304b..0000000
--- a/t/scripts/Lintian/Internal/PackageList/02-io.t
+++ /dev/null
@@ -1,57 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More;
-use Lintian::Internal::PackageList;
-
-my $DATADIR = $0;
-$DATADIR =~ s,[^/]+$,,o;
-if ($DATADIR) {
- # invokved in some other dir
- $DATADIR = "$DATADIR/data";
-} else {
- # current dir
- $DATADIR = 'data';
-}
-
-plan skip_all => 'Data files not available'
- unless -d $DATADIR;
-
-plan tests => 9;
-
-my $plist = Lintian::Internal::PackageList->new('changes');
-my $olist = Lintian::Internal::PackageList->new('changes');
-$plist->read_list("$DATADIR/changes1-info");
-my @all = sort $plist->get_all;
-my @oall;
-my $inmemdata;
-
-is( @all, 3, "Read 3 elements from the data file");
-for ( my $i = 0; $i < scalar @all; $i++) {
- my $no = $i + 1;
- is($all[$i], "pkg$no", "The first element is pkg$no");
-}
-
-ok( eval {
- $plist->write_list(\$inmemdata);
- $olist->read_list(\$inmemdata);
- 1;
-}, "Wrote and read the data");
-
-SKIP: {
- if ($@) {
- diag("Write/Read issue: $@");
- skip 'Write test failed; the rest of the tests will not work', 4;
- }
- @oall = sort $olist->get_all;
- is_deeply(\@all, \@oall, "The lists contents the same elements");
- for ( my $i = 0 ; $i < scalar @all ; $i++) {
- my $no = $i + 1;
- my $e = $plist->get($all[$i]);
- my $oe = $olist->get($all[$i]);
- is_deeply($e, $oe, "Element no. $no are identical");
- }
-}
-
diff --git a/t/scripts/Lintian/Internal/PackageList/data/changes1-info b/t/scripts/Lintian/Internal/PackageList/data/changes1-info
deleted file mode 100644
index 92ccaf9..0000000
--- a/t/scripts/Lintian/Internal/PackageList/data/changes1-info
+++ /dev/null
@@ -1,4 +0,0 @@
-Lintian's list of changes packages in the archive--V1
-pkg1;1.0;i386;pkg1_1.0.changes;1264616563
-pkg2;1.0-1;i386;pkg1_1.0-1.changes;1264616564
-pkg3;1.1-1;i386;pkg1_1.1-1.changes;1264616565
diff --git a/unpack/list-binpkg b/unpack/list-binpkg
deleted file mode 100755
index ea1b412..0000000
--- a/unpack/list-binpkg
+++ /dev/null
@@ -1,236 +0,0 @@
-#!/usr/bin/perl -w
-# list-binpkg -- lintian helper script
-
-# Copyright (C) 1998 Christian Schwarz
-#
-# This program is free software; you can redistribute it and/or modify
-# it 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 warnings;
-
-use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Lintian::Lab::Manifest;
-use Lintian::Relation::Version qw(versions_lte);
-use Util;
-
-# turn file buffering off:
-$| = 1;
-
-# parse command line options
-if ($#ARGV == -1) {
- print "list-binpkg [-v] <output-list-file>\n";
- print "options:\n";
- print " -v verbose\n";
- print " -u Fetch udebs\n";
- exit 0;
-}
-
-my $verbose = 0;
-my $udeb = 0;
-my $output_file = undef;
-my $type = 'binary';
-
-while (my $arg = shift) {
- if ($arg =~ s,^-,,o) {
- if ($arg eq 'v') {
- $verbose = 1;
- } elsif ($arg eq 'u') {
- $udeb = 1;
- $type = 'udeb';
- } else {
- print STDERR "error: unknown command line argument: $arg\n";
- exit 1;
- }
- } else {
- if ($output_file) {
- print STDERR "error: too many command line arguments: $arg\n";
- exit 1;
- }
- $output_file = $arg;
- }
-}
-
-unless ($output_file) {
- print STDERR "error: no output file specified\n";
- exit 1;
-}
-
-
-
-# get variables out of environment
-my $LINTIAN_ARCHIVEDIR = $ENV{'LINTIAN_ARCHIVEDIR'};
-my $LINTIAN_DIST = $ENV{'LINTIAN_DIST'};
-my $LINTIAN_ARCH = $ENV{'LINTIAN_ARCH'};
-my $LINTIAN_AREA = $ENV{'LINTIAN_AREA'};
-my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
-
-# read old list file (this command does nothing if the file does not exist)
-my $plist = Lintian::Lab::Manifest->new ($type);
-# This stores all the new ones (allows us to use $plist to find old entries)
-my $nlist = Lintian::Lab::Manifest->new ($type);
-# ignore the contents if the contents cannot be read - that is what we
-# used to do!
-eval { $plist->read_list($output_file) };
-
-my %pkgfile;
-# map filenames to package keys (so we can look them up later)
-$plist->visit_all (sub {
- my ($v, @k) = @_;
- $pkgfile{$v->{'file'}} = \@k;
-});
-
-# parse Packages file to get list of packages
-my @packages_files;
-foreach my $area (split /\s*,\s*/,$LINTIAN_AREA) {
- my %hash;
- my $file;
- $hash{'dist'} = $LINTIAN_DIST;
- $hash{'arch'} = $LINTIAN_ARCH;
- $hash{'area'} = $area;
- if ($udeb) {
- $file = "$LINTIAN_ARCHIVEDIR/dists/$hash{'dist'}/$hash{'area'}/" .
- "debian-installer/binary-$hash{'arch'}/Packages";
- } else {
- $file = "$LINTIAN_ARCHIVEDIR/dists/$hash{'dist'}/$hash{'area'}/" .
- "binary-$hash{'arch'}/Packages";
- }
- $hash{'file'} = $file;
- push @packages_files, \%hash;
-}
-
-my $total = 0;
-my @status_list;
-
-foreach my $packages_file (@packages_files) {
- my $pkgs_file = $packages_file->{'file'};
- if (-e $pkgs_file) {
- print "N: Parsing $pkgs_file ...\n" if $verbose;
- open(IN, '<', $pkgs_file)
- or fail("cannot open Packages file $pkgs_file: $!");
- } elsif (-e "$pkgs_file.gz") {
- print "N: Parsing $pkgs_file.gz ...\n" if $verbose;
- open (IN, '-|', 'gzip', '-dc', "$pkgs_file.gz")
- or fail("cannot open Packages file $pkgs_file.gz: $!");
- } else {
- fail("No packages file $pkgs_file");
- }
-
- my $line;
-
- while (!eof(IN)) {
- my ($arch, $deb_file);
- do {
- $line = <IN>;
- if ($line =~ /^Architecture: (.*)$/m) {
- $arch = $1;
- } elsif ($line =~ /^Filename: (.*)$/m) {
- $deb_file = $1;
- }
- } until (not defined($line) or $line =~ /^\s*$/m);
-
- my @stat;
- # get timestamp...
- unless (@stat = stat "$LINTIAN_ARCHIVEDIR/$deb_file") {
- print "E: general: cannot stat $LINTIAN_ARCHIVEDIR/$deb_file\n";
- next;
- }
- my $timestamp = $stat[9];
- my ($status, $data);
- my @keys;
-
- # was package already included in last list?
- if (exists $pkgfile{$deb_file}) {
- # yes!
- @keys = @{ $pkgfile{$deb_file} };
- $data = $plist->get (@keys);
-
- # file changed since last run?
- if ($timestamp == $data->{'timestamp'}) {
- # no.
- $status = 'unchanged';
- } else {
- $status = 'changed';
- $plist->delete (@keys);
- }
- } else {
- # new package, get info
- $status = 'new';
- }
-
- if (($status eq 'new') or ($status eq 'changed')) {
- $data = &safe_get_deb_info ($deb_file);
- next if not defined $data;
- @keys = ($data->{'package'}, $data->{'version'}, $data->{'architecture'});
- }
-
- unless (exists $data->{'source-version'}) {
- if ($data->{'source'} =~ /^([-+\.\w]+)\s+\((.+)\)$/) {
- $data->{'source'} = $1;
- $data->{'source-version'} = $2;
- } else {
- $data->{'source-version'} = $data->{'version'};
- }
- }
-
- # Save entry for writing to output file.
- $data->{file} = $deb_file;
- $data->{timestamp} = $timestamp;
- $data->{area} = $packages_file->{area};
- push @status_list, [$status, @keys];
- $nlist->set ($data);
-
- # remove record
- plist->delete (@keys) if $status eq 'unchanged';
- $total++;
- }
- close(IN) or fail("cannot close input pipe: $!");
-}
-$nlist->write_list($output_file);
-
-if ($verbose) {
- foreach my $status (@status_list) {
- print "N: Listed %s $type package %s %s %s\n", @$status;
- }
-
- # All packages that are still included in $plist have disappeared
- # from the archive.
- $plist->visit_all (sub { print "N: Removed $type $_[1] $_[2] $_[3] from list\n" });
- printf "N: Listed %d $type packages\n",$total;
-}
-
-exit 0;
-
-sub safe_get_deb_info {
- # use eval when calling get_deb_info, since we don't want to `die' just
- # because of a single broken package
- my $data;
- eval { $data = get_deb_info("$LINTIAN_ARCHIVEDIR/$_[0]"); };
- if ($@) {
- # error!
- print STDERR "$@\n";
- print "E: general: bad-$type-package $_[0]\n";
- return;
- }
- $data->{'source'} or ($data->{'source'} = $data->{'package'});
- return $data;
-}
-
-# Local Variables:
-# indent-tabs-mode: nil
-# cperl-indent-level: 4
-# End:
-# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/unpack/list-srcpkg b/unpack/list-srcpkg
deleted file mode 100755
index 1f6eb1a..0000000
--- a/unpack/list-srcpkg
+++ /dev/null
@@ -1,199 +0,0 @@
-#!/usr/bin/perl -w
-# list-srcpkg -- lintian helper script
-
-# Copyright (C) 1998 Christian Schwarz
-#
-# This program is free software; you can redistribute it and/or modify
-# it 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 warnings;
-
-use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Lintian::Lab::Manifest;
-use Lintian::Relation::Version qw(versions_lte);
-
-# turn file buffering off:
-$| = 1;
-
-# parse command line options
-if ($#ARGV == -1) {
- print "list-srcpkg [-v] <output-list-file>\n";
- print "options:\n";
- print " -v verbose\n";
- exit 0;
-}
-
-my $verbose = 0;
-my $output_file = undef;
-
-while (my $arg = shift) {
- if ($arg =~ s,^-,,o) {
- if ($arg eq 'v') {
- $verbose = 1;
- } else {
- print STDERR "error: unknown command line argument: $arg\n";
- exit 1;
- }
- } else {
- if ($output_file) {
- print STDERR "error: too many command line arguments: $arg\n";
- exit 1;
- }
- $output_file = $arg;
- }
-}
-unless ($output_file) {
- print STDERR "error: no output file specified\n";
- exit 1;
-}
-
-# get variables out of environment
-my $LINTIAN_ARCHIVEDIR = $ENV{'LINTIAN_ARCHIVEDIR'};
-my $LINTIAN_DIST = $ENV{'LINTIAN_DIST'};
-my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
-my $LINTIAN_AREA = $ENV{'LINTIAN_AREA'};
-
-# read old list file (this command does nothing if the file does not exist)
-my $plist = Lintian::Lab::Manifest->new ('source');
-my $nlist = Lintian::Lab::Manifest->new ('source');
-# ignore the contents if the contents cannot be read - that is what we
-# used to do!
-eval { $plist->read_list($output_file) };
-
-my @status_list;
-
-my %pkgfile;
-# map filenames to package keys (so we can look them up later)
-$plist->visit_all (sub {
- my ($v, @k) = @_;
- $pkgfile{$v->{'file'}} = \@k;
-});
-
-# parse Sources.gz to get list of packages
-my @sources;
-foreach my $area (split /\s*,\s*/,$LINTIAN_AREA) {
- my %hash;
- $hash{'dist'} = $LINTIAN_DIST;
- $hash{'area'} = $area;
- $hash{'file'} = "$LINTIAN_ARCHIVEDIR/dists/$hash{'dist'}/$hash{'area'}/" .
- 'source/Sources.gz';
- push @sources, \%hash;
-}
-
-my $total = 0;
-
-foreach my $sources (@sources) {
- print "N: Parsing $sources->{'file'} ...\n" if $verbose;
- open(IN, '-|', 'zcat', $sources->{'file'})
- or fail("Cannot open input pipe from zcat $sources->{'file'}: $!");
-
- my $line;
-
- while (!eof(IN)) {
- my $pkg_dir;
- my $dsc_file;
-
- do {
- $line = <IN>;
- if ($line =~ m/^Directory: (.*)$/) {
- $pkg_dir = $1;
- } elsif ($line =~ m/^ [0-9a-f]{32} [0-9]+ (.+\.dsc)$/) {
- $dsc_file = $1;
- }
- } until (not defined($line) or $line =~ /^\s*$/);
- $dsc_file = "$pkg_dir/$dsc_file";
-
- my @stat;
- # get timestamp...
- unless (@stat = stat "$LINTIAN_ARCHIVEDIR/$dsc_file") {
- warn "E: general: cannot stat file $LINTIAN_ARCHIVEDIR/$dsc_file: $!\n";
- next;
- }
- my $timestamp = $stat[9];
-
- my ($status,$data);
- my @keys;
-
- # was package already included in last list?
- if (exists $pkgfile{$dsc_file}) {
- # yes!
- @keys = @{ $pkgfile{$dsc_file} };
- $data = $plist->get (@keys);
-
- # file changed since last run?
- if ($timestamp == $data->{'timestamp'}) {
- # no.
- $status = 'unchanged';
- } else {
- $status = 'changed';
- $plist->delete (@keys);
- }
- } else {
- # new package, get info
- $status = 'new';
- }
-
- if (($status eq 'new') or ($status eq 'changed')) {
- # use eval when calling get_dsc_info, since we don't want to `die' just
- # because of a single broken package
- eval { $data = get_dsc_info("$LINTIAN_ARCHIVEDIR/$dsc_file"); };
- if ($@) {
- # error!
- print STDERR "$@\n";
- print "E: general: bad-source-package $dsc_file\n";
- next;
- }
- @keys = ($data->{'source'}, $data->{'version'});
- }
-
- # Save entry for writing to output file.
- $data->{file} = $dsc_file;
- $data->{area} = $sources->{area};
- $data->{timestamp} = $timestamp;
- for (qw(version maintainer uploaders binary)) {
- $data->{$_} =~ tr/;\n/_ / if $data->{$_};
- }
- push @status_list, [$status, @keys];
- $nlist->set ($data);
-
- # remove record from hash
- $plist->delete (@keys) if $status eq 'unchanged';
- $total++;
- }
- close(IN) or fail("cannot close input pipe: $!");
-}
-
-$nlist->write_list($output_file);
-
-if ($verbose) {
- foreach my $status (@status_list) {
- print "N: Listed %s source package %s %s\n", @$status;
- }
-
- # All packages that are still included in $plist have disappeared
- # from the archive.
- $plist->visit_all (sub { print "N: Removed source $_[1] $_[2] $_[3] from list\n" });
- printf "N: Listed %d source packages\n",$total;
-}
-
-exit 0;
-
-# Local Variables:
-# indent-tabs-mode: nil
-# cperl-indent-level: 4
-# End:
-# vim: syntax=perl sw=4 sts=4 sr et
--
Debian package checker
Reply to: