[libparse-debianchangelog-perl] 42/52: General regex cleanup

Intrigeri intrigeri at moszumanska.debian.org
Sun May 24 12:37:31 UTC 2015


This is an automated email from the git hooks/post-receive script.

intrigeri pushed a commit to branch master
in repository libparse-debianchangelog-perl.

commit 4aa27eb9133df635a963b1196db53a5d932884b6
Author: Frank Lichtenheld <frank at lichtenheld.de>
Date:   Mon Apr 4 17:40:13 2011 +0200

    General regex cleanup
    
    - Use named captures for better readability
    - Don't use $& or $`
---
 Changes                                     |  3 +++
 lib/Parse/DebianChangelog.pm                | 24 +++++++++++-------------
 lib/Parse/DebianChangelog/ChangesFilters.pm | 20 ++++++++++----------
 3 files changed, 24 insertions(+), 23 deletions(-)

diff --git a/Changes b/Changes
index 44db029..626e687 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Parse-DebianChangelog (1.2.0) unstable; urgency=low
 
+  * DebianChangelog:
+    - Improve readability of regexes by using named captures
+    - Don't use $& or $` (Closes: #515018)
   * ChangesFilters:
     - Fix conversion of <http://something/> (Closes: #603341)
     - Allow to omit # before closed bug numbers (Closes: 446798 ;)
