[SCM] Debian package checker branch, master, updated. 2.5.10-228-gdd7bf1a

["Niels Thykier" <niels@thykier.net>]

The following commit has been merged in the master branch:
commit 2f1d4f1bed3a3e22812f02a34aee6017d1bedd17
Author: Niels Thykier <niels@thykier.net>
Date:   Wed Oct 24 16:03:29 2012 +0200

    L::I::FrontendUtil: add split_tag
    
    Refactor the tag "splitting" code and put it in
    Lintian::Internal::FrontendUtil.
    
    Signed-off-by: Niels Thykier <niels@thykier.net>

diff --git a/frontend/lintian-info b/frontend/lintian-info
index 865f715..3816fa0 100755
--- a/frontend/lintian-info
+++ b/frontend/lintian-info
@@ -38,6 +38,7 @@ BEGIN {
 # import perl libraries
 use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Lintian::Data;
+use Lintian::Internal::FrontendUtil qw(split_tag);
 use Lintian::Profile;
 
 my %already_displayed = ();
@@ -94,19 +95,6 @@ if ($tags) {
 }
 
 my $type_re = qr/(?:binary|changes|source|udeb)/o;
-# 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:
-#                                  111
-# -  T: pkg type (version) [arch]: tag [...]
-#           ^^^^^^^^^^^^^^^^^^^^^
-# Where the marked part(s) are optional values.  The numbers above the example
-# are the capture groups.
-my $fullre = qr/[EWIXOP]: \S+(?: $type_re(?:$verarchre)?)?: (\S+)(?:\s+.*)?/o;
 
 # Otherwise, read input files or STDIN, watch for tags, and add descriptions
 # whenever we see one, can, and haven't already explained that tag.  Strip off
@@ -132,8 +120,9 @@ while (<>) {
         $tagdata = $1;
         ($tag, undef) = split m/ /o, $tagdata, 2;
     } else {
-        next unless m/^$fullre$/o;
-        $tag = $1;
+        my @parts = split_tag ($_);
+        next unless @parts;
+        $tag = $parts[5];
     }
     next if $already_displayed{$tag}++;
     my $info = $profile->get_tag ($tag, 1);
diff --git a/lib/Lintian/Internal/FrontendUtil.pm b/lib/Lintian/Internal/FrontendUtil.pm
index d6ea68b..72bcd66 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 load_collections);
+our @EXPORT = qw(check_test_feature default_parallel load_collections split_tag);
 
 # Check if we are testing a specific feature
 #  - e.g. vendor-libdpkg-perl
@@ -78,6 +78,31 @@ sub default_parallel {
     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:
diff --git a/reporting/html_reports b/reporting/html_reports
index abb0512..ebc403e 100755
--- a/reporting/html_reports
+++ b/reporting/html_reports
@@ -54,6 +54,7 @@ $ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT;
 # Import Lintian Perl libraries.
 use lib "$ENV{LINTIAN_ROOT}/lib";
 use Lintian::Data;
+use Lintian::Internal::FrontendUtil qw(split_tag);
 use Lintian::Lab;
 use Lintian::Profile;
 use Lintian::Util qw(read_dpkg_control slurp_entire_file);
@@ -184,23 +185,12 @@ my (%by_maint, %by_uploader, %by_tag);
 # about it).
 my (%seen, %saw_maintainer);
 
-# 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 $fullre = qr/([EWIXOP]): (\S+)(?: (\S+)(?:$verarchre)?)?: (\S+)(?:\s+(.*))?/o;
 while (<>) {
+    my @parts;
     chomp;
-    next unless m/^$fullre/o;
-    my ($code, $package, $type, $pver, $parch, $tag, $extra) = ($1, $2, $3, $4, $5, $6, $7);
+    @parts = split_tag ($_);
+    next unless @parts;
+    my ($code, $package, $type, $pver, $parch, $tag, $extra) = @parts;
     $type = 'binary' unless (defined $type);
     $extra = '' unless (defined $extra);
     next unless ($type eq 'source' || $type eq 'binary' || $type eq 'udeb');

-- 
Debian package checker