r47979 - 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 20:07:28 UTC 2009
Author: azatoth-guest
Date: Mon Nov 30 20:07:20 2009
New Revision: 47979
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=47979
Log:
fucking the repo up :(
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=47979&op=diff
==============================================================================
--- trunk/libparse-debcontrol-perl/debian/patches/strict_parse.diff (original)
+++ trunk/libparse-debcontrol-perl/debian/patches/strict_parse.diff Mon Nov 30 20:07:20 2009
@@ -1,7 +1,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-30 19:45:05.000000000 +0100
++++ libparse-debcontrol-perl/t/34strict.t 2009-11-30 20:52:30.000000000 +0100
@@ -0,0 +1,47 @@
+#
+#===============================================================================
@@ -53,7 +53,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-30 19:45:05.000000000 +0100
++++ libparse-debcontrol-perl/lib/Parse/DebControl/Error.pm 2009-11-30 20:52:30.000000000 +0100
@@ -0,0 +1,75 @@
+use strict;
+use warnings;
@@ -133,13 +133,19 @@
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-30 19:45:05.000000000 +0100
-@@ -0,0 +1,135 @@
++++ libparse-debcontrol-perl/lib/Parse/DebControl/Patch.pm 2009-11-30 20:57:00.000000000 +0100
+@@ -0,0 +1,152 @@
+package Parse::DebControl::Patch;
+use strict;
+use warnings;
+
+use base 'Parse::DebControl';
++
++use constant {
++ Forwared_Yes => 1,
++ Forwared_No => 2,
++ Forwared_NotNeeded => 3,
++};
+
+our $VERSION = '0.1';
+
@@ -265,6 +271,17 @@
+ throw Parse::DebControl::Error::Parse('Freeform field found without any Subject or Description fields');
+ }
+ }
++ if( exists $data->{'Forwarded'} ) {
++ if( $data->{'Forwarded'}->[0] eq 'no' ) {
++ $data->{'Forwarded'} = Forwarded_No;
++ } elsif( $data->{'Forwarded'}->[0] eq 'not-needed' ) {
++ $data->{'Forwarded'} = Forwarded_NotNeeded;
++ } else {
++ $data->{'Forwarded'} = Forwarded_Yes;
++ }
++ } else {
++ $data->{'Forwarded'} = Forwarded_Yes;
++ }
+
+ return $data;
+}
@@ -273,7 +290,7 @@
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-30 20:18:59.000000000 +0100
++++ libparse-debcontrol-perl/t/35patch.t 2009-11-30 20:56:47.000000000 +0100
@@ -0,0 +1,93 @@
+#
+#===============================================================================
@@ -364,14 +381,14 @@
+# Test file doesn't include a forwared field, so it should default to true
+ok( declared( 'Parse::DebControl::Patch::Forwared_Yes' )," Parse::DebControl::Patch::Forwared_Yes is defined" );
+ok( declared( 'Parse::DebControl::Patch::Forwared_No' ), "Parse::DebControl::Patch::Forwared_No is defined" );
-+ok( declared( 'Parse::DebControl::Patch::Forwared_Not_Needed' ), "Parse::DebControl::Patch::Forwared_Not_Needed is defined" );
++ok( declared( 'Parse::DebControl::Patch::Forwared_NotNeeded' ), "Parse::DebControl::Patch::Forwared_Not_Needed is defined" );
+ok( exists $data->{Forwarded}, "Exists Forwared field");
+is( ref $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-30 19:45:05.000000000 +0100
++++ libparse-debcontrol-perl/t/testfiles/patch1.diff 2009-11-30 20:52:30.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=47979&op=diff
==============================================================================
--- trunk/libparse-debcontrol-perl/lib/Parse/DebControl.pm (original)
+++ trunk/libparse-debcontrol-perl/lib/Parse/DebControl.pm Mon Nov 30 20:07:20 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=47979&op=diff
==============================================================================
--- trunk/libparse-debcontrol-perl/t/30parse.t (original)
+++ trunk/libparse-debcontrol-perl/t/30parse.t Mon Nov 30 20:07:20 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=47979&op=diff
==============================================================================
--- trunk/libparse-debcontrol-perl/t/40write.t (original)
+++ trunk/libparse-debcontrol-perl/t/40write.t Mon Nov 30 20:07:20 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