r48015 - in /trunk/libparse-debcontrol-perl: debian/patches/strict_parse.diff lib/Parse/DebControl.pm
azatoth-guest at users.alioth.debian.org
azatoth-guest at users.alioth.debian.org
Mon Nov 30 23:59:47 UTC 2009
Author: azatoth-guest
Date: Mon Nov 30 23:59:42 2009
New Revision: 48015
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=48015
Log:
fix the patch again :(
Modified:
trunk/libparse-debcontrol-perl/debian/patches/strict_parse.diff
trunk/libparse-debcontrol-perl/lib/Parse/DebControl.pm
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=48015&op=diff
==============================================================================
--- trunk/libparse-debcontrol-perl/debian/patches/strict_parse.diff (original)
+++ trunk/libparse-debcontrol-perl/debian/patches/strict_parse.diff Mon Nov 30 23:59:42 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 21:07:42.000000000 +0100
++++ libparse-debcontrol-perl/t/34strict.t 2009-12-01 00:59:02.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 21:07:42.000000000 +0100
++++ libparse-debcontrol-perl/lib/Parse/DebControl/Error.pm 2009-12-01 00:59:02.000000000 +0100
@@ -0,0 +1,75 @@
+use strict;
+use warnings;
@@ -133,7 +133,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-30 21:36:16.000000000 +0100
++++ libparse-debcontrol-perl/lib/Parse/DebControl/Patch.pm 2009-12-01 00:59:02.000000000 +0100
@@ -0,0 +1,156 @@
+package Parse::DebControl::Patch;
+use strict;
@@ -294,7 +294,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 21:45:02.000000000 +0100
++++ libparse-debcontrol-perl/t/35patch.t 2009-12-01 00:59:02.000000000 +0100
@@ -0,0 +1,76 @@
+#
+#===============================================================================
@@ -375,7 +375,7 @@
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 21:07:42.000000000 +0100
++++ libparse-debcontrol-perl/t/testfiles/patch1.diff 2009-12-01 00:59:02.000000000 +0100
@@ -0,0 +1,27 @@
+From: Ulrich Drepper <drepper at redhat.com>
+Subject: Fix regex problems with some multi-bytes characters
@@ -404,3 +404,404 @@
+
+ * sysdeps/unix/sysv/linux/s390/bits/libc-vdso.h: New file.
+
+Index: libparse-debcontrol-perl/lib/Parse/DebControl.pm
+===================================================================
+--- libparse-debcontrol-perl.orig/lib/Parse/DebControl.pm 2009-12-01 00:59:12.000000000 +0100
++++ libparse-debcontrol-perl/lib/Parse/DebControl.pm 2009-12-01 00:59:16.000000000 +0100
+@@ -13,10 +13,111 @@
+ 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) = @_;
+ 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 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
++ {
++ #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);
++ }
++ }
+
+- unless($lastfield)
+- {
+- $this->_dowarn("Parse error on line $linenum of data; indented entry without previous line");
+- return $structs;
+- }
+ 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;
+@@ -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.
+
++ 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/lib/Parse/DebControl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-debcontrol-perl/lib/Parse/DebControl.pm?rev=48015&op=diff
==============================================================================
--- trunk/libparse-debcontrol-perl/lib/Parse/DebControl.pm (original)
+++ trunk/libparse-debcontrol-perl/lib/Parse/DebControl.pm Mon Nov 30 23:59:42 2009
@@ -13,110 +13,9 @@
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) = @_;
@@ -134,13 +33,15 @@
my ($this, $filename, $options) = @_;
unless($filename)
{
- throw Parse::DebControl::Error::IO("parse_file failed because no filename parameter was given");
+ $this->_dowarn("parse_file failed because no filename parameter was given");
+ return;
}
my $fh;
unless(open($fh,"$filename"))
{
- throw Parse::DebControl::Error::IO("parse_file failed because $filename could not be opened for reading");
+ $this->_dowarn("parse_file failed because $filename could not be opened for reading");
+ return;
}
return $this->_parseDataHandle($fh, $options);
@@ -151,14 +52,16 @@
unless($data)
{
- throw Parse::DebControl::Error::IO("parse_mem failed because no data was given");
+ $this->_dowarn("parse_mem failed because no data was given");
+ return;
}
my $IOS = new IO::Scalar \$data;
unless($IOS)
{
- throw Parse::DebControl::Error::IO("parse_mem failed because IO::Scalar creation failed.");
+ $this->_dowarn("parse_mem failed because IO::Scalar creation failed.");
+ return;
}
return $this->_parseDataHandle($IOS, $options);
@@ -170,7 +73,8 @@
unless($url)
{
- throw Parse::DebControl::Error::IO("No url given, thus no data to parse");
+ $this->_dowarn("No url given, thus no data to parse");
+ return;
}
my $ua = LWP::UserAgent->new;
@@ -179,7 +83,8 @@
unless($request)
{
- throw Parse::DebControl::Error::IO("Failed to instantiate HTTP Request object");
+ $this->_dowarn("Failed to instantiate HTTP Request object");
+ return;
}
my $response = $ua->request($request);
@@ -187,7 +92,8 @@
if ($response->is_success) {
return $this->parse_mem($response->content(), $options);
} else {
- throw Parse::DebControl::Error::IO("Failed to fetch $url from the web");
+ $this->_dowarn("Failed to fetch $url from the web");
+ return;
}
}
@@ -196,19 +102,22 @@
unless($filenameorhandle)
{
- throw Parse::DebControl::Error::IO("write_file failed because no filename or filehandle was given");
+ $this->_dowarn("write_file failed because no filename or filehandle was given");
+ return;
}
unless($dataorarrayref)
{
- throw Parse::DebControl::Error::IO("write_file failed because no data was given");
+ $this->_dowarn("write_file failed because no data was given");
+ return;
}
my $handle = $this->_getValidHandle($filenameorhandle, $options);
unless($handle)
{
- throw Parse::DebControl::Error::IO("write_file failed because we couldn't negotiate a valid handle");
+ $this->_dowarn("write_file failed because we couldn't negotiate a valid handle");
+ return;
}
my $string = $this->write_mem($dataorarrayref, $options);
@@ -225,7 +134,8 @@
unless($dataorarrayref)
{
- throw Parse::DebControl::Error::IO("write_mem failed because no data was given");
+ $this->_dowarn("write_mem failed because no data was given");
+ return;
}
my $arrayref = $this->_makeArrayref($dataorarrayref);
@@ -255,7 +165,8 @@
{
unless($filenameorhandle->opened())
{
- throw Parse::DebControl::Error::IO("Can't get a valid filehandle to write to, because that is closed");
+ $this->_dowarn("Can't get a valid filehandle to write to, because that is closed");
+ return;
}
return $filenameorhandle;
@@ -269,7 +180,8 @@
unless(open $handle,"$openmode$filenameorhandle")
{
- throw Parse::DebControl::Error::IO("Couldn't open file: $openmode$filenameorhandle for writing");
+ $this->_dowarn("Couldn't open file: $openmode$filenameorhandle for writing");
+ return;
}
return $handle;
@@ -336,7 +248,8 @@
unless($handle)
{
- throw Parse::DebControl::Error("_parseDataHandle failed because no handle was given. This is likely a bug in the module");
+ $this->_dowarn("_parseDataHandle failed because no handle was given. This is likely a bug in the module");
+ return;
}
if($options->{tryGzip})
@@ -360,16 +273,12 @@
chomp $line;
- 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/\#\#/\#/;
- }
+ if($options->{stripComments}){
+ next if $line =~ /^\s*\#[^\#]/;
+ $line =~ s/\#$//;
+ $line =~ s/(?<=[^\#])\#[^\#].*//;
+ $line =~ s/\#\#/\#/;
+ }
$linenum++;
if($line =~ /^[^\t\s]/)
@@ -400,27 +309,19 @@
$lastfield = $key;
}else{
- throw Parse::DebControl::Error::Parse('invalid key/value stansa', $linenum, $line);
+ $this->_dowarn("Parse error on line $linenum of data; invalid key/value stanza");
+ return $structs;
}
}elsif($line =~ /^([\t\s])(.*)/)
- {
- #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);
- }
- }
-
+ {
+ #appends to previous line
+
+ unless($lastfield)
+ {
+ $this->_dowarn("Parse error on line $linenum of data; indented entry without previous line");
+ return $structs;
+ }
if($options->{verbMultiLine}){
$data->{$lastfield}.="\n$1$2";
}elsif($2 eq "." ){
@@ -431,29 +332,20 @@
$data->{$lastfield}.="\n$val";
}
- }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);
- }
+ }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;
+ }
}
@@ -487,7 +379,8 @@
eval("use Tie::IxHash");
if($@)
{
- throw Parse::DebControl::Error("Can't use Tie::IxHash. You need to install it to have this functionality");
+ $this->_dowarn("Can't use Tie::IxHash. You need to install it to have this functionality");
+ return;
}
tie(%$data, "Tie::IxHash");
return $data;
@@ -495,6 +388,19 @@
return {};
}
+
+sub _dowarn
+{
+ my ($this, $warning) = @_;
+
+ if($this->{_verbose})
+ {
+ warn "DEBUG: $warning";
+ }
+
+ return;
+}
+
1;
@@ -595,17 +501,6 @@
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
More information about the Pkg-perl-cvs-commits
mailing list