1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
From: Niels Thykier <niels@thykier.net>
Date: Sat, 14 Sep 2013 11:55:01 +0200
Subject: P::DC: Support open handles as input
---
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 0916b44..05571bb 100644
--- a/bin/parsechangelog
+++ b/bin/parsechangelog
@@ -211,8 +211,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 ])) {
|
