diff --git a/.SRCINFO b/.SRCINFO index e261d50..ce30580 100644 --- a/.SRCINFO +++ b/.SRCINFO @@ -8,9 +8,21 @@ pkgbase = perl-parse-debcontrol license = PerlArtistic depends = perl>=5.10.0 depends = perl-io-stringy + depends = perl-exporter-lite options = !emptydirs source = http://cpan.metacpan.org/authors/id/J/JA/JAYBONCI/Parse-DebControl-2.005.tar.gz + source = 0001-Parse-DebControl-error-handling.patch + source = 0002-Strict-parse.patch + source = 0003-Parse-DebControl-Patch.patch + source = 0004-Manpage-spelling-fixes.patch + source = 0005-More-thorough-comment-parsing.patch + source = 0006-Better-line-number-tracking.patch sha256sums = b64bce1ff212d7e3ef9d4368e7b62749cf27751fa8360cdf53e969123346a729 + sha256sums = dbee9a96466067e2fe27c93a5d27e31d5dc9e9e698adee9ed72c18d9f3345add + sha256sums = f3473c89718b8463579668b2b8339f7a354e59c716bf200538232b4d69043b17 + sha256sums = 4a3e2bea2b23df8766f40e80101be4a3716087cb4ce7e78cd433e2d68d12b2ff + sha256sums = 44067394d602adbcccc6a165502d5785f28b4938da00053db97972af4881734b + sha256sums = e6c69a85d8d3fe7e48467b39710e8885cc4c184412b44f12675b0ecdf3116ce8 + sha256sums = 07ec49ad7f7bfbefbdeebcbe98dbcad52318d44b4c8fb588769352489d1acc32 pkgname = perl-parse-debcontrol - diff --git a/0001-Parse-DebControl-error-handling.patch b/0001-Parse-DebControl-error-handling.patch new file mode 100644 index 0000000..f41d241 --- /dev/null +++ b/0001-Parse-DebControl-error-handling.patch @@ -0,0 +1,380 @@ +From: =?UTF-8?q?Carl=20F=C3=BCrstenberg?= +Date: Sun, 9 Jan 2011 21:22:45 +0100 +Subject: Parse::DebControl error handling + +To allow for better error handling instead of mearly returning an error +return value +--- + lib/Parse/DebControl.pm | 68 +++++++------------------- + lib/Parse/DebControl/Error.pm | 104 +++++++++++++++++++++++++++++++++++++++++ + t/30parse.t | 5 +- + t/40write.t | 13 ++--- + 4 files changed, 131 insertions(+), 59 deletions(-) + create mode 100644 lib/Parse/DebControl/Error.pm + +--- a/lib/Parse/DebControl.pm ++++ b/lib/Parse/DebControl.pm +@@ -13,6 +13,7 @@ use strict; + use IO::Scalar; + use Compress::Zlib; + use LWP::UserAgent; ++use Parse::DebControl::Error; + + use vars qw($VERSION); + $VERSION = '2.005'; +@@ -33,15 +34,13 @@ sub parse_file { + 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 +51,14 @@ sub parse_mem { + + 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 +70,7 @@ sub parse_web { + + 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 +79,7 @@ sub parse_web { + + 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 +87,7 @@ sub parse_web { + 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 +96,19 @@ sub write_file { + + 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 +125,7 @@ sub write_mem { + + 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 +155,7 @@ sub _getValidHandle { + { + 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 +169,7 @@ sub _getValidHandle { + + 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 +236,7 @@ sub _parseDataHandle + + 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}) +@@ -309,8 +296,7 @@ sub _parseDataHandle + + $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 stanza', $linenum, $line); + } + + }elsif($line =~ /^([\t\s])(.*)/) +@@ -319,8 +305,7 @@ sub _parseDataHandle + + unless($lastfield) + { +- $this->_dowarn("Parse error on line $linenum of data; indented entry without previous line"); +- return $structs; ++ throw Parse::DebControl::Error::Parse("indented entry without previous line", $linenum); + } + if($options->{verbMultiLine}){ + $data->{$lastfield}.="\n$1$2"; +@@ -343,8 +328,7 @@ sub _parseDataHandle + $data = $this->_getReadyHash($options); + $lastfield = ""; + }else{ +- $this->_dowarn("Parse error on line $linenum of data; unidentified line structure"); +- return $structs; ++ throw Parse::DebControl::Error::Parse("unidentified line structure", $linenum, $line); + } + + } +@@ -379,8 +363,7 @@ sub _getReadyHash + 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 +372,6 @@ sub _getReadyHash + return {}; + } + +-sub _dowarn +-{ +- my ($this, $warning) = @_; +- +- if($this->{_verbose}) +- { +- warn "DEBUG: $warning"; +- } +- +- return; +-} +- +- + 1; + + __END__ +--- /dev/null ++++ b/lib/Parse/DebControl/Error.pm +@@ -0,0 +1,106 @@ ++use strict; ++use warnings; ++ ++package Parse::DebControl::Error; ++=pod ++ ++=encoding utf-8 ++ ++=head1 NAME ++Parse::DebControl::Error - Exception classes for Parse::DebControl ++ ++=head1 SYNOPSIS ++ ++ use Parse::DebControl::Error; ++ ++ throw Parse::DebControl::Error(); ++ ++ throw Parse::DebControl::Error::Parse( "reason for exception" ); ++ throw Parse::DebControl::Error::Parse( "reason for exception", $line_number_of_data ); ++ throw Parse::DebControl::Error::Parse( "reason for exception", $line_number_of_data, $context_line ); ++ ++ throw Parse::DebControl::Error::IO( "information regarding the error" ); ++ ++=head1 COPYRIGHT ++ ++Parse::DebControl is copyright 2003,2004 Jay Bonci Ejaybonci@cpan.orgE. ++ ++Parse::DebControl::Error is copyright 2009 Carl Fürstenberg Eazatoth@gmail.comE. ++ ++This program is free software; you can redistribute it and/or modify it under ++the same terms as Perl itself. ++ ++=cut ++use base 'Error'; ++our $VERSION = '0.1'; ++sub new ++{ ++ my $self = shift; ++ local $Error::Depth = $Error::Depth + 1; ++ ++ $self->SUPER::new(@_); ++} ++ ++package Parse::DebControl::Error::Parse; ++ ++use base 'Parse::DebControl::Error'; ++our $VERSION = '0.1'; ++ ++sub new ++{ ++ my $self = shift; ++ my $text = "".shift; ++ my @args = (); ++ ++ my $line = shift; ++ my $context = shift; ++ ++ push(@args, '-context', $context) if defined($context); ++ push(@args, '-line', $line) if defined($line); ++ ++ local $Error::Depth = $Error::Depth + 1; ++ ++ $self->SUPER::new(-text => $text, @args); ++} ++ ++sub stringify { ++ my $self = shift; ++ my $text; ++ if( $self->context ) { ++ $text = sprintf("Parse error: %s at line %d of data (\"%s\").\n", $self->SUPER::stringify, $self->line, $self->context); ++ } elsif( $self->line ) { ++ $text = sprintf("Parse error: %s at line %d of data.\n", $self->SUPER::stringify, $self->line); ++ } else { ++ $text = sprintf("Parse error: %s.\n", $self->SUPER::stringify); ++ } ++ $text; ++} ++ ++sub context { ++ my $self = shift; ++ exists $self->{'-context'} ? $self->{'-context'} : undef; ++} ++ ++package Parse::DebControl::Error::IO; ++ ++use base 'Parse::DebControl::Error'; ++our $VERSION = '0.1'; ++sub new ++{ ++ my $self = shift; ++ my $text = "".shift; ++ my @args = (); ++ ++ local $Error::Depth = $Error::Depth + 1; ++ ++ $self->SUPER::new(-text => $text, @args); ++} ++ ++sub stringify { ++ my $self = shift; ++ my $text; ++ $text = sprintf("IO error: %s.\n", $self->SUPER::stringify ); ++ $text; ++} ++ ++1; +--- a/t/30parse.t ++++ b/t/30parse.t +@@ -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 @@ my $mod = "Parse::DebControl"; + + #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 + +--- a/t/40write.t ++++ b/t/40write.t +@@ -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 @@ use_ok($mod); + 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 @@ ok($warnings eq "", "Writing blank hashr + + $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 +- diff --git a/0002-Strict-parse.patch b/0002-Strict-parse.patch new file mode 100644 index 0000000..5b602eb --- /dev/null +++ b/0002-Strict-parse.patch @@ -0,0 +1,514 @@ +From: Debian Perl Group +Date: Sun, 9 Jan 2011 21:15:39 +0100 +Subject: Strict parse + +implementation to allow users to enable strict parsing mode, which will +bail out if a file doesn't follow the content rule for that particular +format + +Currently following formats are available: + * debian/control + * DEBIAN/control + * .dsc + * .changes +--- + lib/Parse/DebControl.pm | 219 +++++++++++++++++++++++++++++++++++++----- + t/34strict.t | 92 ++++++++++++++++++ + t/testfiles/strict1.changes | 43 +++++++++ + t/testfiles/strict2.dsc | 16 +++ + t/testfiles/strict3.source | 29 ++++++ + t/testfiles/strict4.binary | 23 +++++ + 6 files changed, 396 insertions(+), 26 deletions(-) + create mode 100644 t/34strict.t + create mode 100644 t/testfiles/strict1.changes + create mode 100644 t/testfiles/strict2.dsc + create mode 100644 t/testfiles/strict3.source + create mode 100644 t/testfiles/strict4.binary + +--- a/lib/Parse/DebControl.pm ++++ b/lib/Parse/DebControl.pm +@@ -14,10 +14,135 @@ use IO::Scalar; + use Compress::Zlib; + use LWP::UserAgent; + use Parse::DebControl::Error; ++use 5.10.1; + + use vars qw($VERSION); + $VERSION = '2.005'; + ++# in strict mode, following specifies what fields are OK, and ++# if they might have multiline data ++my $strict_field_rules = { ++ 'debian/control' => { ++ 'source' => 0, ++ 'maintainer' => 0, ++ 'uploaders' => 1, ++ 'section' => 0, ++ 'priority' => 0, ++ 'build-depends' => 1, ++ 'build-depends-indep' => 1, ++ 'build-conflicts' => 1, ++ 'build-conflicts-indep' => 1, ++ 'depends' => 1, ++ 'pre-depends' => 1, ++ 'recommends' => 1, ++ 'suggests' => 1, ++ 'enhances' => 1, ++ 'breaks' => 1, ++ 'conflicts' => 1, ++ 'description' => 1, ++ 'package' => 0, ++ 'architecture' => 0, ++ 'essential' => 0, ++ 'standards-version' => 0, ++ 'homepage' => 0, ++ }, ++ 'DEBIAN/control' => { ++ 'source' => 0, ++ 'maintainer' => 0, ++ 'changed-by' => 0, ++ 'section' => 0, ++ 'priority' => 0, ++ 'package' => 0, ++ 'architecture' => 0, ++ 'essential' => 0, ++ 'version' => 0, ++ 'installed-size' => 0, ++ 'homepage' => 0, ++ 'depends' => 1, ++ 'pre-depends' => 1, ++ 'recommends' => 1, ++ 'suggests' => 1, ++ 'enhances' => 1, ++ 'breaks' => 1, ++ 'conflicts' => 1, ++ 'description' => 1, ++ 'description' => 1, ++ }, ++ '.dsc' => { ++ 'format' => 0, ++ 'date' => 0, ++ 'source' => 0, ++ 'version' => 0, ++ 'maintainer' => 0, ++ 'architecture' => 0, ++ 'standards-version' => 0, ++ 'homepage' => 0, ++ 'uploaders' => 1, ++ 'binary' => 1, ++ 'build-depends' => 1, ++ 'build-depends-indep' => 1, ++ 'build-conflicts' => 1, ++ 'build-conflicts-indep' => 1, ++ 'files' => 1, ++ }, ++ '.changes' => { ++ 'format' => 0, ++ 'date' => 0, ++ 'source' => 0, ++ 'architecture' => 0, ++ 'version' => 0, ++ 'distribution' => 0, ++ 'description' => 1, ++ 'urgency' => 0, ++ 'maintainer' => 0, ++ 'changed-by' => 0, ++ 'closes' => 0, ++ 'binary' => 1, ++ 'changes' => 1, ++ 'files' => 1, ++ } ++}; ++my $strict_field_match_rules = { ++ 'debian/control' => qr/^\s*( ++ ++ |vcs-\w+ # not in policy ++ ++ )\s*$/ix, ++ 'DEBIAN/control' => qr/^\s*( ++ ++ )\s*$/ix, ++ '.dsc' => qr/^\s*( ++ ++ |vcs-\w+ # not in policy ++ |checksums-\w+ # not in policy ++ ++ )\s*$/ix, ++ '.changes' => qr/^\s*( ++ ++ |checksums-\w+ # not in policy ++ ++ )\s*$/ix, ++}; ++my $strict_field_match_rules_multiline = { ++ 'debian/control' => qr/^\s*( ++ ++ )\s*$/ix, ++ 'DEBIAN/control' => qr/^\s*( ++ ++ )\s*$/ix, ++ '.dsc' => qr/^\s*( ++ ++ |checksums-\w+ # not in policy ++ ++ )\s*$/ix, ++ '.changes' => qr/^\s*( ++ ++ |checksums-\w+ # not in policy ++ ++ )\s*$/ix, ++}; ++ ++ + sub new { + my ($class, $debug) = @_; + my $this = {}; +@@ -260,12 +385,16 @@ sub _parseDataHandle + 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]/) +@@ -276,6 +405,17 @@ sub _parseDataHandle + my $key = $1; + my $value = $2; + ++ if( $options->{strict} ) { ++ if( exists $strict_field_rules->{$options->{'type'}} ) { ++ unless( ++ $options->{'allowUnknownFields'} ++ || $key =~ /^X\w*?-/i ++ || exists $strict_field_rules->{$options->{'type'}}->{lc $key} ++ || $key =~ $strict_field_match_rules->{$options->{type} } ) { ++ throw Parse::DebControl::Error::Parse("field '$key' for type '$options->{type}' is not allowed", $linenum, $line); ++ } ++ } ++ } + if($options->{discardCase}) + { + $key = lc($key); +@@ -299,14 +439,22 @@ sub _parseDataHandle + throw Parse::DebControl::Error::Parse('invalid key/value stanza', $linenum, $line); + } + +- }elsif($line =~ /^([\t\s])(.*)/) +- { +- #appends to previous line ++ }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_field_rules->{$options->{'type'}}->{lc $lastfield} ) { ++ unless( $strict_field_rules->{$options->{'type'}}->{lc $lastfield} == 1 || $lastfield =~ $strict_field_match_rules_multiline->{$options->{'type'}} ) { ++ throw Parse::DebControl::Error::Parse("field $lastfield for type $options->{type} may not span multiple lines", $linenum); ++ } ++ } ++ } + +- unless($lastfield) +- { +- throw Parse::DebControl::Error::Parse("indented entry without previous line", $linenum); +- } + if($options->{verbMultiLine}){ + $data->{$lastfield}.="\n$1$2"; + }elsif($2 eq "." ){ +@@ -316,20 +464,23 @@ sub _parseDataHandle + $val =~ s/[\s\t]+$//; + $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{ ++ }elsif($line =~ /^[\s\t]*$/){ ++ if ($options->{verbMultiLine} ++ && ($data->{$lastfield} =~ /\n/o)) { ++ $data->{$lastfield} .= "\n"; ++ } ++ ++ if(keys %$data > 0){ ++ if( $options->{singleBlock} ) { ++ return $data; ++ } ++ push @$structs, $data; ++ } ++ $data = $this->_getReadyHash($options); ++ $lastfield = ""; ++ }else{ + throw Parse::DebControl::Error::Parse("unidentified line structure", $linenum, $line); +- } ++ } + + } + +@@ -471,6 +622,22 @@ enables the option. + it is off by default so we don't have to scrub over all the text for + performance reasons. + ++ singleBlock - Only parse the first block of data and return it. This is ++ useful when you have possible "junk" data after the metadata. ++ ++ 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. ++ ++ allowUnknownFields - In strict mode, allow unknown fields. ++ ++ type - If the strict option is chosen, then this parameter defines what format ++ we have. Available formats is: ++ - debian/control ++ - DEBIAN/control ++ - .dsc ++ - .changes ++ + =back + + =over 4 +--- /dev/null ++++ b/t/34strict.t +@@ -0,0 +1,92 @@ ++# ++#=============================================================================== ++# ++# 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 => 12; # 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); ++ ++# Parse debian/control ++lives_ok (sub { ++ $data = $pdc->parse_file( "testfiles/strict3.source", { strict => 1, type => 'debian/control', singeBlock => 1 } ); ++}, "parse debian/control"); ++ ++# Parse DEBIAN/control ++lives_ok (sub { ++ $data = $pdc->parse_file( "testfiles/strict4.binary", { strict => 1, type => 'DEBIAN/control', singeBlock => 1 } ); ++}, "parse DEBIAN/control"); ++ ++# Parse .changes ++lives_ok (sub { ++ $data = $pdc->parse_file( "testfiles/strict1.changes", { strict => 1, type => '.changes', singeBlock => 1 } ); ++}, "parse .changes"); ++ ++# Parse .dsc ++lives_ok (sub { ++ $data = $pdc->parse_file( "testfiles/strict2.dsc", { strict => 1, type => '.dsc', singeBlock => 1 } ); ++}, "parse .dsc"); ++ ++ ++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'} ++ ) ++} 'Parse::DebControl::Error::Parse', "Error thrown"; ++throws_ok { ++ $pdc->parse_mem( ++ "Source: foo\nPackage: bar\nExtra: candy for me", ++ {strict => 1, type => 'debian/control'} ++ ) ++} 'Parse::DebControl::Error::Parse', "Error thrown for the extra field"; ++lives_ok { ++ $pdc->parse_mem( ++ "Format: 1.8\nSource: bar\n\nExtra: candy for me", ++ {strict => 1, type => '.dsc', singleBlock => 1} ++ ) ++} "Error not thrown when ignoring junk"; ++throws_ok { ++ $pdc->parse_mem( ++ "Source: foo\nPackage: bar\n\nExtra: candy for me", ++ {strict => 1, type => 'debian/control'} ++ ) ++} 'Parse::DebControl::Error::Parse', "Error thrown for the extra block"; ++lives_ok { ++ $pdc->parse_mem( ++ "Format: 1.8\nSource: bar\nX-Extra: candy for me", ++ {strict => 1, type => '.dsc'} ++ ) ++} "Error not thrown when local fields is used"; +--- /dev/null ++++ b/t/testfiles/strict1.changes +@@ -0,0 +1,43 @@ ++Format: 1.8 ++Date: Sun, 29 Nov 2009 19:51:05 +0100 ++Source: libparse-debcontrol-perl ++Binary: libparse-debcontrol-perl ++Architecture: source all ++Version: 2.005-3 ++Distribution: UNRELEASED ++Urgency: low ++Maintainer: Debian Perl Group ++Changed-By: Carl Fürstenberg ++Description: ++ libparse-debcontrol-perl - Easy OO parsing of Debian control-like files ++Closes: 535958 ++Changes: ++ libparse-debcontrol-perl (2.005-3) UNRELEASED; urgency=low ++ . ++ [ gregor herrmann ] ++ * debian/control: Changed: Switched Vcs-Browser field to ViewSVN ++ (source stanza). ++ . ++ [ Nathan Handler ] ++ * debian/watch: Update to ignore development releases. ++ . ++ [ Carl Fürstenberg ] ++ * 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 ++ * Adding specific class for DEP3 patch metadata files (needs unconventional ++ parsing) ++Checksums-Sha1: ++ 270e381c3edc74b45f8849bc9bcd3530d4ad8534 1312 libparse-debcontrol-perl_2.005-3.dsc ++ 8bac7ca276601ec993b8d57dad9e2da3650c5b21 8715 libparse-debcontrol-perl_2.005-3.diff.gz ++ 5d8fa94499aefead57da8db6f80a93832ca8967b 24352 libparse-debcontrol-perl_2.005-3_all.deb ++Checksums-Sha256: ++ d5beb5e7cf627da4a454171e053054df640be9ae79d0bde6d5839ed91232e2d1 1312 libparse-debcontrol-perl_2.005-3.dsc ++ 890533ed1dbe6e77c7b416c52fa7ea48cae98d0887d7c45456057f7b26407f45 8715 libparse-debcontrol-perl_2.005-3.diff.gz ++ 168c7c287382b18be6de81cf1aaedb3f7b40bf512a71a0f46e459285b94e8ef0 24352 libparse-debcontrol-perl_2.005-3_all.deb ++Files: ++ 48ea11ea1a2cf1df823c56014bde906b 1312 perl optional libparse-debcontrol-perl_2.005-3.dsc ++ 5b1813a6d4ef35f45a53432c8fa47ddf 8715 perl optional libparse-debcontrol-perl_2.005-3.diff.gz ++ f0b93bdfe997dab7bc47437d970e644d 24352 perl optional libparse-debcontrol-perl_2.005-3_all.deb +--- /dev/null ++++ b/t/testfiles/strict2.dsc +@@ -0,0 +1,16 @@ ++Format: 1.0 ++Source: libparse-debcontrol-perl ++Binary: libparse-debcontrol-perl ++Architecture: all ++Version: 2.005-2 ++Maintainer: Debian Perl Group ++Uploaders: Carl Fürstenberg , Gunnar Wolf ++Homepage: http://search.cpan.org/dist/Parse-DebControl/ ++Standards-Version: 3.7.3 ++Vcs-Browser: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-debcontrol-perl/ ++Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libparse-debcontrol-perl/ ++Build-Depends: cdbs (>= 0.4.49), debhelper (>= 6) ++Build-Depends-Indep: libcompress-zlib-perl, libio-stringy-perl, libpod-coverage-perl, libtest-pod-perl, libtie-ixhash-perl, libwww-perl, perl (>= 5.8.8-7) ++Files: ++ 4fbf2e0b28a471a5e94394615303daf6 11414 libparse-debcontrol-perl_2.005.orig.tar.gz ++ 1eab49874a689857f8458457081fbe86 1783 libparse-debcontrol-perl_2.005-2.diff.gz +--- /dev/null ++++ b/t/testfiles/strict3.source +@@ -0,0 +1,29 @@ ++Source: libparse-debcontrol-perl ++Section: perl ++Priority: optional ++Build-Depends: debhelper (>= 7.0.50) ++Build-Depends-Indep: perl (>= 5.8.8-7), libio-stringy-perl, libcompress-zlib-perl, libwww-perl, libtie-ixhash-perl, libtest-pod-perl, libpod-coverage-perl ++Maintainer: Debian Perl Group ++Uploaders: Carl Fürstenberg , Gunnar Wolf ++Standards-Version: 3.8.3 ++Homepage: http://search.cpan.org/dist/Parse-DebControl/ ++Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libparse-debcontrol-perl/ ++Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libparse-debcontrol-perl/ ++ ++Package: libparse-debcontrol-perl ++Architecture: all ++Depends: ${perl:Depends}, ${misc:Depends}, libio-stringy-perl, libcompress-zlib-perl, libwww-perl ++Recommends: libtie-ixhash-perl, libtest-pod-perl, libpod-coverage-perl ++Description: Easy OO parsing of Debian control-like files ++ Parse::DebControl is an easy OO way to parse Debian control files and ++ other colon separated key-value pairs. It's specifically designed ++ to handle the format used in Debian control files, template files, and ++ the cache files used by dpkg. ++ . ++ For basic format information see: ++ http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-controlsyntax ++ . ++ This module does not actually do any intelligence with the file content ++ (because there are a lot of files in this format), but merely handles ++ the format. It can handle simple control files, or files hundreds of lines ++ long efficiently and easily. +--- /dev/null ++++ b/t/testfiles/strict4.binary +@@ -0,0 +1,23 @@ ++Package: libparse-debcontrol-perl ++Version: 2.005-2 ++Architecture: all ++Maintainer: Debian Perl Group ++Installed-Size: 80 ++Depends: perl, libio-stringy-perl, libcompress-zlib-perl, libwww-perl ++Recommends: libtie-ixhash-perl, libtest-pod-perl, libpod-coverage-perl ++Section: perl ++Priority: optional ++Homepage: http://search.cpan.org/dist/Parse-DebControl/ ++Description: Easy OO parsing of Debian control-like files ++ Parse::DebControl is an easy OO way to parse Debian control files and ++ other colon separated key-value pairs. It's specifically designed ++ to handle the format used in Debian control files, template files, and ++ the cache files used by dpkg. ++ . ++ For basic format information see: ++ http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-controlsyntax ++ . ++ This module does not actually do any intelligence with the file content ++ (because there are a lot of files in this format), but merely handles ++ the format. It can handle simple control files, or files hundreds of lines ++ long efficiently and easily. diff --git a/0003-Parse-DebControl-Patch.patch b/0003-Parse-DebControl-Patch.patch new file mode 100644 index 0000000..6a1e944 --- /dev/null +++ b/0003-Parse-DebControl-Patch.patch @@ -0,0 +1,385 @@ +From: Debian Perl Group +Date: Sun, 9 Jan 2011 21:15:39 +0100 +Subject: Parse::DebControl::Patch + +Easy OO parsing of debian patch file metadata (DEP3) data +--- + lib/Parse/DebControl/Patch.pm | 221 +++++++++++++++++++++++++++++++++++++++++ + t/35patch.t | 95 ++++++++++++++++++ + t/testfiles/patch1.diff | 26 +++++ + t/testfiles/patch2.diff | 4 + + t/testfiles/patch3.diff | 4 + + 5 files changed, 350 insertions(+), 0 deletions(-) + create mode 100644 lib/Parse/DebControl/Patch.pm + create mode 100644 t/35patch.t + create mode 100644 t/testfiles/patch1.diff + create mode 100644 t/testfiles/patch2.diff + create mode 100644 t/testfiles/patch3.diff + +--- /dev/null ++++ b/lib/Parse/DebControl/Patch.pm +@@ -0,0 +1,223 @@ ++package Parse::DebControl::Patch; ++=pod ++ ++=encoding utf-8 ++ ++=head1 NAME ++ ++Parse::DebControl::Patch - Easy OO parsing of debian patch file metadata (DEP3) data ++ ++=head1 SYNOPSIS ++ ++ use Parse::DebControl::Patch ++ ++ $parser = new Parse::DebControl::Patch; ++ ++ $data = $parser->parse_mem($control_data, $options); ++ $data = $parser->parse_file('./debian/control', $options); ++ $data = $parser->parse_web($url, $options); ++ ++=head1 DESCRIPTION ++ ++ The patch-file metadata specification (DEP3) diverts from the normal debian/control ++ rules primarly of the "free-form" field specification. To handle this we most create ++ an parser specifically for this format and hardcode these rules direclty into the code. ++ ++ As we will always only have one block of data, we will return the hashref directly ++ instead of enclosing it into an array. ++ ++ The field B is magic and will always exists in the out data, even if not specified ++ in the indata. It can only have three values, I, I, and I. If not specified ++ it will have the value I. ++ ++=head1 COPYRIGHT ++ ++Parse::DebControl is copyright 2003,2004 Jay Bonci Ejaybonci@cpan.orgE. ++Parse::DebControl::Patch is copyright 2009 Carl Fürstenberg Eazatoth@gmail.comE. ++This program is free software; you can redistribute it and/or modify it under ++the same terms as Perl itself. ++ ++=cut ++use strict; ++use warnings; ++ ++use base 'Parse::DebControl'; ++ ++use Exporter::Lite; ++ ++ ++our @EXPORT_OK = qw($Forwared_Yes $Forwared_No $Forwared_NotNeeded); ++ ++our $VERSION = '0.1'; ++ ++sub _parseDataHandle ++{ ++ my ($this, $handle, $options) = @_; ++ ++ unless($handle) ++ { ++ throw Parse::DebControl::Error("_parseDataHandle failed because no handle was given. This is likely a bug in the module"); ++ } ++ ++ if($options->{tryGzip}) ++ { ++ if(my $gunzipped = $this->_tryGzipInflate($handle)) ++ { ++ $handle = new IO::Scalar \$gunzipped ++ } ++ } ++ ++ my $data = $this->_getReadyHash($options); ++ ++ my $linenum = 0; ++ my $lastfield = ""; ++ my $begun = 0; ++ my $dpatch = 0; ++ my $freeform = ""; ++ my $in_freeform = 0; ++ my $freeform_fields = []; ++ ++ foreach my $line (<$handle>) ++ { ++ next if $line =~ /^\s*$/ and not $begun; ++ ++ if( $line =~ /^#\s*$/ and not $begun ) { ++ $dpatch = 1; ++ next; ++ } ++ if( $line =~ /^#\s$/ and not $begun ) { ++ $dpatch = 1; ++ } ++ $begun = 1; ++ if( $dpatch ) { ++ unless( $line =~ s/^# // ) { ++ throw Parse::DebControl::Error::Parse("We are in dpatch mode, and a non-shell-comment line found", $linenum, $line); ++ } ++ } ++ ++ chomp $line; ++ ++ ++ $linenum++; ++ if( $in_freeform ) { ++ if( $line =~ /^---/ ) { ++ # we need to prohibit --- lines in freeform ++ last; ++ } ++ if( $line =~ /^$/ ) { ++ chomp $freeform; ++ push @$freeform_fields, $freeform; ++ $freeform = ""; ++ $in_freeform = 0; ++ } else { ++ $freeform .= "$line\n"; ++ } ++ next; ++ } else { ++ if( $line =~ /^$/ ) { ++ $in_freeform = 1; ++ $freeform = ""; ++ next; ++ } ++ } ++ ++ if( $line =~ /^---/ ) { ++ last; ++ } elsif($line =~ /^[^\t\s]/) { ++ #we have a valid key-value pair ++ if($line =~ /(.*?)\s*\:\s*(.*)$/) ++ { ++ my $key = $1; ++ my $value = $2; ++ ++ if($options->{discardCase}) ++ { ++ $key = lc($key); ++ } ++ ++ push @{$data->{$key}}, $value; ++ ++ $lastfield = $key; ++ }else{ ++ throw Parse::DebControl::Error::Parse('invalid key/value stanza', $linenum, $line); ++ } ++ ++ } elsif($line =~ /^([\t\s])(.*)/) { ++ #appends to previous line ++ ++ unless($lastfield) ++ { ++ throw Parse::DebControl::Error::Parse('indented entry without previous line', $linenum, $line); ++ } ++ if($2 eq "." ){ ++ $data->{$lastfield}->[scalar @{$data->{$lastfield}}] .= "\n"; ++ }else{ ++ my $val = $2; ++ $val =~ s/[\s\t]+$//; ++ $data->{$lastfield}->[scalar @{$data->{$lastfield}}] .= "\n$val"; ++ } ++ }else{ ++ # we'll ignore if junk comes after the metadata usually ++ last; ++ } ++ ++ } ++ ++ if( scalar @$freeform_fields ) { ++ if( exists $data->{'Description'} ) { ++ push @{$data->{'Description'}}, @$freeform_fields; ++ } elsif( exists $data->{'Subject'} ) { ++ push @{$data->{'Subject'}}, @$freeform_fields; ++ } else { ++ throw Parse::DebControl::Error::Parse('Freeform field found without any Subject or Description fields'); ++ } ++ } ++ if( exists $data->{'Forwarded'} ) { ++ $data->{'Forwarded'} = new Parse::DebControl::Patch::Forwarded($data->{'Forwarded'}->[0]); ++ } else { ++ $data->{'Forwarded'} = new Parse::DebControl::Patch::Forwarded(); ++ } ++ ++ return $data; ++} ++ ++package Parse::DebControl::Patch::Forwarded; ++ ++sub new { ++ my ($class, $value) = @_; ++ my $this = {}; ++ ++ my $obj = bless $this, $class; ++ $obj->{value} = $value ? $value : 'yes'; ++ $obj; ++} ++ ++use overload 'bool' => \&check_bool, '""' => \&get_string, 'cmp' => \&compare; ++ ++sub check_bool { ++ my ( $self ) = shift; ++ if( $self->{value} eq 'no' || $self->{value} eq 'not-needed' ) { ++ return 0; ++ } ++ return 1; ++} ++ ++sub get_string { ++ my ( $self ) = shift; ++ return $self->{value}; ++} ++ ++sub compare { ++ my $self = shift; ++ my $theirs = shift; ++ ++ if( $self->{value} eq $theirs ) { ++ return 0; ++ } elsif( $self->{value} gt $theirs ) { ++ return 1; ++ } ++ return -1; ++ ++} ++ ++1; +--- /dev/null ++++ b/t/35patch.t +@@ -0,0 +1,95 @@ ++# ++#=============================================================================== ++# ++# FILE: 35patch.t ++# ++# DESCRIPTION: ++# ++# FILES: --- ++# BUGS: --- ++# NOTES: --- ++# AUTHOR: (), <> ++# COMPANY: ++# VERSION: 1.0 ++# CREATED: 2009-11-29 19.13.10 CET ++# REVISION: --- ++#=============================================================================== ++ ++use strict; ++use warnings; ++ ++use Test::More tests => 31; # last test to print ++use Test::Exception; ++ ++BEGIN { ++ chdir 't' if -d 't'; ++ use lib '../blib/lib', 'lib/', '..'; ++} ++ ++my $pdc; ++my $data; ++ ++#Object initialization - 2 tests ++ ++BEGIN { use_ok( 'Parse::DebControl::Patch' ) }; ++ok($pdc = new Parse::DebControl::Patch(), "Parser object creation works fine"); ++ ++#Parse file - 1 test ++lives_ok ( sub { ++ $data = $pdc->parse_file( 'testfiles/patch1.diff' ) ++ }, "Parsed patch ok"); ++ ++# Check From - 3 tests ++ok( exists $data->{From}->[0], "Exists first From field"); ++is( $data->{From}->[0], "Ulrich Drepper ", "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 - 3 tests ++# Test file doesn't include a forwared field, so it should default to true ++ok( exists $data->{Forwarded}, "Exists Forwarded field"); ++ok( $data->{Forwarded}, "Forwarded is true"); ++is( $data->{Forwarded}, 'yes', "Forwarded is set to \"yes\""); ++ ++#Parse file - 1 test ++lives_ok ( sub { ++ $data = $pdc->parse_file( 'testfiles/patch2.diff' ) ++ }, "Parsed patch2 ok"); ++# Check if the Forwarded field is set and is set to false - 3 tests ++ok( exists $data->{Forwarded}, "Exists Forwarded field"); ++ok( !$data->{Forwarded}, "Forwarded is false"); ++is( $data->{Forwarded}, 'not-needed', "Forwarded is set to \"not-needed\""); ++ ++#Parse file - 1 test ++lives_ok ( sub { ++ $data = $pdc->parse_file( 'testfiles/patch3.diff' ) ++ }, "Parsed patch3 ok"); ++# Check if the Forwarded field is set and is set to true - 3 tests ++ok( exists $data->{Forwarded}, "Exists Forwarded field"); ++ok( $data->{Forwarded}, "Forwarded is true"); ++is( $data->{Forwarded}, 'http://www.example.com/patches?id=42', "Forwarded is set to \"http://www.example.com/patches?id=42\""); +--- /dev/null ++++ b/t/testfiles/patch1.diff +@@ -0,0 +1,26 @@ ++From: Ulrich Drepper ++Subject: Fix regex problems with some multi-bytes characters ++ ++* posix/bug-regex17.c: Add testcases. ++* posix/regcomp.c (re_compile_fastmap_iter): Rewrite COMPLEX_BRACKET ++ handling. ++ ++Origin: upstream, http://sourceware.org/git/?p=glibc.git;a=commitdiff;h=bdb56bac ++Bug: http://sourceware.org/bugzilla/show_bug.cgi?id=9697 ++Bug-Debian: http://bugs.debian.org/510219 ++ ++diff --git a/ChangeLog b/ChangeLog ++index 182bd26..8829b44 100644 ++--- a/ChangeLog +++++ b/ChangeLog ++@@ -1,3 +1,10 @@ +++2009-01-04 Paolo Bonzini +++ +++ [BZ 9697] +++ * posix/bug-regex17.c: Add testcases. +++ * posix/regcomp.c (re_compile_fastmap_iter): Rewrite COMPLEX_BRACKET +++ handling. +++ ++ 2009-01-05 Martin Schwidefsky ++ ++ * sysdeps/unix/sysv/linux/s390/bits/libc-vdso.h: New file. +--- /dev/null ++++ b/t/testfiles/patch2.diff +@@ -0,0 +1,4 @@ ++From: Fubbe Dubbe ++Author: Someone Cool ++Subject: Bla bla bla ++Forwarded: not-needed +--- /dev/null ++++ b/t/testfiles/patch3.diff +@@ -0,0 +1,4 @@ ++From: Fubbe Dubbe ++Author: Someone Cool ++Subject: Bla bla bla ++Forwarded: http://www.example.com/patches?id=42 diff --git a/0004-Manpage-spelling-fixes.patch b/0004-Manpage-spelling-fixes.patch new file mode 100644 index 0000000..1fdca4f --- /dev/null +++ b/0004-Manpage-spelling-fixes.patch @@ -0,0 +1,28 @@ +From: =?UTF-8?q?Carl=20F=C3=BCrstenberg?= +Date: Tue, 8 Feb 2011 22:13:59 +0100 +Subject: Manpage spelling fixes + +--- + lib/Parse/DebControl.pm | 4 ++-- + 1 files changed, 2 insertions(+), 2 deletions(-) + +--- a/lib/Parse/DebControl.pm ++++ b/lib/Parse/DebControl.pm +@@ -672,7 +672,7 @@ above + + This function takes a filename or a handle and writes the data out. The + data can be given as a single hashref or as an arrayref of hashrefs. It +-will then write it out in a format that it can parse. The order is dependant ++will then write it out in a format that it can parse. The order is dependent + on your hash sorting order. If you care, use Tie::IxHash. Remember for + reading back in, the module doesn't care. + +@@ -713,7 +713,7 @@ is no I<%options> for this file (yet); + + =item * C + +-Turns on debugging. Calling it with no paramater or a true parameter turns ++Turns on debugging. Calling it with no parameter or a true parameter turns + on verbose Cings. Calling it with a false parameter turns it off. + It is useful for nailing down any format or internal problems. + diff --git a/0005-More-thorough-comment-parsing.patch b/0005-More-thorough-comment-parsing.patch new file mode 100644 index 0000000..5c21f66 --- /dev/null +++ b/0005-More-thorough-comment-parsing.patch @@ -0,0 +1,64 @@ +From f80ef7038b36985780e13af1694df9a47a77afc6 Mon Sep 17 00:00:00 2001 +From: Dima Kogan +Date: Thu, 2 Aug 2012 17:14:13 -0700 +Subject: [PATCH] Fixed improperly-handled comment stripping + +--- a/t/31stripcomments.t ++++ b/t/31stripcomments.t +@@ -1,6 +1,6 @@ + #!/usr/bin/perl -w + +-use Test::More tests => 24; ++use Test::More tests => 28; + + BEGIN { + chdir 't' if -d 't'; +@@ -54,3 +54,23 @@ my $mod = "Parse::DebControl"; + ok($data->[0]->{Key1} eq "value", "...first value is correct"); + ok($data->[0]->{Key2} eq "value2", "...second value is correct"); + ++ # Comments in the middle of an indented block ++ my $test_str = <<'EOF'; ++Key1: value, ++ next1, ++ next2, ++#hello there ++# ++ next3 ++EOF ++ my $val_ref = "value,next1,next2,next3"; ++ ++ ok($data = $pdc->parse_mem($test_str, {stripComments => 1}), "Parse with comments in indented block"); ++ $data->[0]->{Key1} =~ s/^\s*//mg; # strip leading whitespace ++ $data->[0]->{Key1} =~ s/\n//g; # collapse newlines ++ ok($data->[0]->{Key1} eq $val_ref, "...value is correct"); ++ ++ ok($data = $pdc->parse_mem($test_str, {verbMultiLine => 1, stripComments => 1}), "Parse with comments in indented block"); ++ $data->[0]->{Key1} =~ s/^\s*//mg;# strip leading whitespace ++ $data->[0]->{Key1} =~ s/\n//g; # collapse newlines ++ ok($data->[0]->{Key1} eq $val_ref, "...value is correct"); +--- a/lib/Parse/DebControl.pm ++++ b/lib/Parse/DebControl.pm +@@ -390,9 +390,19 @@ sub _parseDataHandle + next if $line =~ /^\#/; + } + } elsif( $options->{stripComments} ){ +- next if $line =~ /^\s*\#[^\#]/; +- $line =~ s/\#$//; +- $line =~ s/(?<=[^\#])\#[^\#].*//; ++ ++ # skip all lines that contain ONLY comments ++ next if $line =~ /^\s* # leading whitespace ++ \# # comment character ++ (?:[^\#] | $)/x; # anything else (to not react to ##) ++ ++ # cut off everything past the first non-## comment character ++ $line =~ s/ (?<=[^\#]) # 0-width non-# ++ \# # # ++ (?:[^\#] | $) # non-# or end-of-line ++ .*//x; # everything-else. Replace. ++ ++ # Comments have been cut off, so ## -> # + $line =~ s/\#\#/\#/; + } + diff --git a/0006-Better-line-number-tracking.patch b/0006-Better-line-number-tracking.patch new file mode 100644 index 0000000..ee0224c --- /dev/null +++ b/0006-Better-line-number-tracking.patch @@ -0,0 +1,24 @@ +From f80ef7038b36985780e13af1694df9a47a77afc6 Mon Sep 17 00:00:00 2001 +From: Dima Kogan +Date: Thu, 2 Aug 2012 17:14:13 -0700 +Subject: [PATCH] Fixed improperly-handled comment stripping + +--- a/lib/Parse/DebControl.pm ++++ b/lib/Parse/DebControl.pm +@@ -379,6 +379,8 @@ sub _parseDataHandle + + foreach my $line (<$handle>) + { ++ $linenum++; ++ + #Sometimes with IO::Scalar, lines may have a newline at the end + + #$line =~ s/\r??\n??$//; #CRLF fix, but chomp seems to clean it +@@ -406,7 +408,6 @@ sub _parseDataHandle + $line =~ s/\#\#/\#/; + } + +- $linenum++; + if($line =~ /^[^\t\s]/) + { + #we have a valid key-value pair diff --git a/PKGBUILD b/PKGBUILD index 13c033a..20befe9 100644 --- a/PKGBUILD +++ b/PKGBUILD @@ -1,4 +1,5 @@ -# Maintainer: C. Dominik Bódi +# Maintainer: Luiz Amaral +# Contributor: C. Dominik Bódi # Contributor: Charles Pigott _perlmod=parse-debcontrol @@ -11,10 +12,32 @@ pkgdesc="Easy OO parsing of debian control-like files" arch=('any') url="https://metacpan.org/module/Parse::DebControl" license=('GPL' 'PerlArtistic') -depends=('perl>=5.10.0' 'perl-io-stringy') +depends=('perl>=5.10.0' 'perl-io-stringy' 'perl-exporter-lite') options=('!emptydirs') -source=("http://cpan.metacpan.org/authors/id/J/JA/JAYBONCI/$_perlname-$pkgver.tar.gz") -sha256sums=('b64bce1ff212d7e3ef9d4368e7b62749cf27751fa8360cdf53e969123346a729') +source=("http://cpan.metacpan.org/authors/id/J/JA/JAYBONCI/$_perlname-$pkgver.tar.gz" + '0001-Parse-DebControl-error-handling.patch' + '0002-Strict-parse.patch' + '0003-Parse-DebControl-Patch.patch' + '0004-Manpage-spelling-fixes.patch' + '0005-More-thorough-comment-parsing.patch' + '0006-Better-line-number-tracking.patch') +sha256sums=('b64bce1ff212d7e3ef9d4368e7b62749cf27751fa8360cdf53e969123346a729' + 'dbee9a96466067e2fe27c93a5d27e31d5dc9e9e698adee9ed72c18d9f3345add' + 'f3473c89718b8463579668b2b8339f7a354e59c716bf200538232b4d69043b17' + '4a3e2bea2b23df8766f40e80101be4a3716087cb4ce7e78cd433e2d68d12b2ff' + '44067394d602adbcccc6a165502d5785f28b4938da00053db97972af4881734b' + 'e6c69a85d8d3fe7e48467b39710e8885cc4c184412b44f12675b0ecdf3116ce8' + '07ec49ad7f7bfbefbdeebcbe98dbcad52318d44b4c8fb588769352489d1acc32') + +prepare() { + cd "$srcdir/$_perlname-$pkgver" + patch --forward --strip=1 --input="$srcdir/0001-Parse-DebControl-error-handling.patch" + patch --forward --strip=1 --input="$srcdir/0002-Strict-parse.patch" + patch --forward --strip=1 --input="$srcdir/0003-Parse-DebControl-Patch.patch" + patch --forward --strip=1 --input="$srcdir/0004-Manpage-spelling-fixes.patch" + patch --forward --strip=1 --input="$srcdir/0005-More-thorough-comment-parsing.patch" + patch --forward --strip=1 --input="$srcdir/0006-Better-line-number-tracking.patch" +} build() { cd "$srcdir/$_perlname-$pkgver"