File Coverage

blib/lib/Dpkg/Changelog/Entry.pm
Criterion Covered Total %
statement 62 95 65.2
branch 10 32 31.2
condition 4 7 57.1
subroutine 15 25 60.0
pod 16 16 100.0
total 107 175 61.1


line stmt bran cond sub pod time code
1             # Copyright © 2009 Raphaël Hertzog
2             #
3             # This program is free software; you can redistribute it and/or modify
4             # it under the terms of the GNU General Public License as published by
5             # the Free Software Foundation; either version 2 of the License, or
6             # (at your option) any later version.
7             #
8             # This program is distributed in the hope that it will be useful,
9             # but WITHOUT ANY WARRANTY; without even the implied warranty of
10             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11             # GNU General Public License for more details.
12             #
13             # You should have received a copy of the GNU General Public License
14             # along with this program. If not, see .
15              
16             package Dpkg::Changelog::Entry;
17              
18 2     2   14 use strict;
  2         4  
  2         60  
19 2     2   11 use warnings;
  2         3  
  2         77  
20              
21             our $VERSION = '1.01';
22              
23 2     2   11 use Carp;
  2         4  
  2         112  
24              
25 2     2   13 use Dpkg::Gettext;
  2         2  
  2         117  
26 2     2   12 use Dpkg::ErrorHandling;
  2         3  
  2         184  
27 2     2   14 use Dpkg::Control::Changelog;
  2         8  
  2         216  
28              
29             use overload
30             '""' => \&output,
31 0 0   0   0 'eq' => sub { defined($_[1]) and "$_[0]" eq "$_[1]" },
32 2     2   21 fallback => 1;
  2         6  
  2         26  
