Package/perl-parse-debcontrol
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add patches from Debian

Browse Source
This commit is contained in:
Luiz Amaral
2025-02-19 14:47:42 +01:00
parent 53699ef8d7
commit 05210f7531
8 changed files with 1435 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
.SRCINFO
View File

@@ -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

380
0001-Parse-DebControl-error-handling.patch Normal file
View File

@@ -0,0 +1,380 @@
From: =?UTF-8?q?Carl=20F=C3=BCrstenberg?= <azatoth@gmail.com>
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 E<lt>jaybonci@cpan.orgE<gt>.
+
+Parse::DebControl::Error is copyright 2009 Carl Fürstenberg E<lt>azatoth@gmail.comE<gt>.
+
+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
-

514
0002-Strict-parse.patch Normal file
View File

@@ -0,0 +1,514 @@
From: Debian Perl Group <pkg-perl-maintainers@lists.alioth.debian.org>
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 <pkg-perl-maintainers@lists.alioth.debian.org>
+Changed-By: Carl Fürstenberg <carl@excito.com>
+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 <pkg-perl-maintainers@lists.alioth.debian.org>
+Uploaders: Carl Fürstenberg <azatoth@gmail.com>, Gunnar Wolf <gwolf@debian.org>
+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 <pkg-perl-maintainers@lists.alioth.debian.org>
+Uploaders: Carl Fürstenberg <azatoth@gmail.com>, Gunnar Wolf <gwolf@debian.org>
+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 <pkg-perl-maintainers@lists.alioth.debian.org>
+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.

385
0003-Parse-DebControl-Patch.patch Normal file
View File

@@ -0,0 +1,385 @@
From: Debian Perl Group <pkg-perl-maintainers@lists.alioth.debian.org>
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<Forwarded> is magic and will always exists in the out data, even if not specified
+ in the indata. It can only have three values, I<yes>, I<no>, and I<not-needed>. If not specified
+ it will have the value I<yes>.
+
+=head1 COPYRIGHT
+
+Parse::DebControl is copyright 2003,2004 Jay Bonci E<lt>jaybonci@cpan.orgE<gt>.
+Parse::DebControl::Patch is copyright 2009 Carl Fürstenberg E<lt>azatoth@gmail.comE<gt>.
+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 <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 - 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 <drepper@redhat.com>
+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 <bonzini@gnu.org>
++
++ [BZ 9697]
++ * posix/bug-regex17.c: Add testcases.
++ * posix/regcomp.c (re_compile_fastmap_iter): Rewrite COMPLEX_BRACKET
++ handling.
++
+ 2009-01-05 Martin Schwidefsky <schwidefsky@de.ibm.com>
+
+ * 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

28
0004-Manpage-spelling-fixes.patch Normal file
View File

@@ -0,0 +1,28 @@
From: =?UTF-8?q?Carl=20F=C3=BCrstenberg?= <azatoth@gmail.com>
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<DEBUG()>
-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 C<warn()>ings. Calling it with a false parameter turns it off.
It is useful for nailing down any format or internal problems.

64
0005-More-thorough-comment-parsing.patch Normal file
View File

@@ -0,0 +1,64 @@
From f80ef7038b36985780e13af1694df9a47a77afc6 Mon Sep 17 00:00:00 2001
From: Dima Kogan <dima@secretsauce.net>
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/\#\#/\#/;
}

24
0006-Better-line-number-tracking.patch Normal file
View File

@@ -0,0 +1,24 @@
From f80ef7038b36985780e13af1694df9a47a77afc6 Mon Sep 17 00:00:00 2001
From: Dima Kogan <dima@secretsauce.net>
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

31
PKGBUILD
View File

@@ -1,4 +1,5 @@
# Maintainer: C. Dominik Bódi <dominik dot bodi at gmx dot de>
# Maintainer: Luiz Amaral <email at luiz dot eng dot br>
# Contributor: C. Dominik Bódi <dominik dot bodi at gmx dot de>
# Contributor: Charles Pigott <charlespigott@googlemail.com>
_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"