r47872 - in /trunk/libparse-debcontrol-perl/debian: changelog patches/strict_parse.diff patches/strict_parse_comments.diff
azatoth-guest at users.alioth.debian.org
azatoth-guest at users.alioth.debian.org
Sat Nov 28 17:25:34 UTC 2009
Author: azatoth-guest
Date: Sat Nov 28 17:25:24 2009
New Revision: 47872
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=47872
Log:
changed to _dowarn sub to using Error instead so we actually can use
strict in production code
Removed:
trunk/libparse-debcontrol-perl/debian/patches/strict_parse_comments.diff
Modified:
trunk/libparse-debcontrol-perl/debian/changelog
trunk/libparse-debcontrol-perl/debian/patches/strict_parse.diff
Modified: trunk/libparse-debcontrol-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-debcontrol-perl/debian/changelog?rev=47872&op=diff
==============================================================================
--- trunk/libparse-debcontrol-perl/debian/changelog (original)
+++ trunk/libparse-debcontrol-perl/debian/changelog Sat Nov 28 17:25:24 2009
@@ -11,8 +11,10 @@
* remove cdbs usage in favor of debhelper 7
* added patch for strict parsing for REAL debian control files
(Closes: #535958)
+ * changed to _dowarn sub to using Error instead so we actually can use
+ strict in production code
- -- Carl Fürstenberg <carl at excito.com> Sat, 28 Nov 2009 03:33:33 +0100
+ -- Carl Fürstenberg <carl at excito.com> Sat, 28 Nov 2009 18:24:11 +0100
libparse-debcontrol-perl (2.005-2) unstable; urgency=low
Modified: trunk/libparse-debcontrol-perl/debian/patches/strict_parse.diff
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-debcontrol-perl/debian/patches/strict_parse.diff?rev=47872&op=diff
==============================================================================
--- trunk/libparse-debcontrol-perl/debian/patches/strict_parse.diff (original)
+++ trunk/libparse-debcontrol-perl/debian/patches/strict_parse.diff Sat Nov 28 17:25:24 2009
@@ -1,8 +1,253 @@
Index: libparse-debcontrol-perl/lib/Parse/DebControl.pm
===================================================================
---- libparse-debcontrol-perl.orig/lib/Parse/DebControl.pm 2009-11-28 03:32:51.000000000 +0100
-+++ libparse-debcontrol-perl/lib/Parse/DebControl.pm 2009-11-28 03:32:49.000000000 +0100
-@@ -273,12 +273,16 @@
+--- libparse-debcontrol-perl.orig/lib/Parse/DebControl.pm 2009-11-28 18:20:31.000000000 +0100
++++ libparse-debcontrol-perl/lib/Parse/DebControl.pm 2009-11-28 18:20:49.000000000 +0100
+@@ -13,10 +13,111 @@
+ use IO::Scalar;
+ use Compress::Zlib;
+ use LWP::UserAgent;
++use Error;
+
+ use vars qw($VERSION);
+ $VERSION = '2.005';
+
++# in strict mode following fields may not have linebreaks
++my $strict_single_line_fields = {
++ 'debian/control' => {
++ 'source' => 1,
++ 'maintainer' => 1,
++ 'section' => 1,
++ 'priority' => 1,
++ 'package' => 1,
++ 'architecture' => 1,
++ 'essential' => 1,
++ 'standards-version' => 1,
++ 'homepage' => 1,
++ },
++ 'DEBIAN/control' => {
++ 'source' => 1,
++ 'maintainer' => 1,
++ 'changed-by' => 1,
++ 'section' => 1,
++ 'priority' => 1,
++ 'package' => 1,
++ 'architecture' => 1,
++ 'essential' => 1,
++ 'version' => 1,
++ 'installed-size' => 1,
++ 'homepage' => 1,
++ },
++ '.dsc' => {
++ 'format' => 1,
++ 'date' => 1,
++ 'source' => 1,
++ 'version' => 1,
++ 'maintainer' => 1,
++ 'architecture' => 1,
++ 'standards-version' => 1,
++ 'homepage' => 1,
++ },
++ '.changes' => {
++ 'format' => 1,
++ 'date' => 1,
++ 'source' => 1,
++ 'architecture' => 1,
++ 'version' => 1,
++ 'distribution' => 1,
++ 'urgency' => 1,
++ 'maintainer' => 1,
++ 'changed-by' => 1,
++ 'closes' => 1,
++ }
++};
++
++# TODO fill in more rules
++my $strict_rules = {
++ 'debian/control' => {
++ 'source' => qr'^\s*\w+\s*$'o,
++ 'maintainer' => qr''o,
++ 'section' => qr''o,
++ 'priority' => qr''o,
++ 'package' => qr''o,
++ 'architecture' => qr''o,
++ 'essential' => qr''o,
++ 'standards-version' => qr''o,
++ 'homepage' => qr''o,
++ },
++ 'DEBIAN/control' => {
++ 'source' => qr'^\s*\w+\s*(?:\(.*\))?$'o,
++ 'maintainer' => qr''o,
++ 'changed-by' => qr''o,
++ 'section' => qr''o,
++ 'priority' => qr''o,
++ 'package' => qr''o,
++ 'architecture' => qr''o,
++ 'essential' => qr''o,
++ 'version' => qr''o,
++ 'installed-size' => qr''o,
++ 'homepage' => qr''o,
++ },
++ '.dsc' => {
++ 'source' => qr'^\s*\w+\s*$'o,
++ 'format' => qr''o,
++ 'date' => qr''o,
++ 'version' => qr''o,
++ 'maintainer' => qr''o,
++ 'architecture' => qr''o,
++ 'standards-version' => qr''o,
++ 'homepage' => qr''o,
++ },
++ '.changes' => {
++ 'source' => qr'^\s*\w+\s*(?:\(.*\))?$'o,
++ 'format' => qr''o,
++ 'date' => qr''o,
++ 'architecture' => qr''o,
++ 'version' => qr''o,
++ 'distribution' => qr''o,
++ 'urgency' => qr''o,
++ 'maintainer' => qr''o,
++ 'changed-by' => qr''o,
++ 'closes' => qr''o,
++ }
++};
++
+ sub new {
+ my ($class, $debug) = @_;
+ my $this = {};
+@@ -33,15 +134,13 @@
+ my ($this, $filename, $options) = @_;
+ unless($filename)
+ {
+- $this->_dowarn("parse_file failed because no filename parameter was given");
+- return;
++ throw Error::Simple("parse_file failed because no filename parameter was given");
+ }
+
+ my $fh;
+ unless(open($fh,"$filename"))
+ {
+- $this->_dowarn("parse_file failed because $filename could not be opened for reading");
+- return;
++ throw Error::Simple("parse_file failed because $filename could not be opened for reading");
+ }
+
+ return $this->_parseDataHandle($fh, $options);
+@@ -52,16 +151,14 @@
+
+ unless($data)
+ {
+- $this->_dowarn("parse_mem failed because no data was given");
+- return;
++ throw Error::Simple("parse_mem failed because no data was given");
+ }
+
+ my $IOS = new IO::Scalar \$data;
+
+ unless($IOS)
+ {
+- $this->_dowarn("parse_mem failed because IO::Scalar creation failed.");
+- return;
++ throw Error::Simple("parse_mem failed because IO::Scalar creation failed.");
+ }
+
+ return $this->_parseDataHandle($IOS, $options);
+@@ -73,8 +170,7 @@
+
+ unless($url)
+ {
+- $this->_dowarn("No url given, thus no data to parse");
+- return;
++ throw Error::Simple("No url given, thus no data to parse");
+ }
+
+ my $ua = LWP::UserAgent->new;
+@@ -83,8 +179,7 @@
+
+ unless($request)
+ {
+- $this->_dowarn("Failed to instantiate HTTP Request object");
+- return;
++ throw Error::Simple("Failed to instantiate HTTP Request object");
+ }
+
+ my $response = $ua->request($request);
+@@ -92,8 +187,7 @@
+ if ($response->is_success) {
+ return $this->parse_mem($response->content(), $options);
+ } else {
+- $this->_dowarn("Failed to fetch $url from the web");
+- return;
++ throw Error::Simple("Failed to fetch $url from the web");
+ }
+ }
+
+@@ -102,22 +196,19 @@
+
+ unless($filenameorhandle)
+ {
+- $this->_dowarn("write_file failed because no filename or filehandle was given");
+- return;
++ throw Error::Simple("write_file failed because no filename or filehandle was given");
+ }
+
+ unless($dataorarrayref)
+ {
+- $this->_dowarn("write_file failed because no data was given");
+- return;
++ throw Error::Simple("write_file failed because no data was given");
+ }
+
+ my $handle = $this->_getValidHandle($filenameorhandle, $options);
+
+ unless($handle)
+ {
+- $this->_dowarn("write_file failed because we couldn't negotiate a valid handle");
+- return;
++ throw Error::Simple("write_file failed because we couldn't negotiate a valid handle");
+ }
+
+ my $string = $this->write_mem($dataorarrayref, $options);
+@@ -134,8 +225,7 @@
+
+ unless($dataorarrayref)
+ {
+- $this->_dowarn("write_mem failed because no data was given");
+- return;
++ throw Error::Simple("write_mem failed because no data was given");
+ }
+
+ my $arrayref = $this->_makeArrayref($dataorarrayref);
+@@ -165,8 +255,7 @@
+ {
+ unless($filenameorhandle->opened())
+ {
+- $this->_dowarn("Can't get a valid filehandle to write to, because that is closed");
+- return;
++ throw Error::Simple("Can't get a valid filehandle to write to, because that is closed");
+ }
+
+ return $filenameorhandle;
+@@ -180,8 +269,7 @@
+
+ unless(open $handle,"$openmode$filenameorhandle")
+ {
+- $this->_dowarn("Couldn't open file: $openmode$filenameorhandle for writing");
+- return;
++ throw Error::Simple("Couldn't open file: $openmode$filenameorhandle for writing");
+ }
+
+ return $handle;
+@@ -248,8 +336,7 @@
+
+ unless($handle)
+ {
+- $this->_dowarn("_parseDataHandle failed because no handle was given. This is likely a bug in the module");
+- return;
++ throw Error::Simple("_parseDataHandle failed because no handle was given. This is likely a bug in the module");
+ }
+
+ if($options->{tryGzip})
+@@ -273,12 +360,16 @@
chomp $line;
@@ -25,7 +270,13 @@
$linenum++;
if($line =~ /^[^\t\s]/)
-@@ -314,14 +318,69 @@
+@@ -309,19 +400,27 @@
+
+ $lastfield = $key;
+ }else{
+- $this->_dowarn("Parse error on line $linenum of data; invalid key/value stanza");
+- return $structs;
++ throw Error::Simple("Parse error on line $linenum of data; invalid key/value stanza");
}
}elsif($line =~ /^([\t\s])(.*)/)
@@ -36,61 +287,15 @@
+
+ unless($lastfield)
+ {
-+ $this->_dowarn("Parse error on line $linenum of data; indented entry without previous line");
-+ return $structs;
++ throw Error::Simple("Parse error on line $linenum of data; indented entry without previous line");
+ }
+ if( $options->{strict} ) {
-+ my $key = $lastfield;
+ if(
-+ $options->{type} eq 'debian/control' && (
-+ $key eq 'source'
-+ || $key eq 'maintainer'
-+ || $key eq 'section'
-+ || $key eq 'priority'
-+ || $key eq 'package'
-+ || $key eq 'architecture'
-+ || $key eq 'essential'
-+ || $key eq 'standards-version'
-+ || $key eq 'homepage'
-+ )
-+ || $options->{type} eq 'DEBIAN/control' && (
-+ $key eq 'source'
-+ || $key eq 'maintainer'
-+ || $key eq 'changed-by'
-+ || $key eq 'section'
-+ || $key eq 'priority'
-+ || $key eq 'package'
-+ || $key eq 'architecture'
-+ || $key eq 'essential'
-+ || $key eq 'version'
-+ || $key eq 'installed-size'
-+ || $key eq 'homepage'
-+ )
-+ || $options->{type} eq '.dsc' && (
-+ $key eq 'format'
-+ || $key eq 'date'
-+ || $key eq 'source'
-+ || $key eq 'version'
-+ || $key eq 'maintainer'
-+ || $key eq 'architecture'
-+ || $key eq 'standards-version'
-+ || $key eq 'homepage'
-+ )
-+ || $options->{type} eq '.changes' && (
-+ $key eq 'format'
-+ || $key eq 'date'
-+ || $key eq 'source'
-+ || $key eq 'architecture'
-+ || $key eq 'version'
-+ || $key eq 'distribution'
-+ || $key eq 'urgency'
-+ || $key eq 'maintainer'
-+ || $key eq 'changed-by'
-+ || $key eq 'closes'
-+ )
++ exists $strict_single_line_fields->{$options->{type}}
++ && exists $strict_single_line_fields->{$options->{type}}->{lc $lastfield}
++ && $strict_single_line_fields->{$options->{type}}->{lc $lastfield} == 1
+ ) {
-+ $this->_dowarn("Parse error on line $linenum of data; field $lastfield for type $options->{type} may not span multiple lines");
-+ return $structs;
++ throw Error::Simple("Parse error on line $linenum of data; field $lastfield for type $options->{type} may not span multiple lines");
+ }
+ }
@@ -102,7 +307,81 @@
if($options->{verbMultiLine}){
$data->{$lastfield}.="\n$1$2";
}elsif($2 eq "." ){
-@@ -501,6 +560,17 @@
+@@ -332,20 +431,29 @@
+ $data->{$lastfield}.="\n$val";
+ }
+
+- }elsif($line =~ /^[\s\t]*$/){
+- if ($options->{verbMultiLine}
+- && ($data->{$lastfield} =~ /\n/o)) {
+- $data->{$lastfield} .= "\n";
+- }
+- if(keys %$data > 0){
+- push @$structs, $data;
+- }
+- $data = $this->_getReadyHash($options);
+- $lastfield = "";
+- }else{
+- $this->_dowarn("Parse error on line $linenum of data; unidentified line structure");
+- return $structs;
+- }
++ }elsif($line =~ /^[\s\t]*$/){
++ if ($options->{verbMultiLine}
++ && ($data->{$lastfield} =~ /\n/o)) {
++ $data->{$lastfield} .= "\n";
++ }
++ if( $options->{strict} ) {
++ if(
++ exists $strict_rules->{$options->{type}}
++ && exists $strict_rules->{$options->{type}}->{lc $lastfield}
++ && $data->{$lastfield} !~ $strict_rules->{$options->{type}}->{lc $lastfield}
++ ) {
++ throw Error::Simple("Parse error on line $linenum of data; field $lastfield for type $options->{type} doesn't match rule");
++ }
++
++ }
++ if(keys %$data > 0){
++ push @$structs, $data;
++ }
++ $data = $this->_getReadyHash($options);
++ $lastfield = "";
++ }else{
++ throw Error::Simple("Parse error on line $linenum of data; unidentified line structure");
++ }
+
+ }
+
+@@ -379,8 +487,7 @@
+ eval("use Tie::IxHash");
+ if($@)
+ {
+- $this->_dowarn("Can't use Tie::IxHash. You need to install it to have this functionality");
+- return;
++ throw Error::Simple("Can't use Tie::IxHash. You need to install it to have this functionality");
+ }
+ tie(%$data, "Tie::IxHash");
+ return $data;
+@@ -389,19 +496,6 @@
+ return {};
+ }
+
+-sub _dowarn
+-{
+- my ($this, $warning) = @_;
+-
+- if($this->{_verbose})
+- {
+- warn "DEBUG: $warning";
+- }
+-
+- return;
+-}
+-
+-
+ 1;
+
+ __END__
+@@ -501,6 +595,17 @@
it is off by default so we don't have to scrub over all the text for
performance reasons.
@@ -120,3 +399,113 @@
=back
=over 4
+Index: libparse-debcontrol-perl/t/34strict.t
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ libparse-debcontrol-perl/t/34strict.t 2009-11-28 18:20:49.000000000 +0100
+@@ -0,0 +1,47 @@
++#
++#===============================================================================
++#
++# FILE: 34strict.t
++#
++# DESCRIPTION:
++#
++# FILES: ---
++# BUGS: ---
++# NOTES: ---
++# AUTHOR: (), <>
++# COMPANY:
++# VERSION: 1.0
++# CREATED: 2009-11-28 17.38.03 CET
++# REVISION: ---
++#===============================================================================
++
++use strict;
++use warnings;
++
++use Test::More tests => 4; # last test to print
++use Test::Exception;
++
++BEGIN {
++ chdir 't' if -d 't';
++ use lib '../blib/lib', 'lib/', '..';
++}
++
++
++my $mod = "Parse::DebControl";
++my $pdc;
++my $data;
++
++#Object initialization - 2 tests
++
++use_ok($mod);
++ok($pdc = new Parse::DebControl(), "Parser object creation works fine");
++
++$pdc = new Parse::DebControl(1);
++
++ok($data = $pdc->parse_mem("Source: foo\n#This is a comment\nPackage: bar\#another comment\n#thid comment\nPriority: required", {strict => 1, type => 'debian/control'}), "Comments parse out correctly");
++throws_ok {
++ $pdc->parse_mem(
++ "Source: foo\n#This is a comment\nPackage: bar\#another comment\n#thid comment\nPriority: required",
++ {strict => 1, type => 'DEBIAN/control'}
++ )
++} 'Error::Simple', "Error thrown";
+Index: libparse-debcontrol-perl/t/30parse.t
+===================================================================
+--- libparse-debcontrol-perl.orig/t/30parse.t 2009-11-28 18:20:31.000000000 +0100
++++ libparse-debcontrol-perl/t/30parse.t 2009-11-28 18:20:49.000000000 +0100
+@@ -1,6 +1,7 @@
+ #!/usr/bin/perl -w
+
+ use Test::More tests => 62;
++use Test::Exception;
+
+ BEGIN {
+ chdir 't' if -d 't';
+@@ -17,8 +18,8 @@
+
+ #Object default failure - 2 tests
+
+- ok(!$pdc->parse_mem(), "Parser should fail if not given a name");
+- ok(!$pdc->parse_file(), "Parser should fail if not given a filename");
++ throws_ok { $pdc->parse_mem() } 'Error::Simple', "Parser should fail if not given a name";
++ throws_ok { $pdc->parse_file() } 'Error::Simple', "Parser should fail if not given a filename";
+
+ #Single item (no ending newline) parsing - 8 tests
+
+Index: libparse-debcontrol-perl/t/40write.t
+===================================================================
+--- libparse-debcontrol-perl.orig/t/40write.t 2009-11-28 18:20:31.000000000 +0100
++++ libparse-debcontrol-perl/t/40write.t 2009-11-28 18:23:45.000000000 +0100
+@@ -1,7 +1,8 @@
+ #!/usr/bin/perl -w
+
+ use strict;
+-use Test::More tests => 14;
++use Test::More tests => 13;
++use Test::Exception;
+
+ my $warning ="";
+
+@@ -18,9 +19,9 @@
+ my $writer;
+
+ ok($writer = new Parse::DebControl);
+-ok(!$writer->write_mem(), "write_mem should fail without data");
+-ok(!$writer->write_file(), "write_file should fail without a filename or handle");
+-ok(!$writer->write_file('/fake/file'), "write_file should fail without data");
++throws_ok { $writer->write_mem() } 'Error::Simple', "write_mem should fail without data";
++throws_ok { $writer->write_file() } 'Error::Simple', "write_file should fail without a filename or handle";
++throws_ok { $writer->write_file('/fake/file') } 'Error::Simple', "write_file should fail without data";
+
+ ok($writer->write_mem({'foo' => 'bar'}) eq "foo: bar\n", "write_* should translate simple items correctly");
+
+@@ -54,7 +55,3 @@
+
+ $mem = $writer->write_mem([]);
+ ok($warnings eq "", "Writing blank arrayrefs doesn't throw warnings"); #Version 1.9 fix
+-
+-$mem = $writer->write_mem();
+-ok($warnings eq "", "Writing blank arrayrefs doesn't throw warnings"); #Version 1.9 fix
+-
More information about the Pkg-perl-cvs-commits
mailing list