33              
34             =encoding utf8
35              
36             =head1 NAME
37              
38             Dpkg::Changelog::Entry - represents a changelog entry
39              
40             =head1 DESCRIPTION
41              
42             This class represents a changelog entry. It is composed
43             of a set of lines with specific purpose: an header line, changes lines, a
44             trailer line. Blank lines can be between those kind of lines.
45              
46             =head1 METHODS
47              
48             =over 4
49              
50             =item $entry = Dpkg::Changelog::Entry->new()
51              
52             Creates a new object. It doesn't represent a real changelog entry
53             until one has been successfully parsed or built from scratch.
54              
55             =cut
56              
57             sub new {
58 250     250 1 445 my $this = shift;
59 250   33     733 my $class = ref($this) || $this;
60              
61 250         1286 my $self = {
62             header => undef,
63             changes => [],
64             trailer => undef,
65             blank_after_header => [],
66             blank_after_changes => [],
67             blank_after_trailer => [],
68             };
69 250         560 bless $self, $class;
70 250         566 return $self;
71             }
72              
73             =item $str = $entry->output()
74              
75             =item "$entry"
76              
77             Get a string representation of the changelog entry.
78              
79             =item $entry->output($fh)
80              
81             Print the string representation of the changelog entry to a
82             filehandle.
83              
84             =cut
85              
86             sub _format_output_block {
87 1528     1528   1992 my $lines = shift;
88 1528         1786 return join('', map { $_ . "\n" } @{$lines});
  3786         8190  
  1528         2343  
89             }
90              
91             sub output {
92 382     382 1 18723 my ($self, $fh) = @_;
93 382         512 my $str = '';
94 382 50       1025 $str .= $self->{header} . "\n" if defined($self->{header});
95 382         639 $str .= _format_output_block($self->{blank_after_header});
96 382         719 $str .= _format_output_block($self->{changes});
97 382         720 $str .= _format_output_block($self->{blank_after_changes});
98 382 50       1001 $str .= $self->{trailer} . "\n" if defined($self->{trailer});
99 382         652 $str .= _format_output_block($self->{blank_after_trailer});
100 382 50       716 print { $fh } $str if defined $fh;
  0         0  
101 382         954 return $str;
102             }
103              
104             =item $entry->get_part($part)
105              
106             Return either a string (for a single line) or an array ref (for multiple
107             lines) corresponding to the requested part. $part can be
108             "header, "changes", "trailer", "blank_after_header",
109             "blank_after_changes", "blank_after_trailer".
110              
111             =cut
112              
113             sub get_part {
114 1478     1478 1 2495 my ($self, $part) = @_;
115 1478 50       2982 croak "invalid part of changelog entry: $part" unless exists $self->{$part};
116 1478         6430 return $self->{$part};
117             }
118              
119             =item $entry->set_part($part, $value)
120              
121             Set the value of the corresponding part. $value can be a string
122             or an array ref.
123              
124             =cut
125              
126             sub set_part {
127 498     498 1 1038 my ($self, $part, $value) = @_;
128 498 50       1288 croak "invalid part of changelog entry: $part" unless exists $self->{$part};
129 498 50       1002 if (ref($self->{$part})) {
130 0 0       0 if (ref($value)) {
131 0         0 $self->{$part} = $value;
132             } else {
133 0         0 $self->{$part} = [ $value ];
134             }
135             } else {
136 498         1197 $self->{$part} = $value;
137             }
138             }
139              
140             =item $entry->extend_part($part, $value)
141              
142             Concatenate $value at the end of the part. If the part is already a
143             multi-line value, $value is added as a new line otherwise it's
144             concatenated at the end of the current line.
145              
146             =cut
147              
148             sub extend_part {
149 3266     3266 1 6154 my ($self, $part, $value, @rest) = @_;
150 3266 50       6813 croak "invalid part of changelog entry: $part" unless exists $self->{$part};
151 3266 50       6229 if (ref($self->{$part})) {
152 3266 100       5056 if (ref($value)) {
153 2782         3498 push @{$self->{$part}}, @$value;
  2782         7873  
154             } else {
155 484         609 push @{$self->{$part}}, $value;
  484         1455  
156             }
157             } else {
158 0 0       0 if (defined($self->{$part})) {
159 0 0       0 if (ref($value)) {
160 0         0 $self->{$part} = [ $self->{$part}, @$value ];
161             } else {
162 0         0 $self->{$part} .= $value;
163             }
164             } else {
165 0         0 $self->{$part} = $value;
166             }
167             }
168             }
169              
170             =item $is_empty = $entry->is_empty()
171              
172             Returns 1 if the changelog entry doesn't contain anything at all.
173             Returns 0 as soon as it contains something in any of its non-blank
174             parts.
175              
176             =cut
177              
178             sub is_empty {
179 266     266 1 402 my $self = shift;
180             return !(defined($self->{header}) || defined($self->{trailer}) ||
181 266   100     1173 scalar(@{$self->{changes}}));
182             }
183              
184             =item $entry->normalize()
185              
186             Normalize the content. Strip whitespaces at end of lines, use a single
187             empty line to separate each part.
188              
189             =cut
190              
191             sub normalize {
192 0     0 1 0 my $self = shift;
193 0 0       0 if (defined($self->{header})) {
194 0         0 $self->{header} =~ s/\s+$//g;
195 0         0 $self->{blank_after_header} = [''];
196             } else {
197 0         0 $self->{blank_after_header} = [];
198             }
199 0 0       0 if (scalar(@{$self->{changes}})) {
  0         0  
200 0         0 s/\s+$//g foreach @{$self->{changes}};
  0         0  
201 0         0 $self->{blank_after_changes} = [''];
202             } else {
203 0         0 $self->{blank_after_changes} = [];
204             }
205 0 0       0 if (defined($self->{trailer})) {
206 0         0 $self->{trailer} =~ s/\s+$//g;
207 0         0 $self->{blank_after_trailer} = [''];
208             } else {
209 0         0 $self->{blank_after_trailer} = [];
210             }
211             }
212              
213             =item $src = $entry->get_source()
214              
215             Return the name of the source package associated to the changelog entry.
216              
217             =cut
218              
219             sub get_source {
220 0     0 1 0 return;
221             }
222              
223             =item $ver = $entry->get_version()
224              
225             Return the version associated to the changelog entry.
226              
227             =cut
228              
229             sub get_version {
230 0     0 1 0 return;
231             }
232              
233             =item @dists = $entry->get_distributions()
234              
235             Return a list of target distributions for this version.
236              
237             =cut
238              
239             sub get_distributions {
240 0     0 1 0 return;
241             }
242              
243             =item $fields = $entry->get_optional_fields()
244              
245             Return a set of optional fields exposed by the changelog entry.
246             It always returns a Dpkg::Control object (possibly empty though).
247              
248             =cut
249              
250             sub get_optional_fields {
251 0     0 1 0 return Dpkg::Control::Changelog->new();
252             }
253              
254             =item $urgency = $entry->get_urgency()
255              
256             Return the urgency of the associated upload.
257              
258             =cut
259              
260             sub get_urgency {
261 0     0 1 0 return;
262             }
263              
264             =item $maint = $entry->get_maintainer()
265              
266             Return the string identifying the person who signed this changelog entry.
267              
268             =cut
269              
270             sub get_maintainer {
271 0     0 1 0 return;
272             }
273              
274             =item $time = $entry->get_timestamp()
275              
276             Return the timestamp of the changelog entry.
277              
278             =cut
279              
280             sub get_timestamp {
281 0     0 1 0 return;
282             }
283              
284             =item $time = $entry->get_timepiece()
285              
286             Return the timestamp of the changelog entry as a Time::Piece object.
287              
288             This function might return undef if there was no timestamp.
289              
290             =cut
291              
292             sub get_timepiece {
293 0     0 1 0 return;
294             }
295              
296             =item $str = $entry->get_dpkg_changes()
297              
298             Returns a string that is suitable for usage in a C field
299             in the output format of C.
300              
301             =cut
302              
303             sub get_dpkg_changes {
304 738     738 1 1173 my $self = shift;
305 738   50     1478 my $header = $self->get_part('header') // '';
306 738         2541 $header =~ s/\s+$//;
307 738         1694 return "\n$header\n\n" . join("\n", @{$self->get_part('changes')});
  738         1556  
308             }
309              
310             =back
311              
312             =head1 CHANGES
313              
314             =head2 Version 1.01 (dpkg 1.18.8)
315              
316             New method: $entry->get_timepiece().
317              
318             =head2 Version 1.00 (dpkg 1.15.6)
319              
320             Mark the module as public.
321              
322             =cut
323              
324             1;