Преглед изворни кода

Dpkg::Changelog::Entry::Debian: Deprecate regex package variables

Expose two functions to match a changelog header and trailer, instead
of exposing the raw regex variables.

Fixes Variables::ProhibitPackageVars.

Warned-by: perlcritic
Guillem Jover пре 12 година
родитељ
комит
46199371e2
4 измењених фајлова са 53 додато и 15 уклоњено
  1. 2 0
      debian/changelog
  2. 4 3
      scripts/Dpkg/Changelog/Debian.pm
  3. 46 12
      scripts/Dpkg/Changelog/Entry/Debian.pm
  4. 1 0
      test/100_critic.t

+ 2 - 0
debian/changelog

@@ -95,6 +95,8 @@ dpkg (1.17.2) UNRELEASED; urgency=low
     - Dpkg::Exit: Deprecate @handlers package variable.
     - Dpkg::Source::Package: Deprecate $diff_ignore_default_regexp and
       @tar_ignore_default_pattern package variables.
+    - Dpkg::Changelog::Entry::Debian: Deprecate $regex_header and
+      $regex_trailer package variables.
 
   [ Updated programs translations ]
   * German (Sven Joachim).

+ 4 - 3
scripts/Dpkg/Changelog/Debian.pm

@@ -1,6 +1,7 @@
 # Copyright © 1996 Ian Jackson
 # Copyright © 2005 Frank Lichtenheld <frank@lichtenheld.de>
 # Copyright © 2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2012-2013 Guillem Jover <guillem@debian.org>
 #
 # 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
@@ -49,7 +50,7 @@ use Dpkg::Gettext;
 use Dpkg::File;
 use Dpkg::Changelog qw(:util);
 use parent qw(Dpkg::Changelog);
-use Dpkg::Changelog::Entry::Debian qw($regex_header $regex_trailer);
+use Dpkg::Changelog::Entry::Debian qw(match_header match_trailer);
 
 use constant {
     FIRST_HEADING => _g('first heading'),
@@ -83,7 +84,7 @@ sub parse {
 
     while (<$fh>) {
 	chomp;
-	if ($_ =~ $regex_header) {
+	if (match_header($_)) {
 	    unless ($expect eq FIRST_HEADING || $expect eq NEXT_OR_EOF) {
 		$self->parse_error($file, $.,
 		    sprintf(_g('found start of entry where expected %s'),
@@ -124,7 +125,7 @@ sub parse {
 	    $self->set_unparsed_tail("$_\n" . file_slurp($fh));
 	} elsif (m/^\S/) {
 	    $self->parse_error($file, $., _g('badly formatted heading line'), "$_");
-	} elsif ($_ =~ $regex_trailer) {
+	} elsif (match_trailer($_)) {
 	    unless ($expect eq CHANGES_OR_TRAILER) {
 		$self->parse_error($file, $.,
 		    sprintf(_g('found trailer where expected %s'), $expect), "$_");

+ 46 - 12
scripts/Dpkg/Changelog/Entry/Debian.pm

@@ -1,4 +1,5 @@
 # Copyright © 2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2012-2013 Guillem Jover <guillem@debian.org>
 #
 # 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
@@ -18,12 +19,13 @@ package Dpkg::Changelog::Entry::Debian;
 use strict;
 use warnings;
 
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 
 use Exporter qw(import);
 use Dpkg::Changelog::Entry;
 use parent qw(Dpkg::Changelog::Entry);
-our @EXPORT_OK = qw($regex_header $regex_trailer find_closes);
+our @EXPORT_OK = qw(match_header match_trailer find_closes
+                    $regex_header $regex_trailer);
 
 use Date::Parse;
 
@@ -44,22 +46,23 @@ This object represents a Debian changelog entry. It implements the
 generic interface Dpkg::Changelog::Entry. Only functions specific to this
 implementation are described below.
 
-=head1 VARIABLES
-
-$regex_header, $regex_trailer are two regular expressions that can be used
-to match a line and know whether it's a valid header/trailer line.
-
-The matched content for $regex_header is the source package name ($1), the
-version ($2), the target distributions ($3) and the options on the rest
-of the line ($4). For $regex_trailer, it's the maintainer name ($1), its
-email ($2), some blanks ($3) and the timestamp ($4).
-
 =cut
 
 my $name_chars = qr/[-+0-9a-z.]/i;
+
+# XXX: Backwards compatibility, stop exporting on VERSION 2.00.
+## no critic (Variables::ProhibitPackageVars)
+
+# The matched content is the source package name ($1), the version ($2),
+# the target distributions ($3) and the options on the rest of the line ($4).
 our $regex_header = qr/^(\w$name_chars*) \(([^\(\) \t]+)\)((?:\s+$name_chars+)+)\;(.*?)\s*$/i;
+
+# The matched content is the maintainer name ($1), its email ($2),
+# some blanks ($3) and the timestamp ($4).
 our $regex_trailer = qr/^ \-\- (.*) <(.*)>(  ?)((\w+\,\s*)?\d{1,2}\s+\w+\s+\d{4}\s+\d{1,2}:\d\d:\d\d\s+[-+]\d{4}(\s+\([^\\\(\)]\))?)\s*$/o;
 
+## use critic
+
 =head1 FUNCTIONS
 
 =over 4
@@ -257,6 +260,30 @@ sub get_timestamp {
 
 =over 4
 
+=item my $bool = match_header($line)
+
+Checks if the line matches a valid changelog header line.
+
+=cut
+
+sub match_header {
+    my ($line) = @_;
+
+    return $line =~ /$regex_header/;
+}
+
+=item my $bool = match_trailer($line)
+
+Checks if the line matches a valid changelog trailing line.
+
+=cut
+
+sub match_trailer {
+    my ($line) = @_;
+
+    return $line =~ /$regex_trailer/;
+}
+
 =item my @closed_bugs = find_closes($changes)
 
 Takes one string as argument and finds "Closes: #123456, #654321" statements
@@ -280,6 +307,13 @@ sub find_closes {
 
 =back
 
+=head1 CHANGES
+
+=head2 Version 1.01
+
+New functions: match_header(), match_trailer()
+Deprecated variables: $regex_header, $regex_trailer
+
 =head1 AUTHOR
 
 Raphaël Hertzog <hertzog@debian.org>.

+ 1 - 0
test/100_critic.t

@@ -104,6 +104,7 @@ my @policies = qw(
     Variables::ProhibitAugmentedAssignmentInDeclaration
     Variables::ProhibitConditionalDeclarations
     Variables::ProhibitLocalVars
+    Variables::ProhibitPackageVars
     Variables::ProhibitPerl4PackageNames
     Variables::ProhibitUnusedVariables
     Variables::ProtectPrivateVars