r47973 - in /trunk/libparse-debcontrol-perl: debian/patches/strict_parse.diff lib/Parse/DebControl.pm t/30parse.t t/40write.t
azatoth-guest at users.alioth.debian.org
azatoth-guest at users.alioth.debian.org
Mon Nov 30 19:43:59 UTC 2009
Author: azatoth-guest
Date: Mon Nov 30 19:43:54 2009
New Revision: 47973
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=47973
Log:
added more testes fort the DEP3 parser module
Modified:
trunk/libparse-debcontrol-perl/debian/patches/strict_parse.diff
trunk/libparse-debcontrol-perl/lib/Parse/DebControl.pm
trunk/libparse-debcontrol-perl/t/30parse.t
trunk/libparse-debcontrol-perl/t/40write.t
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=47973&op=diff
==============================================================================
--- trunk/libparse-debcontrol-perl/debian/patches/strict_parse.diff (original)
+++ trunk/libparse-debcontrol-perl/debian/patches/strict_parse.diff Mon Nov 30 19:43:54 2009
@@ -1,7 +1,7 @@
Index: libparse-debcontrol-perl/lib/Parse/DebControl.pm
===================================================================
---- libparse-debcontrol-perl.orig/lib/Parse/DebControl.pm 2009-11-29 19:21:59.000000000 +0100
-+++ libparse-debcontrol-perl/lib/Parse/DebControl.pm 2009-11-29 19:22:09.000000000 +0100
+--- libparse-debcontrol-perl.orig/lib/Parse/DebControl.pm 2009-11-29 19:50:57.000000000 +0100
++++ libparse-debcontrol-perl/lib/Parse/DebControl.pm 2009-11-30 19:45:04.000000000 +0100
@@ -13,10 +13,111 @@
use IO::Scalar;
use Compress::Zlib;
@@ -402,7 +402,7 @@
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-29 19:22:09.000000000 +0100
++++ libparse-debcontrol-perl/t/34strict.t 2009-11-30 19:45:05.000000000 +0100
@@ -0,0 +1,47 @@
+#
+#===============================================================================
@@ -453,8 +453,8 @@
+} 'Parse::DebControl::Error::Parse', "Error thrown";
Index: libparse-debcontrol-perl/t/30parse.t
===================================================================
---- libparse-debcontrol-perl.orig/t/30parse.t 2009-11-29 19:21:59.000000000 +0100
-+++ libparse-debcontrol-perl/t/30parse.t 2009-11-29 19:22:09.000000000 +0100
+--- libparse-debcontrol-perl.orig/t/30parse.t 2009-11-29 19:50:57.000000000 +0100
++++ libparse-debcontrol-perl/t/30parse.t 2009-11-30 19:45:05.000000000 +0100
@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
@@ -476,8 +476,8 @@
Index: libparse-debcontrol-perl/t/40write.t
===================================================================
---- libparse-debcontrol-perl.orig/t/40write.t 2009-11-29 19:21:59.000000000 +0100
-+++ libparse-debcontrol-perl/t/40write.t 2009-11-29 19:22:09.000000000 +0100
+--- libparse-debcontrol-perl.orig/t/40write.t 2009-11-29 19:50:57.000000000 +0100
++++ libparse-debcontrol-perl/t/40write.t 2009-11-30 19:45:05.000000000 +0100
@@ -1,7 +1,8 @@
#!/usr/bin/perl -w
@@ -512,7 +512,7 @@
Index: libparse-debcontrol-perl/lib/Parse/DebControl/Error.pm
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ libparse-debcontrol-perl/lib/Parse/DebControl/Error.pm 2009-11-29 19:22:09.000000000 +0100
++++ libparse-debcontrol-perl/lib/Parse/DebControl/Error.pm 2009-11-30 19:45:05.000000000 +0100
@@ -0,0 +1,75 @@
+use strict;
+use warnings;
@@ -592,7 +592,7 @@
Index: libparse-debcontrol-perl/lib/Parse/DebControl/Patch.pm
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ libparse-debcontrol-perl/lib/Parse/DebControl/Patch.pm 2009-11-29 19:46:09.000000000 +0100
++++ libparse-debcontrol-perl/lib/Parse/DebControl/Patch.pm 2009-11-30 19:45:05.000000000 +0100
@@ -0,0 +1,135 @@
+package Parse::DebControl::Patch;
+use strict;
@@ -732,8 +732,8 @@
Index: libparse-debcontrol-perl/t/35patch.t
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ libparse-debcontrol-perl/t/35patch.t 2009-11-29 19:30:27.000000000 +0100
-@@ -0,0 +1,44 @@
++++ libparse-debcontrol-perl/t/35patch.t 2009-11-30 20:15:08.000000000 +0100
+@@ -0,0 +1,89 @@
+#
+#===============================================================================
+#
@@ -754,7 +754,7 @@
+use strict;
+use warnings;
+
-+use Test::More tests => 3; # last test to print
++use Test::More tests => 20; # last test to print
+use Test::Exception;
+
+BEGIN {
@@ -762,6 +762,14 @@
+ use lib '../blib/lib', 'lib/', '..';
+}
+
++sub declared ($) {
++ use constant 1.01; # don't omit this!
++ my $name = shift;
++ $name =~ s/^::/main::/;
++ my $pkg = caller;
++ my $full_name = $name =~ /::/ ? $name : "${pkg}::$name";
++ $constant::declared{$full_name};
++}
+
+my $mod = "Parse::DebControl::Patch";
+my $pdc;
@@ -774,14 +782,51 @@
+
+$pdc = new Parse::DebControl::Patch(1);
+
++#Parse file - 1 test
+ok($data = $pdc->parse_file( 'testfiles/patch1.diff' ), "Parsed patch ok");
-+use Data::Dumper;
-+print Dumper( $data );
-+
++
++# Check From - 3 tests
++ok( exists $data->{From}->[0], "Exists first From field");
++is( $data->{From}->[0], "Ulrich Drepper <drepper\@redhat.com>", "Single From field");
++ok( ! exists $data->{From}->[1], "No second From field");
++
++# Check Subject - 5 tests
++ok( exists $data->{Subject}->[0], "Exists first Subject field");
++ok( exists $data->{Subject}->[1], "Exists second Subject field");
++is( $data->{Subject}->[0], "Fix regex problems with some multi-bytes characters", "First paragraph of Subject");
++is( $data->{Subject}->[1],
++ "* posix/bug-regex17.c: Add testcases.\n".
++ "* posix/regcomp.c (re_compile_fastmap_iter): Rewrite COMPLEX_BRACKET\n".
++ " handling.", "Second paragraph of Subject"
++);
++ok( ! exists $data->{Subject}->[2], "No third Subject field");
++
++# Check Origin - 3 tests
++ok( exists $data->{Origin}->[0], "Exists first Origin field");
++is( $data->{Origin}->[0], "upstream, http://sourceware.org/git/?p=glibc.git;a=commitdiff;h=bdb56bac", "Single Origin address");
++ok( ! exists $data->{Origin}->[1], "No second Origin field");
++
++# Check Bug - 3 tests
++ok( exists $data->{Bug}->[0], "Exists first Bug field");
++is( $data->{Bug}->[0], "http://sourceware.org/bugzilla/show_bug.cgi?id=9697", "Single Bug field");
++ok( ! exists $data->{Bug}->[1], "No second Bug field");
++
++# Check Bug-Debian - 3 tests
++ok( exists $data->{"Bug-Debian"}->[0], "Exists first Bug-Debian field");
++is( $data->{"Bug-Debian"}->[0], "http://bugs.debian.org/510219", "Single Bug-Debian field");
++ok( ! exists $data->{"Bug-Debian"}->[1], "No second Bug-Debian field");
++
++# Check if the Forwarded field is set and is set to true - 2 tests
++# Test file doesn't include a forwared field, so it should default to true
++ok( declared( 'Parse::DebControl::Patch::Forwared_Yes' ) );
++ok( declared( 'Parse::DebControl::Patch::Forwared_No' ) );
++ok( declared( 'Parse::DebControl::Patch::Forwared_Not_Needed' ) );
++ok( exists $data->{Forwarded}, "Exists Forwared field");
++is( $data->{Forwared}, Parse::DebControl::Patch::Forwared_Yes, "Forwared is set to \"yes\"");
Index: libparse-debcontrol-perl/t/testfiles/patch1.diff
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ libparse-debcontrol-perl/t/testfiles/patch1.diff 2009-11-29 19:27:00.000000000 +0100
++++ libparse-debcontrol-perl/t/testfiles/patch1.diff 2009-11-30 19:45:05.000000000 +0100
@@ -0,0 +1,27 @@
+From: Ulrich Drepper <drepper at redhat.com>
+Subject: Fix regex problems with some multi-bytes characters
Modified: trunk/libparse-debcontrol-perl/lib/Parse/DebControl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-debcontrol-perl/lib/Parse/DebControl.pm?rev=47973&op=diff
==============================================================================
--- trunk/libparse-debcontrol-perl/lib/Parse/DebControl.pm (original)
+++ trunk/libparse-debcontrol-perl/lib/Parse/DebControl.pm Mon Nov 30 19:43:54 2009
@@ -13,9 +13,110 @@
use IO::Scalar;
use Compress::Zlib;
use LWP::UserAgent;
+use Parse::DebControl::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) = @_;
@@ -33,15 +134,13 @@
my ($this, $filename, $options) = @_;
unless($filename)
{
- $this->_dowarn("parse_file failed because no filename parameter was given");
- return;
+ throw Parse::DebControl::Error::IO("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 Parse::DebControl::Error::IO("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 Parse::DebControl::Error::IO("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 Parse::DebControl::Error::IO("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 Parse::DebControl::Error::IO("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 Parse::DebControl::Error::IO("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 Parse::DebControl::Error::IO("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 Parse::DebControl::Error::IO("write_file failed because no filename or filehandle was given");
}
unless($dataorarrayref)
{
- $this->_dowarn("write_file failed because no data was given");
- return;
+ throw Parse::DebControl::Error::IO("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 Parse::DebControl::Error::IO("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 Parse::DebControl::Error::IO("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 Parse::DebControl::Error::IO("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 Parse::DebControl::Error::IO("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 Parse::DebControl::Error("_parseDataHandle failed because no handle was given. This is likely a bug in the module");
}
if($options->{tryGzip})
@@ -273,12 +360,16 @@
chomp $line;
- if($options->{stripComments}){
- next if $line =~ /^\s*\#[^\#]/;
- $line =~ s/\#$//;
- $line =~ s/(?<=[^\#])\#[^\#].*//;
- $line =~ s/\#\#/\#/;
- }
+ if( $options->{strict} ) {
+ if ( $options->{type} eq 'debian/control' ) {
+ next if $line =~ /^\#/;
+ }
+ } elsif( $options->{stripComments} ){
+ next if $line =~ /^\s*\#[^\#]/;
+ $line =~ s/\#$//;
+ $line =~ s/(?<=[^\#])\#[^\#].*//;
+ $line =~ s/\#\#/\#/;
+ }
$linenum++;
if($line =~ /^[^\t\s]/)
@@ -309,19 +400,27 @@
$lastfield = $key;
}else{
- $this->_dowarn("Parse error on line $linenum of data; invalid key/value stanza");
- return $structs;
+ throw Parse::DebControl::Error::Parse('invalid key/value stansa', $linenum, $line);
}
}elsif($line =~ /^([\t\s])(.*)/)
- {
- #appends to previous line
-
- unless($lastfield)
- {
- $this->_dowarn("Parse error on line $linenum of data; indented entry without previous line");
- return $structs;
- }
+ {
+ #appends to previous line
+
+ unless($lastfield)
+ {
+ throw Parse::DebControl::Error::Parse('indented entry without previous line', $linenum, $line);
+ }
+ if( $options->{strict} ) {
+ if(
+ 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
+ ) {
+ throw Parse::DebControl::Error::Parse("field $lastfield for type $options->{type} may not span multiple lines", $linenum);
+ }
+ }
+
if($options->{verbMultiLine}){
$data->{$lastfield}.="\n$1$2";
}elsif($2 eq "." ){
@@ -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 Parse::DebControl::Error::Parse("field $lastfield for type $options->{type} doesn't match rule", $linenum);
+ }
+
+ }
+ if(keys %$data > 0){
+ push @$structs, $data;
+ }
+ $data = $this->_getReadyHash($options);
+ $lastfield = "";
+ }else{
+ throw Parse::DebControl::Error::Parse("unidentified line structure", $linenum, $line);
+ }
}
@@ -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 Parse::DebControl::Error("Can't use Tie::IxHash. You need to install it to have this functionality");
}
tie(%$data, "Tie::IxHash");
return $data;
@@ -388,19 +495,6 @@
return {};
}
-
-sub _dowarn
-{
- my ($this, $warning) = @_;
-
- if($this->{_verbose})
- {
- warn "DEBUG: $warning";
- }
-
- return;
-}
-
1;
@@ -501,6 +595,17 @@
it is off by default so we don't have to scrub over all the text for
performance reasons.
+ strict - Tries to parse obeying the strict rules for real debian control files.
+ This will force comment stripping for debian/control (must start line) and for
+ other files will check if a field may span multiple lines.
+
+ type - If the strict option is choosen, then this parameter defines what format
+ we have. Available formats is:
+ - debian/control
+ - DEBIAN/control
+ - .dsc
+ - .changes
+
=back
=over 4
Modified: trunk/libparse-debcontrol-perl/t/30parse.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-debcontrol-perl/t/30parse.t?rev=47973&op=diff
==============================================================================
--- trunk/libparse-debcontrol-perl/t/30parse.t (original)
+++ trunk/libparse-debcontrol-perl/t/30parse.t Mon Nov 30 19:43:54 2009
@@ -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() } 'Parse::DebControl::Error::IO', "Parser should fail if not given a name";
+ throws_ok { $pdc->parse_file() } 'Parse::DebControl::Error::IO', "Parser should fail if not given a filename";
#Single item (no ending newline) parsing - 8 tests
Modified: trunk/libparse-debcontrol-perl/t/40write.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-debcontrol-perl/t/40write.t?rev=47973&op=diff
==============================================================================
--- trunk/libparse-debcontrol-perl/t/40write.t (original)
+++ trunk/libparse-debcontrol-perl/t/40write.t Mon Nov 30 19:43:54 2009
@@ -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() } 'Parse::DebControl::Error::IO', "write_mem should fail without data";
+throws_ok { $writer->write_file() } 'Parse::DebControl::Error::IO', "write_file should fail without a filename or handle";
+throws_ok { $writer->write_file('/fake/file') } 'Parse::DebControl::Error::IO', "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