/usr/share/perl5/Lintian/Internal/FrontendUtil.pm is in lintian 2.5.22ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | # -*- perl -*-
# Lintian::Internal::FrontendUtil -- internal helpers for lintian frontends
# 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, see <http://www.gnu.org/licenses/>.
package Lintian::Internal::FrontendUtil;
use strict;
use warnings;
use autodie qw(opendir closedir);
use Exporter qw(import);
use Dpkg::Vendor;
use Lintian::CollScript;
use Lintian::Util qw(check_path fail);
our @EXPORT_OK
= qw(check_test_feature default_parallel load_collections split_tag);
# Check if we are testing a specific feature
# - e.g. vendor-libdpkg-perl
sub check_test_feature{
my $env = $ENV{LINTIAN_TEST_FEATURE};
return 0 unless $env;
foreach my $feat (@_){
return 1 if($env =~ m/$feat/);
}
return 0;
}
# load_collections ($visitor, $dirname)
#
# Load collections from $dirname and pass them to $visitor. $visitor
# will be called once per collection as it has been loaded. The first
# (and only) argument to $visitor is the collection as an instance of
# Lintian::CollScript instance.
sub load_collections {
my ($visitor, $dirname) = @_;
opendir(my $dir, $dirname);
foreach my $file (readdir $dir) {
next if $file =~ m/^\./;
next unless $file =~ m/\.desc$/;
my $cs = Lintian::CollScript->new("$dirname/$file");
$visitor->($cs);
}
closedir($dir);
return;
}
# Return the default number of parallization to be used
sub default_parallel {
# check cpuinfo for the number of cores...
my $cpus;
chomp($cpus = `nproc 2>&1`);
if ($? == 0 and $cpus =~ m/^\d+$/) {
# Running up to twice the number of cores usually gets the most out
# of the CPUs and disks but it might be too aggresive to be the
# default for -j. Only use <cores>+1 then.
return $cpus + 1;
}
# No decent number of jobs? Just use 2 as a default
return 2;
}
{
# Matches something like: (1:2.0-3) [arch1 arch2]
# - captures the version and the architectures
my $verarchre = qr,(?: \s* \(( [^)]++ )\) \s* \[ ( [^]]++ ) \]),xo;
# ^^^^^^^^ ^^^^^^^^^^^^
# ( version ) [architecture ]
# matches the full deal:
# 1 222 3333 4444444 5555 666 777
# - T: pkg type (version) [arch]: tag [...]
# ^^^^^^^^^^^^^^^^^^^^^
# Where the marked part(s) are optional values. The numbers above
# the example are the capture groups.
my $TAG_REGEX
= qr/([EWIXOP]): (\S+)(?: (\S+)(?:$verarchre)?)?: (\S+)(?:\s+(.*))?/o;
sub split_tag {
my ($tag_input) = @_;
my $pkg_type;
return unless $tag_input =~ m/^${TAG_REGEX}$/o;
# default value...
$pkg_type = $3//'binary';
return ($1, $2, $pkg_type, $4, $5, $6, $7);
}
}
1;
# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
# End:
# vim: syntax=perl sw=4 sts=4 sr et
|