Parse-DebControl-2.005/0040755000175000017500000000000010000700705014772 5ustar jayboncijaybonciParse-DebControl-2.005/t/0040755000175000017500000000000010000700705015235 5ustar jayboncijaybonciParse-DebControl-2.005/t/50pod.t0100644000175000017500000000024507776571005016400 0ustar jayboncijaybonci#!/usr/bin/perl -w use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Parse-DebControl-2.005/t/40write.t0100644000175000017500000000316207710011555016733 0ustar jayboncijaybonci#!/usr/bin/perl -w use strict; use Test::More tests => 14; my $warning =""; BEGIN { chdir 't' if -d 't'; use lib '../blib/lib', 'lib/', '..'; } my $mod = "Parse::DebControl"; 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"); ok($writer->write_mem({'foo' => 'bar'}) eq "foo: bar\n", "write_* should translate simple items correctly"); ok($writer->write_mem({'foo' => ''}) eq "foo:\n", "write_* should accept (begrudgingly) blank hashkeys"); ok($writer->write_mem({'foo' => undef}) eq "foo:\n", "write_* should correctly handle undef items"); SKIP: { eval { require Tie::IxHash }; skip "Tie::IxHash is not installed", 3 if($@); my $test1 = "Test: Item1\nTest2: Item2\nTest3: Item3\n"; my $test2 = "Test: Items\n Hello\n There\n .\n World\nAnother-item: world\n"; my $i = 1; foreach($test1, $test2, "$test1\n$test2"){ ok($writer->write_mem($writer->parse_mem($_, {'useTieIxHash' => 1})) eq $_, "...Fidelity test $i"); $i++; } } my $warnings = ""; local $SIG{__WARN__} = sub { $warnings = $_}; my $mem = $writer->write_mem([{}]); ok($warnings eq "", "Writing blank hashrefs doesn't throw warnings"); #Version 1.6 fix $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 Parse-DebControl-2.005/t/33parseweb.t0100644000175000017500000000160707726167361017433 0ustar jayboncijaybonci#!/usr/bin/perl -w use Test::More tests => 4; use Compress::Zlib; use LWP::Simple; BEGIN { chdir 't' if -d 't'; use lib '../blib/lib', 'lib/', '..'; } my $mod = "Parse::DebControl"; #Object initialization - 2 tests use_ok($mod); ok($pdc = new Parse::DebControl(), "Parser object creation works fine"); #parse_web - 2 tests #Even though testing with the web can be uncertain, we can be sure of two things # - Debian is around # - Debian has more than 1k packages SKIP: { skip "Skipping time-consuming web tests", 2 unless($ENV{alltests}); my $url = "http://ftp.debian.org/dists/sid/main/binary-i386/Packages.gz"; my $content = get($url); skip "Web test at debian not available", 2 unless($content); ok(my $data = $pdc->parse_web($url, {"tryGzip" => 1}), "parse_web is sane"); ok(int(@$data) > 1000, "...data looks sane enough"); } Parse-DebControl-2.005/t/42writefile.t0100644000175000017500000000436010000640676017574 0ustar jayboncijaybonci#!/usr/bin/perl -w use Test::More tests => 20; use Compress::Zlib; BEGIN { chdir 't' if -d 't'; use lib '../blib/lib', 'lib/', '..'; } my $mod = "Parse::DebControl"; #Object initialization - 2 tests use_ok($mod); ok($pdc = new Parse::DebControl(), "Parser object creation works fine"); SKIP: { skip "/tmp not available. Either not-unix or not standard unix", 18 unless(-d "/tmp"); skip "/tmp not writable. Skipping write tests", 18 unless(-d "/tmp" and -w "/tmp"); skip "Windows /tmp wierdness. No thanks", 18 if($^O =~ /Win32/); my $fh; my $file = "/tmp/pdc_testfile".int(rand(10000)); ok($pdc->write_file($file, {"key1" => "value1", "key2" => "value2"}, {"clobberFile" => 1}), "File write is okay"); ok(my $data = $pdc->parse_file($file), "...and re-parsing is correct"); ok($data->[0]->{key1} eq "value1", "...and the first key is correct"); ok($data->[0]->{key2} eq "value2", "...and the second key is correct"); unlink $file; ok($pdc->write_file($file, {"key1" => "value3", "key2" => "value4"}, {"gzip" => 1, "clobberFile" => 1}), "Writing file with gzip is okay"); ok($data = $pdc->parse_file($file, {tryGzip => 1}), "...and parsing the zipped file is correct"); ok($data->[0]->{key1} eq "value3", "...and the first key is correct"); ok($data->[0]->{key2} eq "value4", "...and the second key is correct"); #Expected behaviour tests ok($pdc->write_file($file, {"key1" => "value4"}, {"clobberFile" => 1}), "File write with single stanza is okay"); ok($pdc->write_file($file, {"key2" => "value5"}), "...appending to that file should produce consistant results"); ok($data = $pdc->parse_file($file), "...and re-parsing succeeded"); ok($data->[0]->{key1} eq "value4", "...and the first key is correct"); ok($data->[0]->{key2} eq "value5", "...and the second key is correct"); ok($pdc->write_file($file, {"key1" => "value6"}, {"clobberFile" => 1, "addNewline" => 1}), "File rewrite with addNewline"); ok($pdc->write_file($file, {"key2" => "value7"}), "...and append to that file"); ok($data = $pdc->parse_file($file), "...and parsing of the newlined file works"); ok($data->[0]->{key1} eq "value6", "...and the first value is correct"); ok($data->[1]->{key2} eq "value7", "...and the second value is correct"); unlink $file; }; Parse-DebControl-2.005/t/31stripcomments.t0100644000175000017500000000465407725170216020525 0ustar jayboncijaybonci#!/usr/bin/perl -w use Test::More tests => 24; BEGIN { chdir 't' if -d 't'; use lib '../blib/lib', 'lib/', '..'; } my $mod = "Parse::DebControl"; #Object initialization - 2 tests use_ok($mod); ok($pdc = new Parse::DebControl(), "Parser object creation works fine"); #stripComments - 6 tests $pdc = new Parse::DebControl(1); ok($data = $pdc->parse_mem("Key1: value1\n\#This is a comment\nKey2: value2#another comment\nKey3: value3", {stripComments => 1}), "Comments parse out correctly"); ok(@$data == 1, "...and there are two stanzas"); ok(keys %{$data->[0]} == 3, "...and the first stanza is the right size"); ok($data->[0]->{Key1} eq "value1", "...and the first value is correct"); ok($data->[0]->{Key2} eq "value2", "...and the second value is correct"); ok($data->[0]->{Key3} eq "value3", "...and the third value is correct"); #Comment char as last character - 2 tests ok($data = $pdc->parse_mem("Key1: value\#", {stripComments => 1}), "Parse with pound as last character"); ok($data->[0]->{Key1} eq "value", "...data is correct"); #Literal pound as last character - 2 tests ok($data = $pdc->parse_mem("Key1: value\#\#", {stripComments => 1}), "Parse with literal pound as last character"); ok($data->[0]->{Key1} eq "value\#", "...data is correct"); #Comment char as first character - 3 tests ok($data = $pdc->parse_mem("Key1: value\n\#oo: bar", {stripComments => 1}), "Parse with comment as first character"); ok($data->[0]->{Key1} eq "value", "...data is correct"); ok(keys %{$data->[0]} == 1, "...data is right size"); #Literal pound as first character - 3 tests ok($data = $pdc->parse_mem("Key1: value\n\#\#oo: bar", {stripComments => 1}), "Parse with literal pound as first character"); ok($data->[0]->{Key1} eq "value", "...data is correct"); ok($data->[0]->{"\#oo"} eq "bar", "...pound-key character is correct"); #Line skip - 3 tests ok($data = $pdc->parse_mem("Key1: value\n#hello there#\nKey2: value2", {stripComments => 1}), "Parse with line skip"); ok($data->[0]->{Key1} eq "value", "...first value is correct"); ok($data->[0]->{Key2} eq "value2", "...second value is correct"); #Line skip; leading whitespace - 3 tests ok($data = $pdc->parse_mem("Key1: value\n #hello there#\nKey2: value2", {stripComments => 1}), "Parse with line skip and leading space"); ok($data->[0]->{Key1} eq "value", "...first value is correct"); ok($data->[0]->{Key2} eq "value2", "...second value is correct"); Parse-DebControl-2.005/t/10objects.t0100644000175000017500000000045707665371160017245 0ustar jayboncijaybonci#!/usr/bin/perl -w use Test::More tests => 6; BEGIN { chdir 't' if -d 't'; use lib '../blib/lib', 'lib/', '..'; } my $mod = "Parse::DebControl"; use_ok("IO::Scalar"); use_ok($mod); can_ok($mod, "new"); can_ok($mod, "parse_file"); can_ok($mod, "parse_mem"); can_ok($mod, "DEBUG"); Parse-DebControl-2.005/t/32trygzip.t0100644000175000017500000000255207726160733017326 0ustar jayboncijaybonci#!/usr/bin/perl -w use Test::More tests => 13; use Compress::Zlib; BEGIN { chdir 't' if -d 't'; use lib '../blib/lib', 'lib/', '..'; } my $mod = "Parse::DebControl"; #Object initialization - 1 test use_ok($mod); ok($pdc = new Parse::DebControl(), "Parser object creation works fine"); #tryGzip - 6 tests $pdc = new Parse::DebControl(1); my $string = "Key1: value1\nKey2: value2\nKey3: value3"; my $gzdata = Compress::Zlib::memGzip($string); my $gzcopy = $gzdata; ok(Compress::Zlib::memGunzip($gzcopy) eq $string, "memGunzip is sane"); ok($data = $pdc->parse_mem($gzdata, {"tryGzip" => 1}), "Parse with gzip works on a gzipped stanza"); ok(@$data == 1, "...and there is one stanzaa"); ok($data->[0]->{Key1} eq "value1", "...and the first value is correct"); ok($data->[0]->{Key2} eq "value2", "...and the second value is correct"); ok($data->[0]->{Key3} eq "value3", "...and the third value is correct"); #Without gzipped data, emphasis on "try" ok($data = $pdc->parse_mem($string,), "Parsing the string is sane"); ok($data = $pdc->parse_mem($string, {"tryGzip" => 1}), "Parse with gzip works on a ungzipped stanza"); ok($data->[0]->{Key1} eq "value1", "...and the first value is correct"); ok($data->[0]->{Key2} eq "value2", "...and the second value is correct"); ok($data->[0]->{Key3} eq "value3", "...and the third value is correct"); Parse-DebControl-2.005/t/41writegzip.t0100644000175000017500000000114207726162767017645 0ustar jayboncijaybonci#!/usr/bin/perl -w use Test::More tests => 3; use Compress::Zlib; BEGIN { chdir 't' if -d 't'; use lib '../blib/lib', 'lib/', '..'; } my $mod = "Parse::DebControl"; #Object initialization - 1 test use_ok($mod); ok($pdc = new Parse::DebControl(), "Parser object creation works fine"); #writegzip - 1 test $pdc = new Parse::DebControl(1); my $hash = {"Key1" => "value1", "Key2" => "value2","Key3" => "value3"}; my $gzipped = $pdc->write_mem($hash, {gzip => 1}); ok( Compress::Zlib::memGunzip($gzipped) eq $pdc->write_mem($hash), "write_mem with the gzip option is sane"); Parse-DebControl-2.005/t/20new.t0100644000175000017500000000127607665371160016406 0ustar jayboncijaybonci#!/usr/bin/perl -w use Test::More tests => 7; BEGIN { chdir 't' if -d 't'; use lib '../blib/lib', 'lib/', '..'; } my $pdc; my $mod = "Parse::DebControl"; use_ok($mod); ok($pdc = new Parse::DebControl, "Create object with 'new \$class' method"); ok($pdc = Parse::DebControl->new(), "Create object with '\$class->new()' method"); ok($pdc = new Parse::DebControl(1), "Create object with 'new \$class' method with debugging"); ok($pdc->{_verbose} == 1, "...and check to see if it actually got turned on"); ok($pdc = Parse::DebControl->new(1), "Create object with '\$class->new' method with debugging"); ok($pdc->{_verbose} == 1, "...and check to see if it actually got turned on"); Parse-DebControl-2.005/t/30parse.t0100644000175000017500000001400307725161657016725 0ustar jayboncijaybonci#!/usr/bin/perl -w use Test::More tests => 62; BEGIN { chdir 't' if -d 't'; use lib '../blib/lib', 'lib/', '..'; } my $mod = "Parse::DebControl"; #Object initialization - 2 tests use_ok($mod); ok($pdc = new Parse::DebControl(), "Parser object creation works fine"); #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"); #Single item (no ending newline) parsing - 8 tests my $data; ok($data = $pdc->parse_mem("Description: foo"), "Parser for one-line returns valid data"); ok(exists($data->[0]->{Description}), "...and the data exists"); ok($data->[0]->{Description} eq "foo", "...and is the correct value"); ok(@$data == 1, "...and there's only one stanza"); ok(keys %{$data->[0]} == 1, "...and there's only item in the stanza"); ok($data = $pdc->parse_mem("Description: foo "), "Parser for one-line with trailing whitespace"); ok(exists($data->[0]->{Description}), "...and the data exists"); ok($data->[0]->{Description} eq "foo", "...and is the correct whitespace-stripped-value"); #Multiple item (no ending newline) parsing - 6 tests ok($data = $pdc->parse_mem("Item: value1\nOtherItem : value2\nFinalItem:value3"), "Multiple items read in correctly"); ok(@$data == 1, "...and there's only one stanza"); ok(keys %{$data->[0]} == 3, "...and there are three items in the stanza"); ok($data->[0]->{Item} eq "value1", "...and the first key is correct"); ok($data->[0]->{OtherItem} eq "value2", "...and the second key is correct"); ok($data->[0]->{FinalItem} eq "value3", "...and the third key is correct"); #Multiple Stanza (with ending newline) parsing - 9 tests # These tests also make sure we strip off ending newlines ok($data = $pdc->parse_mem("Title: hello\nSection: unknown\n\nManifest: 12345.67890\nOther: value\nThreshold : unknown\n\n\n"), "Parses in a complex structure, and returns valid data"); ok(@$data == 2, "...and there are two stanzas"); ok(keys %{$data->[0]} == 2, "...and the first stanza is the right size"); ok(keys %{$data->[1]} == 3, "...and the second stanza is the right size"); ok($data->[0]->{Title} eq "hello", "First stanza: The first data piece is correct"); ok($data->[0]->{Section} eq "unknown", "...and the second data piece"); ok($data->[1]->{Manifest} eq "12345.67890", "Second stanza: and the (numeric) first data piece"); ok($data->[1]->{Other} eq "value", "...and the second value"); ok($data->[1]->{Threshold} eq "unknown", "...and the third value"); #Single Stanza (overflowline no ending newline) parsing - 4 tests # Here we make sure multilines and period-only lines get stripped ok($data = $pdc->parse_mem("Description: Item1\n Hello\n World\n .\n Again"), "Parse a complex multi-line, single-stanza structure"); ok(@$data == 1, "...and there is one stanza"); ok(keys %{$data->[0]} == 1, "...and the first stanza is the right size"); ok($data->[0]->{Description} eq "Item1\nHello\nWorld\n\nAgain", "...and the data is correct"); #Single Stanza (Tie::IxHash test) - 6 tests SKIP: { eval { require Tie::IxHash }; skip "Tie::IxHash is not installed", 6 if($@); ok($data = $pdc->parse_mem("Description: item\nCorona: GoodWithLime\nOther-Item: here\n\n", {'useTieIxHash' => 1}), "Parse a single stanza item with Tie::IxHash support"); ok(@$data == 1, "...and there is one stanza"); ok(keys %{$data->[0]} == 3, "...and the stanza is the right size"); ok((keys %{$data->[0]})[0] eq "Description", "...and the order is right (first item)"); ok((keys %{$data->[0]})[1] eq "Corona", "...and the order is right (second item)"); ok((keys %{$data->[0]})[2] eq "Other-Item", "...and the order is right (third item)"); } #Single Stanza using caseDiscard - 6 tests ok($data = $pdc->parse_mem("Key1: value1\nKey2: value2\nKEY3: Value3", {'discardCase' => 1}), "Parse a simple structure with discardCase"); ok(@$data == 1, "...and there is one stanza"); ok(keys %{$data->[0]} == 3, "...and the stanza is the right size"); ok((exists($data->[0]->{key1}) and $data->[0]->{key1} eq "value1"), "The first entry exists and has the right value"); ok((exists($data->[0]->{key2}) and $data->[0]->{key2} eq "value2"), "...and the second value"); ok((exists($data->[0]->{key3}) and $data->[0]->{key3} eq "Value3"), "...and the third value"); #Side conditions - 4 tests ok($data = $pdc->parse_mem("Key1:\nKey2: value2\nkey3: value3"), "Parse a simple structure with a bad (blank) value"); ok(@$data == 1, "...and there is one stanza"); ok(keys %{$data->[0]} == 3, "...and the stanza is the right size"); ok($data->[0]->{Key1} eq "", "...and the blank key is correct"); #verbatim tests - 10 tests ok($data = $pdc->parse_mem("Key1: value1\n Testing1\n Testing2\n Testing3", {verbMultiLine => 1}), "Multiline verbatim option parses correctly"); ok(@$data == 1,"...and there is one stanza"); ok(keys %{$data->[0]} == 1, "...and the first stanza is the right size"); ok($data->[0]->{Key1} eq "value1\n Testing1\n Testing2\n Testing3", "...and the data works out correctly"); ok($data = $pdc->parse_mem("Key1: value1\n Testing1\n .\n Testing2", {verbMultiLine => 1}), "Multiline verbatim option parses correctly (with a period line"); ok(@$data == 1, "...and there is one stanza"); ok(keys %{$data->[0]} == 1, "...and the first stanza is the right size"); ok($data->[0]->{Key1} eq "value1\n Testing1\n .\n Testing2", "... and the dot stays in per expected behaviour"); ok($data = $pdc->parse_mem("Key1: value1 ", {verbMultiLine => 1}), "Single line verbatim option parses correctly, (verbatim whitespace save test)"); ok($data->[0]->{Key1} eq "value1 ", "verbMultiLine does not collapse trailing whitespace"); #CRLF tests - 5 tests ok($data = $pdc->parse_mem("Key1: value1\r\nKey2: Value2 \r\n"), "CRLF parses correctly"); ok(@$data == 1, "...and there is one stanza"); ok(keys %{$data->[0]} == 2, "...and the firest stanza is the right size"); ok($data->[0]->{Key1} eq "value1", "...and the first valus is correct"); ok($data->[0]->{Key2} eq "Value2", "...and the second value is correct"); Parse-DebControl-2.005/t/51podcoverage.t0100644000175000017500000000047410000700352020066 0ustar jayboncijaybonci#!/usr/bin/perl -w use strict; use Test::More tests => 1; push @INC, "./lib"; eval "use Pod::Coverage"; SKIP: { skip "Pod::Coverage required for documentation check",1 if($@); my $pc = Pod::Coverage->new(package => "Parse::DebControl"); ok($pc->coverage == 1, "Pod::Coverage documentation overview is ok"); } Parse-DebControl-2.005/MANIFEST0100644000175000017500000000044107776610036016146 0ustar jayboncijayboncilib/Parse/DebControl.pm t/10objects.t t/20new.t t/30parse.t t/31stripcomments.t t/32trygzip.t t/33parseweb.t t/40write.t t/41writegzip.t t/42writefile.t t/50pod.t t/51podcoverage.t Makefile.PL MANIFEST CHANGES META.yml Module meta-data (added by MakeMaker) Parse-DebControl-2.005/CHANGES0100644000175000017500000000700310000700707015764 0ustar jayboncijaybonciCHANGES Version 2.005 - January 13th, 2004 * More generic test suite fix for earlier versions of Test::More * Updated copyright statement Version 2.004 - January 12th, 2004 * More documentation formatting and typo fixes * CHANGES file now generated automatically * Fixes for potential test suite failure in Pod::Coverage run * Adds the "addNewline" option to write_file to solve the streaming stanza problem. * Adds tests for the addNewline option Version 2.003 - January 6th, 2004 * Added optional Test::Pod test * Skips potential Win32 test failure in the module where it wants to write to /tmp. * Added optional Pod::Coverage test Version 2.002 - October 7th, 2003 * No code changes. Fixes to test suite Version 2.001 - September 11th, 2003 * Cleaned up more POD errors * Added tests for file writing * Fixed bug where write_file ignored the gzip parameter Version 2.0 - September 5th, 2003 * Version increase. * Added gzip support (with the tryGzip option), so that compresses control files can be parsed on the fly * Added gzip support for writing of control files * Added parse_web to snag files right off the web. Useful for things such as apt's Sources.gz and Packages.gz Version 1.10b - September 2nd, 2003 * Documentation fix for ## vs # in stripComments Version 1.10 - September 2nd, 2003 * Documentation fixes, as pointed out by pudge * Adds a feature to stripComments where ## will get interpolated as a literal pound sign, as suggested by pudge. Version 1.9 - July 24th, 2003 * Fix for warning for edge case (uninitialized value in chomp) * Tests for CRLF Version 1.8 - July 11th, 2003 * By default, we now strip off whitespace unless verbMultiLine is in place. This makes sense for things like conf files where trailing whitespace has no meaning. Thanks to pudge for reporting this. Version 1.7 - June 25th, 2003 * POD documentation error noticed again by Frank Lichtenheld * Also by Frank, applied a patch to add a "verbMultiLine" option so that we can hand multiline fields back unparsed. * Slightly expanded test suite to cover new features Version 1.6.1 - June 9th, 2003 * POD cleanups noticed by Frank Lichtenheld. Thank you, Frank. Version 1.6 - June 2nd, 2003 * Cleaned up some warnings when you pass in empty hashrefs or arrayrefs * Added stripComments setting * Cleaned up POD errors Version 1.5 - May 8th, 2003 * Added a line to quash errors with undef hashkeys and writing * Fixed the Makefile.PL to straighten up DebControl.pm being in the wrong dir Version 1.4 - April 30th, 2003 * Removed exports as they were unnecessary. Many thanks to pudge, who pointed this out. Version 1.3 - April 28th, 2003 * Fixed a bug where writing blank stanzas would throw a warning. Fix found and supplied by Nate Oostendorp. Version 1.2b - April 25th, 2003 Fixed: * A bug in the test suite where IxHash was not disabled in 40write.t. Thanks to Jeroen Latour from cpan-testers for the report. Version 1.2 - April 24th, 2003 Fixed: * A bug in IxHash support where multiple stanzas might be out of order Version 1.1 - April 23rd, 2003 Added: * Writing support * Tie::IxHash support * Case insensitive reading support Version 1.0 - April 23rd, 2003 * This is the initial public release for CPAN, so everything is new. Parse-DebControl-2.005/lib/0040755000175000017500000000000010000700705015540 5ustar jayboncijaybonciParse-DebControl-2.005/lib/Parse/0040755000175000017500000000000010000700705016612 5ustar jayboncijaybonciParse-DebControl-2.005/lib/Parse/DebControl.pm0100644000175000017500000004241310000700640021202 0ustar jayboncijayboncipackage Parse::DebControl; ########################################################### # Parse::DebControl - Parse debian-style control # files (and other colon key-value fields) # # Copyright 2003 - Jay Bonci # Licensed under the same terms as perl itself # ########################################################### use strict; use IO::Scalar; use Compress::Zlib; use LWP::UserAgent; use vars qw($VERSION); $VERSION = '2.005'; sub new { my ($class, $debug) = @_; my $this = {}; my $obj = bless $this, $class; if($debug) { $obj->DEBUG(); } return $obj; }; sub parse_file { my ($this, $filename, $options) = @_; unless($filename) { $this->_dowarn("parse_file failed because no filename parameter was given"); return; } my $fh; unless(open($fh,"$filename")) { $this->_dowarn("parse_file failed because $filename could not be opened for reading"); return; } return $this->_parseDataHandle($fh, $options); }; sub parse_mem { my ($this, $data, $options) = @_; unless($data) { $this->_dowarn("parse_mem failed because no data was given"); return; } my $IOS = new IO::Scalar \$data; unless($IOS) { $this->_dowarn("parse_mem failed because IO::Scalar creation failed."); return; } return $this->_parseDataHandle($IOS, $options); }; sub parse_web { my ($this, $url, $options) = @_; unless($url) { $this->_dowarn("No url given, thus no data to parse"); return; } my $ua = LWP::UserAgent->new; my $request = HTTP::Request->new(GET => $url); unless($request) { $this->_dowarn("Failed to instantiate HTTP Request object"); return; } my $response = $ua->request($request); if ($response->is_success) { return $this->parse_mem($response->content(), $options); } else { $this->_dowarn("Failed to fetch $url from the web"); return; } } sub write_file { my ($this, $filenameorhandle, $dataorarrayref, $options) = @_; unless($filenameorhandle) { $this->_dowarn("write_file failed because no filename or filehandle was given"); return; } unless($dataorarrayref) { $this->_dowarn("write_file failed because no data was given"); return; } my $handle = $this->_getValidHandle($filenameorhandle, $options); unless($handle) { $this->_dowarn("write_file failed because we couldn't negotiate a valid handle"); return; } my $string = $this->write_mem($dataorarrayref, $options); $string ||= ""; print $handle $string; close $handle; return length($string); } sub write_mem { my ($this, $dataorarrayref, $options) = @_; unless($dataorarrayref) { $this->_dowarn("write_mem failed because no data was given"); return; } my $arrayref = $this->_makeArrayref($dataorarrayref); my $string = $this->_makeControl($arrayref); $string .= "\n" if $options->{addNewline}; $string = Compress::Zlib::memGzip($string) if $options->{gzip}; return $string; } sub DEBUG { my($this, $verbose) = @_; $verbose = 1 unless(defined($verbose) and int($verbose) == 0); $this->{_verbose} = $verbose; return; } sub _getValidHandle { my($this, $filenameorhandle, $options) = @_; if(ref $filenameorhandle eq "GLOB") { unless($filenameorhandle->opened()) { $this->_dowarn("Can't get a valid filehandle to write to, because that is closed"); return; } return $filenameorhandle; }else { my $openmode = ">>"; $openmode=">" if $options->{clobberFile}; $openmode=">>" if $options->{appendFile}; my $handle; unless(open $handle,"$openmode$filenameorhandle") { $this->_dowarn("Couldn't open file: $openmode$filenameorhandle for writing"); return; } return $handle; } } sub _makeArrayref { my ($this, $dataorarrayref) = @_; if(ref $dataorarrayref eq "ARRAY") { return $dataorarrayref; }else{ return [$dataorarrayref]; } } sub _makeControl { my ($this, $dataorarrayref) = @_; my $str = ""; foreach my $stanza(@$dataorarrayref) { foreach my $key(keys %$stanza) { $stanza->{$key} ||= ""; my @lines = split("\n", $stanza->{$key}); if (@lines) { $str.="$key\: ".(shift @lines)."\n"; } else { $str.="$key\:\n"; } foreach(@lines) { if($_ eq "") { $str.=" .\n"; } else{ $str.=" $_\n"; } } } $str ||= ""; $str.="\n"; } chomp($str); return $str; } sub _parseDataHandle { my ($this, $handle, $options) = @_; my $structs; unless($handle) { $this->_dowarn("_parseDataHandle failed because no handle was given. This is likely a bug in the module"); return; } if($options->{tryGzip}) { if(my $gunzipped = $this->_tryGzipInflate($handle)) { $handle = new IO::Scalar \$gunzipped } } my $data = $this->_getReadyHash($options); my $linenum = 0; my $lastfield = ""; foreach my $line (<$handle>) { #Sometimes with IO::Scalar, lines may have a newline at the end #$line =~ s/\r??\n??$//; #CRLF fix, but chomp seems to clean it chomp $line; if($options->{stripComments}){ next if $line =~ /^\s*\#[^\#]/; $line =~ s/\#$//; $line =~ s/(?<=[^\#])\#[^\#].*//; $line =~ s/\#\#/\#/; } $linenum++; if($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); } unless($options->{verbMultiLine}) { $value =~ s/[\s\t]+$//; } $data->{$key} = $value; if ($options->{verbMultiLine} && (($data->{$lastfield} || "") =~ /\n/o)){ $data->{$lastfield} .= "\n"; } $lastfield = $key; }else{ $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) { $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 "." ){ $data->{$lastfield}.="\n"; }else{ my $val = $2; $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{ $this->_dowarn("Parse error on line $linenum of data; unidentified line structure"); return $structs; } } if(keys %$data > 0) { push @$structs, $data; } return $structs; } sub _tryGzipInflate { my ($this, $handle) = @_; my $buffer; { local $/ = undef; $buffer = <$handle>; } return Compress::Zlib::memGunzip($buffer) || $buffer; } sub _getReadyHash { my ($this, $options) = @_; my $data; if($options->{useTieIxHash}) { eval("use Tie::IxHash"); if($@) { $this->_dowarn("Can't use Tie::IxHash. You need to install it to have this functionality"); return; } tie(%$data, "Tie::IxHash"); return $data; } return {}; } sub _dowarn { my ($this, $warning) = @_; if($this->{_verbose}) { warn "DEBUG: $warning"; } return; } 1; __END__ =head1 NAME Parse::DebControl - Easy OO parsing of debian control-like files =head1 SYNOPSIS use Parse::DebControl $parser = new Parse::DebControl; $data = $parser->parse_mem($control_data, $options); $data = $parser->parse_file('./debian/control', $options); $data = $parser->parse_web($url, $options); $writer = new Parse::DebControl; $string = $writer->write_mem($singlestanza); $string = $writer->write_mem([$stanza1, $stanza2]); $writer->write_file($filename, $singlestanza, $options); $writer->write_file($filename, [$stanza1, $stanza2], $options); $writer->write_file($handle, $singlestanza, $options); $writer->write_file($handle, [$stanza1, $stanza2], $options); $parser->DEBUG(); =head1 DESCRIPTION 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. =head2 Class Methods =over 4 =item * C =item * C)> Returns a new Parse::DebControl object. If a true parameter I<$debug> is passed in, it turns on debugging, similar to a call to C (see below); =back =over 4 =item * C)> Takes a filename as a scalar and an optional hashref of options (see below). Will parse as much as it can, warning (if Cing is turned on) on parsing errors. Returns an array of hashrefs, containing the data in the control file, split up by stanza. Stanzas are deliniated by newlines, and multi-line fields are expressed as such post-parsing. Single periods are treated as special extra newline deliniators, per convention. Whitespace is also stripped off of lines as to make it less-easy to make mistakes with hand-written conf files). The options hashref can take parameters as follows. Setting the string to true enables the option. useTieIxHash - Instead of an array of regular hashrefs, uses Tie::IxHash- based hashrefs discardCase - Remove all case items from keys (not values) stripComments - Remove all commented lines in standard #comment format. Literal #'s are represented by ##. For instance Hello there #this is a comment Hello there, I like ##CCCCCC as a grey. The first is a comment, the second is a literal "#". verbMultiLine - Keep the description AS IS, and no not collapse leading spaces or dots as newlines. This also keeps whitespace from being stripped off the end of lines. tryGzip - Attempt to expand the data chunk with gzip first. If the text is already expanded (ie: plain text), parsing will continue normally. This could optionally be turned on for all items in the future, but it is off by default so we don't have to scrub over all the text for performance reasons. =back =over 4 =item * C)> Similar to C, except takes data as a scalar. Returns the same array of hashrefs as C. The options hashref is the same as C as well; see above. =back =over 4 =item * C)> Similar to the other parse_* functions, this pulls down a control file from the web and attempts to parse it. For options and return values, see C, above =back =over 4 =item * C)> =item * C =item * C)> =item * C 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 on your hash sorting order. If you care, use Tie::IxHash. Remember for reading back in, the module doesn't care. The I<$options> hashref can contain one of the following two items: addNewline - At the end of the last stanza, add an additional newline. appendFile - (default) Write to the end of the file clobberFile - Overwrite the file given. gzip - Compress the data with gzip before writing Since you determine the mode of your filehandle, passing it along with an options hashref obviously won't do anything; rather, it is ignored. The I option solves a situation where if you are writing stanzas to a file in a loop (such as logging with this module), then the data will be streamed together, and won't parse back in correctly. It is possible that this is the behavior that you want (if you wanted to write one key at a time), so it is optional. This function returns the number of bytes written to the file, undef otherwise. =back =over 4 =item * C =item * C; This function works similarly to the C method, except it returns the control structure as a scalar, instead of writing it to a file. There is no I<%options> for this file (yet); =back =over 4 =item * C Turns on debugging. Calling it with no paramater 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. =back =head1 CHANGES B - January 13th, 2004 =over 4 =item * More generic test suite fix for earlier versions of Test::More =item * Updated copyright statement =back B - January 12th, 2004 =over 4 =item * More documentation formatting and typo fixes =item * CHANGES file now generated automatically =item * Fixes for potential test suite failure in Pod::Coverage run =item * Adds the "addNewline" option to write_file to solve the streaming stanza problem. =item * Adds tests for the addNewline option =back B - January 6th, 2004 =over 4 =item * Added optional Test::Pod test =item * Skips potential Win32 test failure in the module where it wants to write to /tmp. =item * Added optional Pod::Coverage test =back B - October 7th, 2003 =over 4 =item * No code changes. Fixes to test suite =back B - September 11th, 2003 =over 4 =item * Cleaned up more POD errors =item * Added tests for file writing =item * Fixed bug where write_file ignored the gzip parameter =back B - September 5th, 2003 =over 4 =item * Version increase. =item * Added gzip support (with the tryGzip option), so that compresses control files can be parsed on the fly =item * Added gzip support for writing of control files =item * Added parse_web to snag files right off the web. Useful for things such as apt's Sources.gz and Packages.gz =back B - September 2nd, 2003 =over 4 =item * Documentation fix for ## vs # in stripComments =back B - September 2nd, 2003 =over 4 =item * Documentation fixes, as pointed out by pudge =item * Adds a feature to stripComments where ## will get interpolated as a literal pound sign, as suggested by pudge. =back B - July 24th, 2003 =over 4 =item * Fix for warning for edge case (uninitialized value in chomp) =item * Tests for CRLF =back B - July 11th, 2003 =over 4 =item * By default, we now strip off whitespace unless verbMultiLine is in place. This makes sense for things like conf files where trailing whitespace has no meaning. Thanks to pudge for reporting this. =back B - June 25th, 2003 =over 4 =item * POD documentation error noticed again by Frank Lichtenheld =item * Also by Frank, applied a patch to add a "verbMultiLine" option so that we can hand multiline fields back unparsed. =item * Slightly expanded test suite to cover new features =back B - June 9th, 2003 =over 4 =item * POD cleanups noticed by Frank Lichtenheld. Thank you, Frank. =back B - June 2nd, 2003 =over 4 =item * Cleaned up some warnings when you pass in empty hashrefs or arrayrefs =item * Added stripComments setting =item * Cleaned up POD errors =back B - May 8th, 2003 =over 4 =item * Added a line to quash errors with undef hashkeys and writing =item * Fixed the Makefile.PL to straighten up DebControl.pm being in the wrong dir =back B - April 30th, 2003 =over 4 =item * Removed exports as they were unnecessary. Many thanks to pudge, who pointed this out. =back B - April 28th, 2003 =over 4 =item * Fixed a bug where writing blank stanzas would throw a warning. Fix found and supplied by Nate Oostendorp. =back B - April 25th, 2003 Fixed: =over 4 =item * A bug in the test suite where IxHash was not disabled in 40write.t. Thanks to Jeroen Latour from cpan-testers for the report. =back B - April 24th, 2003 Fixed: =over 4 =item * A bug in IxHash support where multiple stanzas might be out of order =back B - April 23rd, 2003 Added: =over 4 =item * Writing support =item * Tie::IxHash support =item * Case insensitive reading support =back B - April 23rd, 2003 =over 4 =item * This is the initial public release for CPAN, so everything is new. =back =head1 BUGS The module will let you parse otherwise illegal key-value pairs and pairs with spaces. Badly formed stanzas will do things like overwrite duplicate keys, etc. This is your problem. As of 1.10, the module uses advanced regexp's to figure out about comments. If the tests fail, then stripComments won't work on your earlier perl version (should be fine on 5.6.0+) =head1 TODO Change the name over to the Debian:: namespace, probably as Debian::ControlFormat. This will happen as soon as the project that uses this module reaches stability, and we can do some minor tweaks. =head1 COPYRIGHT Parse::DebControl is copyright 2003,2004 Jay Bonci Ejaybonci@cpan.orgE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Parse-DebControl-2.005/META.yml0100644000175000017500000000077510000700704016250 0ustar jayboncijaybonci# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Parse-DebControl version: 2.005 version_from: lib/Parse/DebControl.pm installdirs: site requires: Compress::Zlib: 0 IO::Scalar: 2.104 LWP::Simple: 0 LWP::UserAgent: 0 Test::More: 0.45 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 Parse-DebControl-2.005/Makefile.PL0100644000175000017500000000146510000613310016742 0ustar jayboncijaybonciuse ExtUtils::MakeMaker; my $mod = my $pm = "Parse::DebControl"; $pm =~ s/::/\//g; $pm = "lib/$pm.pm"; unless(-e "CHANGES") { open CHANGES,">>CHANGES"; print CHANGES "Temp CHANGES file\n"; close CHANGES; } WriteMakefile( 'NAME' => $mod, 'VERSION_FROM' => $pm, # finds $VERSION 'PREREQ_PM' => { 'Test::More' => '0.45', 'IO::Scalar' => '2.104', 'Compress::Zlib' => '0', 'LWP::UserAgent' => '0', 'LWP::Simple' => '0', }, 'dist' => { #Auto-generate the CHANGES file PREOP => "podselect $pm -section CHANGES | pod2text -w 1000 -i 5 | perl -pe \"s/^\s+(Version.*)/\$1/g;\" > CHANGES", }, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 ( ABSTRACT_FROM => $pm, # retrieve abstract from module AUTHOR => 'Jay Bonci ') : ()), );