[SCM] Debian package checker branch, master, updated. 2.5.10-110-gbe2dc6a
The following commit has been merged in the master branch:
commit be2dc6ab64cac36998cd8fe5bd29f7ee791ef0b3
Author: Niels Thykier <niels@thykier.net>
Date: Thu Aug 9 00:23:30 2012 +0200
Reduce the boiler plate code needed to use L::Profile
Have the L::Profile::new set a default include path if one is not
provided. Allow the default vendor profile to be loaded by passing
the undefined value as profile name.
Remove find_profile from L::Profile's API, it is no longer used
outside L::Profile and it was hardly useful before.
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/frontend/lintian b/frontend/lintian
index 0d2585e..665d5c4 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -830,12 +830,10 @@ $TAGS->show_experimental($opt{'display-experimental'});
$TAGS->show_overrides($opt{'show-overrides'});
$TAGS->sources(keys %display_source) if %display_source;
-unless ($opt{'LINTIAN_PROFILE'}){
- # Time to ask dpkg-vendor for a vendor name
- $opt{'LINTIAN_PROFILE'} = find_default_profile(@prof_inc, "$opt{'LINTIAN_ROOT'}/profiles");
-}
$PROFILE = Lintian::Profile->new ($opt{'LINTIAN_PROFILE'}, $opt{'LINTIAN_ROOT'},
[@prof_inc, "$opt{'LINTIAN_ROOT'}/profiles"]);
+# Ensure $opt{'LINTIAN_PROFILE'} is defined
+$opt{'LINTIAN_PROFILE'} = $PROFILE->name unless defined $opt{'LINTIAN_PROFILE'};
v_msg('Using profile ' . $PROFILE->name . '.');
if ($dont_check || %suppress_tags || $checks || $check_tags) {
diff --git a/frontend/lintian-info b/frontend/lintian-info
index 6406a18..db657e9 100755
--- a/frontend/lintian-info
+++ b/frontend/lintian-info
@@ -38,16 +38,9 @@ BEGIN {
# import perl libraries
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Data;
-use Lintian::Internal::FrontendUtil;
use Lintian::Profile;
my %already_displayed = ();
-my @proc_inc;
-# In some (rare) cases, $ENV{HOME} will not be available.
-# - Handle that gracefully by not emitting "Uninitialized ...".
-push @proc_inc, "$ENV{HOME}/.lintian/profiles" if defined $ENV{HOME};
-push @proc_inc, '/etc/lintian/profiles', "$ENV{'LINTIAN_ROOT'}/profiles";
-
my ($annotate, $tags, $help, $prof);
my $profile;
Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev');
@@ -74,11 +67,7 @@ EOT
exit 0;
}
-unless ($prof) {
- $prof = find_default_profile(@proc_inc);
-
-}
-$profile = Lintian::Profile->new($prof, $ENV{'LINTIAN_ROOT'}, \@proc_inc);
+$profile = Lintian::Profile->new ($prof, $ENV{'LINTIAN_ROOT'});
Lintian::Data->set_vendor ($profile);
diff --git a/lib/Lintian/Internal/FrontendUtil.pm b/lib/Lintian/Internal/FrontendUtil.pm
index 3fb8d0d..d6ea68b 100644
--- a/lib/Lintian/Internal/FrontendUtil.pm
+++ b/lib/Lintian/Internal/FrontendUtil.pm
@@ -27,7 +27,7 @@ use Dpkg::Vendor;
use Lintian::CollScript;
use Lintian::Util qw(check_path fail);
-our @EXPORT = qw(check_test_feature default_parallel find_default_profile load_collections);
+our @EXPORT = qw(check_test_feature default_parallel load_collections);
# Check if we are testing a specific feature
# - e.g. vendor-libdpkg-perl
@@ -40,30 +40,6 @@ sub check_test_feature{
return 0;
}
-# find_default_profile(@prof_path)
-#
-# locates the default profile - used if no profile was explicitly given.
-sub find_default_profile {
- my (@prof_path) = @_;
- my $vendor = Dpkg::Vendor::get_current_vendor();
- fail "Could not determine the current vendor.\n"
- unless $vendor;
- my $orig = $vendor; # copy
- while ($vendor) {
- my $p;
- $p = Lintian::Profile->find_profile(lc($vendor), @prof_path);
- last if $p;
- my $info = Dpkg::Vendor::get_vendor_info ($vendor);
- # Cannot happen atm, but in case Dpkg::Vendor changes its internals
- # or our code changes
- fail "Could not look up the parent vendor of $vendor.\n"
- unless $info;
- $vendor = $info->{'Parent'};
- }
- fail("Could not find a profile for vendor $orig") unless $vendor;
- return lc($vendor);
-}
-
# load_collections ($visitor, $dirname)
#
# Load collections from $dirname and pass them to $visitor. $visitor
diff --git a/lib/Lintian/Profile.pm b/lib/Lintian/Profile.pm
index 1227a54..fa45d7e 100644
--- a/lib/Lintian/Profile.pm
+++ b/lib/Lintian/Profile.pm
@@ -35,13 +35,10 @@ Lintian::Profile - Profile parser for Lintian
=head1 SYNOPSIS
- my @inc = ("$ENV{'HOME'}/.lintian/profiles/",
- '/etc/lintian/profiles/',
- "$ENV{'LINTIAN_ROOT'}/profiles/");
- # Check if the Ubuntu default profile is present.
- my $file = Lintian::Profile->find_profile('ubuntu', @inc);
- # Parse the debian profile (if available)
- my $profile = Lintian::Profile->new('debian', $ENV{'LINTIAN_ROOT'}, [@inc]);
+ # Load the debian profile (if available)
+ my $profile = Lintian::Profile->new ('debian', $ENV{'LINTIAN_ROOT'});
+ # Load the "default" profile for the current vendor
+ $profile = Lintian::Profile->new (undef, $ENV{'LINTIAN_ROOT'});
foreach my $tag ($profile->tags) {
print "Enabled tag: $tag\n";
}
@@ -84,7 +81,7 @@ my %SEC_FIELDS = (
'severity' => 1,
);
-=item Lintian::Profile->new($profname, $root, $ppath)
+=item Lintian::Profile->new($profname, $root[, $ppath])
Creates a new profile from the profile located by using
find_profile($profname, @$ppath). $profname is the name of the
@@ -92,14 +89,17 @@ profile and $ppath is a list reference containing the directories to
search for the profile and (if any) its parents. $root is the
"LINTIAN_ROOT" and is used for finding checks.
+If $profname is C<undef>, the default vendor will be loaded based on
+Dpkg::Vendor::get_current_vendor.
+
+If $ppath is not given, a default one will be used.
+
=cut
sub new {
my ($type, $name, $root, $ppath) = @_;
my $profile;
- croak "Illegal profile name \"$name\""
- if $name =~ m,^/,o or $name =~ m/\./o;
- croak "Undefined profile path" unless $ppath;
+ $ppath = [_default_inc_path ($root)] unless $ppath;
my $self = {
'parent-map' => {},
'profile_list' => [],
@@ -113,7 +113,13 @@ sub new {
'root' => $root,
};
$self = bless $self, $type;
- $profile = $self->find_profile($name);
+ if (not defined $name) {
+ ($profile, $name) = $self->_find_vendor_profile;
+ } else {
+ croak "Illegal profile name \"$name\""
+ if $name =~ m,^/,o or $name =~ m/\./o;
+ $profile = $self->_find_profile ($name);
+ }
croak "Cannot find profile $name (in " . join(', ', @$ppath).")"
unless $profile;
$self->_read_profile($profile);
@@ -250,36 +256,23 @@ sub disable_tags {
}
}
-=item Lintian::Profile->find_profile($pname, @dirs), $prof->find_profile($pname[, @dirs])
-
-This can both be used as a static or as an instance method. If used
-as an instance method, the @dirs argument may be omitted.
-
-Finds a profile called $pname in the search directories (see below)
-and returns the path to it. If $pname does not contain a slash, then
-it will look for a profile called "$pname/main" instead of $pname.
-
-Returns a non-truth value if the profile could not be found. $pname
-cannot contain any dots.
-
-Search Dirs: For the static call, only @dirs are considered. For the
-instance method @dirs is augmented with the search dirs present when
-the object was created.
-
-=cut
+# $prof->_find_profile ($pname)
+#
+# Finds a profile called $pname in the search directories and returns
+# the path to it. If $pname does not contain a slash, then it will look
+# for a profile called "$pname/main" instead of $pname.
+#
+# Returns a non-truth value if the profile could not be found. $pname
+# cannot contain any dots.
-sub find_profile {
- my ($self, $pname, @dirs) = @_;
+sub _find_profile {
+ my ($self, $pname) = @_;
my $pfile;
croak "\"$pname\" is not a valid profile name" if $pname =~ m/\./o;
- # Allow @dirs to override the default path for this profile-search
- if (ref $self) {
- push @dirs, @{ $self->{'profile-path'} } if defined $self->{'profile-path'};
- }
# $vendor is short for $vendor/main
$pname = "$pname/main" unless $pname =~ m,/,o;
$pfile = "$pname.profile";
- foreach my $path (@dirs){
+ foreach my $path (@{ $self->{'profile-path'} }){
return "$path/$pfile" if -e "$path/$pfile";
}
return '';
@@ -317,7 +310,7 @@ sub _read_profile {
my $parentf;
croak "Invalid Extends field in $pfile"
unless $parent && $parent !~ m/\./o;
- $parentf = $self->find_profile($parent);
+ $parentf = $self->_find_profile ($parent);
croak "Cannot find $parent, which $pname extends"
unless $parentf;
$self->_read_profile($parentf);
@@ -519,6 +512,35 @@ sub _load_checks {
close $dirfd;
}
+sub _default_inc_path {
+ my ($root) = @_;
+ my @path = ();
+ push @path, "$ENV{'HOME'}/.lintian/profiles"
+ if exists $ENV{'HOME'} and defined $ENV{'HOME'};
+ push @path, '/etc/lintian/profiles', "$root/profiles";
+ return @path;
+}
+
+sub _find_vendor_profile {
+ my ($self) = @_;
+ require Dpkg::Vendor;
+ my $vendor = Dpkg::Vendor::get_current_vendor ();
+ croak "Could not determine the current vendor"
+ unless $vendor;
+ my $orig = $vendor; # copy
+ while ($vendor) {
+ my $file = $self->_find_profile (lc $vendor);
+ return ($file, $vendor) if $file;
+ my $info = Dpkg::Vendor::get_vendor_info ($vendor);
+ # Cannot happen atm, but in case Dpkg::Vendor changes its internals
+ # or our code changes
+ croak "Could not look up the parent vendor of $vendor"
+ unless $info;
+ $vendor = $info->{'Parent'};
+ }
+ croak "Could not find a profile for vendor $orig";
+}
+
=back
=head1 AUTHOR
diff --git a/reporting/html_reports b/reporting/html_reports
index 35db64d..2edf71b 100755
--- a/reporting/html_reports
+++ b/reporting/html_reports
@@ -53,10 +53,9 @@ use lib "$ENV{LINTIAN_ROOT}/lib";
use Lintian::Data;
use Lintian::Lab;
use Lintian::Profile;
-use Lintian::Internal::FrontendUtil;
use Lintian::Util qw(read_dpkg_control slurp_entire_file);
-my $profile = Lintian::Profile->new (find_default_profile ("$LINTIAN_ROOT/profiles"),
+my $profile = Lintian::Profile->new (undef,
$LINTIAN_ROOT,
["$LINTIAN_ROOT/profiles"]);
--
Debian package checker
Reply to: