Package: libparse-debianchangelog-perl
Version: 1.2.0-1
Severity: wishlist
Tags: patch
Hi,
I have devised a patch, which makes Parse::DebianChangelog accept open
handles as an input source (instead of just filenames or strings).
A side-effect of this is that parsechangelog no longer needs to slurp
the entire changelog file before starting to parse it.
~Niels
>From df4d8784680fee1c3d593aee32d7a2e782cfabbc Mon Sep 17 00:00:00 2001
From: Niels Thykier <ni...@thykier.net>
Date: Sat, 14 Sep 2013 11:55:01 +0200
Subject: [PATCH] P::DC: Support open handles as input
Signed-off-by: Niels Thykier <ni...@thykier.net>
---
bin/parsechangelog | 3 +--
lib/Parse/DebianChangelog.pm | 31 ++++++++++++++++++++++++-------
t/Parse-DebianChangelog.t | 39 +++++++++++++++++++++++++--------------
3 files changed, 50 insertions(+), 23 deletions(-)
diff --git a/bin/parsechangelog b/bin/parsechangelog
index 7bff43d..3398900 100644
--- a/bin/parsechangelog
+++ b/bin/parsechangelog
@@ -216,8 +216,7 @@ my $changes = Parse::DebianChangelog->init();
$file ||= $default_file;
if ($file eq '-') {
- my @input = <STDIN>;
- $changes->parse({ instring => join('', @input) })
+ $changes->parse({ handle => \*STDIN, handlename => '<stdin>' })
or die sprintf( gettext('fatal error occured while parsing %s')."\n",
'input' );
} else {
diff --git a/lib/Parse/DebianChangelog.pm b/lib/Parse/DebianChangelog.pm
index dbb1531..bec10f9 100644
--- a/lib/Parse/DebianChangelog.pm
+++ b/lib/Parse/DebianChangelog.pm
@@ -115,10 +115,10 @@ There are currently no supported general configuration options, but
see the other methods for more specific configuration options which
can also specified to C<init>.
-If C<infile> or C<instring> are specified (see L<parse>), C<parse()>
-is called from C<init>. If a fatal error is encountered during parsing
-(e.g. the file can't be opened), C<init> will not return a
-valid object but C<undef>!
+If C<infile>, C<instring> or C<handle> are specified (see L<parse>),
+C<parse()> is called from C<init>. If a fatal error is encountered
+during parsing (e.g. the file can't be opened), C<init> will not
+return a valid object but C<undef>!
=cut
@@ -134,7 +134,8 @@ sub init {
$self->init_filters;
$self->reset_parse_errors;
- if ($self->{config}{infile} || $self->{config}{instring}) {
+ if ($self->{config}{infile} || $self->{config}{instring}
+ || $self->{config}{handle}) {
defined($self->parse) or return undef;
}
@@ -250,8 +251,10 @@ sub get_error {
=head3 parse
-Parses either the file named in configuration item C<infile> or the string
-saved in configuration item C<instring>.
+Parses either the file named in configuration item C<infile>, the string
+saved in configuration item C<instring> or the open file handle saved
+in the configuration item C<handle>. In the latter case, the handle can
+be named by using the optional configuration item C<handlename>.
Accepts a hash ref as optional argument which can contain configuration
items.
@@ -294,6 +297,20 @@ sub parse {
}
$fh = IO::String->new( $string );
$file = 'String';
+ } elsif ($fh = $self->{config}{handle}) {
+ # Scalar::Util is in perlcore, so we can rely on its presence.
+ # (also, if it is broken, then most of perl is as well).
+ require Scalar::Util;
+ if (not Scalar::Util::openhandle($fh)) {
+ $self->_do_fatal_error( __g('handle is not open'));
+ return undef;
+ }
+
+ $file = $self->{config}{handlename};
+ if (not defined($file)) {
+ $file = '<unnamed-handle>';
+ $file = '<stdin>' if (fileno($fh)//-1) == 0;
+ }
} else {
$self->_do_fatal_error( __g( 'no changelog file specified' ));
return undef;
diff --git a/t/Parse-DebianChangelog.t b/t/Parse-DebianChangelog.t
index f3b8270..fe10f6e 100644
--- a/t/Parse-DebianChangelog.t
+++ b/t/Parse-DebianChangelog.t
@@ -17,7 +17,7 @@ BEGIN {
my $no_err_examples = 1;
my $no_tests = $no_examples * 13
+ $no_err_examples * 2
- + 49;
+ + 51;
require Test::More;
import Test::More tests => $no_tests, ;
@@ -225,19 +225,30 @@ foreach my $file (qw(Changes t/examples/countme t/examples/shadow)) {
}
-open CHANGES, '<', 't/examples/countme';
-my $string = join('',<CHANGES>);
-
-my $str_changes = Parse::DebianChangelog->init( { instring => $string,
- quiet => 1 } );
-my $errors = $str_changes->get_parse_errors();
-ok( !$errors,
- "Parse example changelog t/examples/countme without errors from string" );
-
-my $str_data = $str_changes->rfc822_str({ all => 1 });
-is( $str_data, $save_data,
- "Compare result of parse from string with result of parse from file" );
-
+for my $i (0..1) {
+ open my $fh, '<', 't/examples/countme' or die "open t/examples/countme: $!";
+ my $str_changes;
+ my $type;
+ if ($i == 0) {
+ my $string = join('', <$fh>);
+
+ $str_changes = Parse::DebianChangelog->init( { instring => $string,
+ quiet => 1 } );
+ $type = 'string';
+ } else {
+ $str_changes = Parse::DebianChangelog->init( { handle => $fh,
+ quiet => 1 } );
+ $type = 'handle';
+ }
+ my $errors = $str_changes->get_parse_errors();
+ ok( !$errors,
+ "Parse example changelog t/examples/countme without errors from $type" );
+
+ my $str_data = $str_changes->rfc822_str({ all => 1 });
+ is( $str_data, $save_data,
+ "Compare result of parse from $type with result of parse from file" );
+ close $fh;
+}
foreach my $test (( [ 't/examples/misplaced-tz', 6 ])) {
--
1.8.4.rc3