diff --git a/lib/Parse/DebianChangelog.pm b/lib/Parse/DebianChangelog.pm
index 494b760..f0f9404 100644
--- a/lib/Parse/DebianChangelog.pm
+++ b/lib/Parse/DebianChangelog.pm
@@ -313,7 +313,7 @@ sub parse {
     while (<$fh>) {
 	s/\s*\n$//;
 #	printf(STDERR "%-39.39s %-39.39s\n",$expect,$_);
-	if (m/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)((\s+[-0-9a-z]+)+)\;/i) {
+	if (m/^(?<Source>\w[-+0-9a-z.]*) \((?<Version>[^\(\) \t]+)\)(?<Distribution>(?:\s+[-0-9a-z]+)+)\;\s*(?<kv>.*)$/i) {
 	    unless ($expect eq 'first heading'
 		    || $expect eq 'next heading or eof') {
 		$entry->{ERROR} = [ $file, $NR,
@@ -328,17 +328,15 @@ sub parse {
 		$entry = Parse::DebianChangelog::Entry->init();
 	    }
 	    {
-		$entry->{'Source'} = "$1";
-		$entry->{'Version'} = "$2";
+		$entry->{'Source'} = $+{Source};
+		$entry->{'Version'} = $+{Version};
 		$entry->{'Header'} = "$_";
-		($entry->{'Distribution'} = "$3") =~ s/^\s+//;
+		($entry->{'Distribution'} = $+{Distribution}) =~ s/^\s+//;
 		$entry->{'Changes'} = $entry->{'Urgency_Comment'} = '';
 		$entry->{'Urgency'} = $entry->{'Urgency_LC'} = 'unknown';
 	    }
-	    (my $rhs = $POSTMATCH) =~ s/^\s+//;
 	    my %kvdone;
-#	    print STDERR "RHS: $rhs\n";
-	    for my $kv (split(/\s*,\s*/,$rhs)) {
+	    for my $kv (split(/\s*,\s*/,$+{kv})) {
 		$kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
 		    $self->_do_parse_error($file, $NR,
 					   __g( "bad key-value after \`;': \`%s'", $kv ));
@@ -392,25 +390,25 @@ sub parse {
 	} elsif (m/^\S/) {
 	    $self->_do_parse_error($file, $NR,
 				  __g( "badly formatted heading line" ), "$_");
-	} elsif (m/^ \-\- (.*) <(.*)>(  ?)((\w+\,\s*)?\d{1,2}\s+\w+\s+\d{4}\s+\d{1,2}:\d\d:\d\d\s+[-+]\d{4}(\s+\([^\\\(\)]\))?)$/o) {
+	} elsif (m/^ \-\- (?<name>.*) <(?<email>.*)>(?<sep>  ?)(?<date>(?:\w+\,\s*)?\d{1,2}\s+\w+\s+\d{4}\s+\d{1,2}:\d\d:\d\d\s+[-+]\d{4}(\s+\([^\\\(\)]\))?)$/o) {
 	    $expect eq 'more change data or trailer' ||
 		$self->_do_parse_error($file, $NR,
 				       __g( "found trailer where expected %s",
 					    $expect ), "$_");
-	    if ($3 ne '  ') {
+	    if ($+{sep} ne '  ') {
 		$self->_do_parse_error($file, $NR,
 				       __g( "badly formatted trailer line" ),
 				       "$_");
 	    }
 	    $entry->{'Trailer'} = $_;
-	    $entry->{'Maintainer'} = "$1 <$2>" unless $entry->{'Maintainer'};
+	    $entry->{'Maintainer'} = "$+{name} <$+{email}>" unless $entry->{'Maintainer'};
 	    unless($entry->{'Date'} && defined $entry->{'Timestamp'}) {
-		$entry->{'Date'} = "$4";
-		$entry->{'Timestamp'} = str2time($4);
+		$entry->{'Date'} = "$+{date}";
+		$entry->{'Timestamp'} = str2time($+{date});
 		unless (defined $entry->{'Timestamp'}) {
 		    $self->_do_parse_error( $file, $NR,
 					    __g( "couldn't parse date %s",
-						 "$4" ) );
+						 "$+{date}" ) );
 		}
 	    }
 	    $expect = 'next heading or eof';
diff --git a/lib/Parse/DebianChangelog/ChangesFilters.pm b/lib/Parse/DebianChangelog/ChangesFilters.pm
index e31a76a..d60e2c9 100644
--- a/lib/Parse/DebianChangelog/ChangesFilters.pm
+++ b/lib/Parse/DebianChangelog/ChangesFilters.pm
@@ -76,8 +76,8 @@ sub http_ftp_urls {
     $text=~ s|(<)?\K(https?:[\w/\.:\@+\-~\%\#?=&;,]+[\w/])(?(1)(?=>))
 	|$cgi->a({ -href=>$2 }, $2)
 	|xego;
-    $text=~ s|ftp:[\w/\.:\@+\-~\%\#?=&;,]+[\w/]
-	|$cgi->a({ -href=>$& }, $&)
+    $text=~ s|(ftp:[\w/\.:\@+\-~\%\#?=&;,]+[\w/])
+	|$cgi->a({ -href=>$1 }, $1)
 	|xego;
 
     return $text;
@@ -86,8 +86,8 @@ sub http_ftp_urls {
 sub email_to_ddpo {
     my ($text, $cgi) = @_;
 
-    $text =~ s|[a-zA-Z0-9_\+\-\.]+\@([a-zA-Z0-9][\w\.+\-]+\.[a-zA-Z]{2,})
-	|$cgi->a({ -href=>"http://qa.debian.org/developer.php?login=$&" }, $&)
+    $text =~ s|([a-zA-Z0-9_\+\-\.]+\@(?:[a-zA-Z0-9][\w\.+\-]+\.[a-zA-Z]{2,}))
+	|$cgi->a({ -href=>"http://qa.debian.org/developer.php?login=$1" }, $1)
 	|xego;
     return $text;
 }
@@ -104,8 +104,8 @@ sub bugs_to_bts {
 sub cve_to_mitre {
     my ($text, $cgi) = @_;
 
-    $text =~ s!\b(?:CVE|CAN)-\d{4}-\d{4}\b
-        !$cgi->a({ -href=>"http://cve.mitre.org/cgi-bin/cvename.cgi?name=$&" }, $&)
+    $text =~ s!\b((?:CVE|CAN)-\d{4}-\d{4})\b
+        !$cgi->a({ -href=>"http://cve.mitre.org/cgi-bin/cvename.cgi?name=$1" }, $1)
 	!xego;
     return $text;
 }
@@ -146,11 +146,11 @@ sub common_licenses {
 	;($2 && $2 < 3) ? $cgi->a({ -href=>"$fsf_old_lics/fdl-1.$2.html" }, $1)
                         : $cgi->a({ -href=>"$fsf_lics/fdl.html" }, $1)
 	;xego;
-    $text=~ s|/usr/share/common-licenses/Artistic
-	|$cgi->a({ -href=>"http://www.opensource.org/licenses/artistic-license.php" }, $&)
+    $text=~ s|(/usr/share/common-licenses/Artistic)
+	|$cgi->a({ -href=>"http://www.opensource.org/licenses/artistic-license.php" }, $1)
 	|xego;
-    $text=~ s|/usr/share/common-licenses/BSD
-	|$cgi->a({ -href=>"http://www.debian.org/misc/bsd.license" }, $&)
+    $text=~ s|(/usr/share/common-licenses/BSD)
+	|$cgi->a({ -href=>"http://www.debian.org/misc/bsd.license" }, $1)
 	|xego;
 
     return $text;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libparse-debianchangelog-perl.git



More information about the Pkg-perl-cvs-commits mailing list