[SCM] Debian package checker branch, lab-refactor, updated. 2.5.3-168-gc6fae95
The following commit has been merged in the lab-refactor branch:
commit c6fae95e53cc601261c23fb3c4b6a7db974f2409
Author: Niels Thykier <niels@thykier.net>
Date: Thu Oct 27 19:04:59 2011 +0200
Removed more unused files
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/lib/Lintian/Config.pm b/lib/Lintian/Config.pm
deleted file mode 100644
index 353be96..0000000
--- a/lib/Lintian/Config.pm
+++ /dev/null
@@ -1,87 +0,0 @@
-# Copyright (C) 2011 Niels Thykier <niels@thykier.net>
-#
-# 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.
-
-## Represents a Lintian Config file
-package Lintian::Config;
-
-use strict;
-use warnings;
-
-use Carp qw(croak);
-
-# Lintian::Config->new($opts)
-#
-# Creates an instance of Lintian::Config; each key in $opts
-# specifies a valid option that may appear in the config file.
-sub new {
- my ($type, $opts) = @_;
- my $self = {
- # Options set in the config
- 'opts' => {},
- # Options allowed in the config
- 'allowed-opts' => $opts,
- };
- bless $self, $type;
- return $self;
-}
-
-# $conf->read_file($file);
-#
-# Parses a config file. Croaks if:
-# - there is a syntax error
-# - there is an unknown variable
-# - a variable appears twice in the file
-#
-sub read_file {
- my ($self, $file) = @_;
- my $opts = $self->{'opts'};
- my $allowed = $self->{'allowed-opts'};
- open my $fd, '<', $file or croak "open $file: $!";
- while ( my $line = <$fd> ) {
- chomp($line);
- $line =~ s/\#.*+//o;
- next if $line =~ m/^\s*+$/o;
- if ($line =~ m/^\s*+(\S++)\s*+=\s*+(.*\S)\s*$/o){
- my ($var, $val) = ($1, $2);
- my $old;
- croak "$file: unknown variable (\"$var\") at line $."
- unless exists $allowed->{$var};
- $old = $opts->{$var};
- if (defined $old) {
- croak "$file: \"$var\" appears a second time at line $.";
- } else {
- $opts->{$var} = $val;
- }
- } else {
- croak "$file: syntax error at line $.";
- }
- }
- close $fd;
-}
-
-# $conf->get_variable($var[, $def]);
-#
-# Returns the value of $var if set by the config file
-# If $var was not set, $def (or if absent, undef) is returned.
-sub get_variable {
- my ($self, $var, $def) = @_;
- return $self->{'opts'}->{$var} if exists $self->{'opts'}->{$var};
- return $def;
-}
-
-1;
diff --git a/lib/Lintian/Lab/Util.pm b/lib/Lintian/Lab/Util.pm
deleted file mode 100644
index 3386c60..0000000
--- a/lib/Lintian/Lab/Util.pm
+++ /dev/null
@@ -1,121 +0,0 @@
-package Lintian::Lab::Util;
-
-use strict;
-use warnings;
-
-use Carp qw(croak);
-
-use Lintian::Lab::Manifest;
-use Util ();
-
-# local_mirror_manifests ($mirdir, $dists, $areas, $archs)
-#
-# Returns a list of manifests that represents what is on the local mirror
-# at $mirdir. 3 manifests will be returned, one for "source", one for "binary"
-# and one for "udeb" packages. They are populated based on the "Sources" and
-# "Packages" files.
-#
-# $mirdir - the path to the local mirror
-# $dists - listref of dists to consider (i.e. ['unstable'])
-# $areas - listref of areas to consider (i.e. ['main', 'contrib', 'non-free'])
-# $archs - listref of archs to consider (i.e. ['i386', 'amd64'])
-#
-sub local_mirror_manifests {
- my ($mirdir, $dists, $areas, $archs) = @_;
- my $srcman = Lintian::Lab::Manifest->new ('source');
- my $binman = Lintian::Lab::Manifest->new ('binary');
- my $udebman = Lintian::Lab::Manifest->new ('udeb');
- foreach my $dist (@$dists) {
- foreach my $area (@$areas) {
- my $srcs = "$mirdir/dists/$dist/$area/source/Sources";
- my $srcfd = _open_data_file ($srcs);
- my $srcsub = sub { _parse_srcs_pg ($srcman, $mirdir, $area, @_) };
- # Binaries have a "per arch" file.
- foreach my $arch (@$archs) {
- my $pkgs = "$mirdir/dists/$dist/$area/binary-$arch/Packages";
- my $upkgs = "$mirdir/dists/$dist/$area/debian-installer/" .
- "binary-$arch/Packages";
- my $pkgfd = _open_data_file ($pkgs);
- my $binsub = sub { _parse_pkgs_pg ($binman, $mirdir, $area, @_) };
- my $upkgfd = _open_data_file ($upkgs);
- my $udebsub = sub { _parse_pkgs_pg ($udebman, $mirdir, $area, @_) };
- Util::_parse_dpkg_control_iterative ($binsub, $pkgfd);
- Util::_parse_dpkg_control_iterative ($udebsub, $upkgfd);
- close $pkgfd;
- close $upkgfd;
- }
- }
- }
- return ($srcman, $binman, $udebman);
-}
-
-# _open_data_file ($file)
-#
-# Opens $file if it exists, otherwise it tries common extensions (i.e. .gz) and opens
-# that instead. It may pipe the file through a external decompressor, so the returned
-# file descriptor cannot be assumed to be a file.
-#
-# If $file does not exists and no common extensions are found, this croaks.
-sub _open_data_file {
- my ($file) = @_;
- if (-e $file) {
- open my $fd, '<', $file or croak "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 croak "running @$cmd $file.$ext";
- return $c;
- }
- }
- croak "Cannot find $file";
-}
-
-# Helper for local_mirror_manifests - it parses a paragraph from Packages file
-sub _parse_pkgs_pg {
- my ($manifest, $mirdir, $area, $data) = @_;
- unless ($data->{'source'}) {
- $data->{'source'} = $data->{'package'};
- } elsif ($data->{'source'} =~ /^([-+\.\w]+)\s+\((.+)\)$/) {
- $data->{'source'} = $1;
- $data->{'source-version'} = $2;
- } else {
- $data->{'source-version'} = $data->{'version'};
- }
- unless (defined $data->{'source-version'}) {
- $data->{'source-version'} = $data->{'version'};
- }
- $data->{'file'} = $mirdir . '/' . $data->{'filename'};
- $data->{'area'} = $area;
- # $manifest strips redundant fields for us. But for clarity and to
- # avoid "hard to debug" cases $manifest renames the fields, we explicitly
- # remove the "filename" field.
- delete $data->{'filename'};
-
- $manifest->set ($data);
-}
-
-# Helper for local_mirror_manifests - it parses a paragraph from Sources file
-sub _parse_srcs_pg {
- my ($manifest, $mirdir, $area, $data) = @_;
- my $dir = $data->{'directory'}//'';
- $dir .= '/' if $dir;
- foreach my $f (split m/\n/, $data->{'files'}) {
- $f =~ s/^\s++//o;
- next unless $f && $f =~ m/\.dsc$/;
- my (undef, undef, $file) = split m/\s++/, $f;
- # $dir should end with a slash if it is non-empty.
- $data->{'file'} = $mirdir . "/$dir" . $file;
- last;
- }
- $data->{'area'} = $area;
- # Rename a field :)
- $data->{'source'} = $data->{'package'};
-
- # $manifest strips redundant fields for us.
- $manifest->set ($data);
-}
-
-1;
-
--
Debian package checker
Reply to: