File: | Dpkg/Changelog/Entry.pm |
Coverage: | 63.2% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | # Copyright © 2009 Raphaël Hertzog <hertzog@debian.org> | ||||||
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 <https://www.gnu.org/licenses/>. | ||||||
15 | |||||||
16 | =encoding utf8 | ||||||
17 | |||||||
18 - 28 | =head1 NAME Dpkg::Changelog::Entry - represents a changelog entry =head1 DESCRIPTION This class represents a changelog entry. It is composed of a set of lines with specific purpose: a header line, changes lines, a trailer line. Blank lines can be between those kind of lines. =cut | ||||||
29 | |||||||
30 | package Dpkg::Changelog::Entry 1.01; | ||||||
31 | |||||||
32 | 18 18 18 | 48 14 319 | use strict; | ||||
33 | 18 18 18 | 32 11 606 | use warnings; | ||||
34 | |||||||
35 | 18 18 18 | 43 21 592 | use Carp; | ||||
36 | |||||||
37 | 18 18 18 | 38 16 520 | use Dpkg::Gettext; | ||||
38 | 18 18 18 | 35 15 677 | use Dpkg::ErrorHandling; | ||||
39 | 18 18 18 | 39 19 876 | use Dpkg::Control::Changelog; | ||||
40 | |||||||
41 | use overload | ||||||
42 | '""' => \&output, | ||||||
43 | 126 | 163 | 'eq' => sub { defined($_[1]) and "$_[0]" eq "$_[1]" }, | ||||
44 | 18 18 18 | 37 12 118 | fallback => 1; | ||||
45 | |||||||
46 - 55 | =head1 METHODS =over 4 =item $entry = Dpkg::Changelog::Entry->new() Creates a new object. It doesn't represent a real changelog entry until one has been successfully parsed or built from scratch. =cut | ||||||
56 | |||||||
57 | sub new { | ||||||
58 | 957 | 1 | 643 | my $this = shift; | |||
59 | 957 | 1771 | my $class = ref($this) || $this; | ||||
60 | |||||||
61 | 957 | 2767 | my $self = { | ||||
62 | header => undef, | ||||||
63 | changes => [], | ||||||
64 | trailer => undef, | ||||||
65 | blank_after_header => [], | ||||||
66 | blank_after_changes => [], | ||||||
67 | blank_after_trailer => [], | ||||||
68 | }; | ||||||
69 | 957 | 924 | bless $self, $class; | ||||
70 | 957 | 888 | return $self; | ||||
71 | } | ||||||
72 | |||||||
73 - 84 | =item $str = $entry->output() =item "$entry" Get a string representation of the changelog entry. =item $entry->output($fh) Print the string representation of the changelog entry to a filehandle. =cut | ||||||
85 | |||||||
86 | sub _format_output_block { | ||||||
87 | 7044 | 3650 | my $lines = shift; | ||||
88 | 7044 15462 7044 | 3316 13211 4388 | return join('', map { $_ . "\n" } @{$lines}); | ||||
89 | } | ||||||
90 | |||||||
91 | sub output { | ||||||
92 | 1761 | 1 | 17033 | my ($self, $fh) = @_; | |||
93 | 1761 | 972 | my $str = ''; | ||||
94 | 1761 | 1967 | $str .= $self->{header} . "\n" if defined($self->{header}); | ||||
95 | 1761 | 1326 | $str .= _format_output_block($self->{blank_after_header}); | ||||
96 | 1761 | 1211 | $str .= _format_output_block($self->{changes}); | ||||
97 | 1761 | 1267 | $str .= _format_output_block($self->{blank_after_changes}); | ||||
98 | 1761 | 1779 | $str .= $self->{trailer} . "\n" if defined($self->{trailer}); | ||||
99 | 1761 | 1171 | $str .= _format_output_block($self->{blank_after_trailer}); | ||||
100 | 1761 0 | 1384 0 | print { $fh } $str if defined $fh; | ||||
101 | 1761 | 2475 | return $str; | ||||
102 | } | ||||||
103 | |||||||
104 - 111 | =item $entry->get_part($part) Return either a string (for a single line) or an array ref (for multiple lines) corresponding to the requested part. $part can be "header, "changes", "trailer", "blank_after_header", "blank_after_changes", "blank_after_trailer". =cut | ||||||
112 | |||||||
113 | sub get_part { | ||||||
114 | 4980 | 1 | 3660 | my ($self, $part) = @_; | |||
115 | 4980 | 4730 | croak "invalid part of changelog entry: $part" unless exists $self->{$part}; | ||||
116 | 4980 | 9791 | return $self->{$part}; | ||||
117 | } | ||||||
118 | |||||||
119 - 124 | =item $entry->set_part($part, $value) Set the value of the corresponding part. $value can be a string or an array ref. =cut | ||||||
125 | |||||||
126 | sub set_part { | ||||||
127 | 1908 | 1 | 1684 | my ($self, $part, $value) = @_; | |||
128 | 1908 | 1875 | croak "invalid part of changelog entry: $part" unless exists $self->{$part}; | ||||
129 | 1908 | 1664 | if (ref($self->{$part})) { | ||||
130 | 0 | 0 | if (ref($value)) { | ||||
131 | 0 | 0 | $self->{$part} = $value; | ||||
132 | } else { | ||||||
133 | 0 | 0 | $self->{$part} = [ $value ]; | ||||
134 | } | ||||||
135 | } else { | ||||||
136 | 1908 | 1852 | $self->{$part} = $value; | ||||
137 | } | ||||||
138 | } | ||||||
139 | |||||||
140 - 146 | =item $entry->extend_part($part, $value) Concatenate $value at the end of the part. If the part is already a multi-line value, $value is added as a new line otherwise it's concatenated at the end of the current line. =cut | ||||||
147 | |||||||
148 | sub extend_part { | ||||||
149 | 11136 | 1 | 8453 | my ($self, $part, $value, @rest) = @_; | |||
150 | 11136 | 10021 | croak "invalid part of changelog entry: $part" unless exists $self->{$part}; | ||||
151 | 11136 | 7876 | if (ref($self->{$part})) { | ||||
152 | 11136 | 7299 | if (ref($value)) { | ||||
153 | 9288 9288 | 5027 10341 | push @{$self->{$part}}, @$value; | ||||
154 | } else { | ||||||
155 | 1848 1848 | 1062 2498 | push @{$self->{$part}}, $value; | ||||
156 | } | ||||||
157 | } elsif (defined $self->{$part}) { | ||||||
158 | 0 | 0 | if (ref($value)) { | ||||
159 | 0 | 0 | $self->{$part} = [ $self->{$part}, @$value ]; | ||||
160 | } else { | ||||||
161 | 0 | 0 | $self->{$part} .= $value; | ||||
162 | } | ||||||
163 | } else { | ||||||
164 | 0 | 0 | $self->{$part} = $value; | ||||
165 | } | ||||||
166 | } | ||||||
167 | |||||||
168 - 174 | =item $is_empty = $entry->is_empty() Returns 1 if the changelog entry doesn't contain anything at all. Returns 0 as soon as it contains something in any of its non-blank parts. =cut | ||||||
175 | |||||||
176 | sub is_empty { | ||||||
177 | 1041 | 1 | 718 | my $self = shift; | |||
178 | return !(defined($self->{header}) || defined($self->{trailer}) || | ||||||
179 | 1041 | 2538 | scalar(@{$self->{changes}})); | ||||
180 | } | ||||||
181 | |||||||
182 - 187 | =item $entry->normalize() Normalize the content. Strip whitespaces at end of lines, use a single empty line to separate each part. =cut | ||||||
188 | |||||||
189 | sub normalize { | ||||||
190 | 0 | 1 | 0 | my $self = shift; | |||
191 | 0 | 0 | if (defined($self->{header})) { | ||||
192 | 0 | 0 | $self->{header} =~ s/\s+$//g; | ||||
193 | 0 | 0 | $self->{blank_after_header} = ['']; | ||||
194 | } else { | ||||||
195 | 0 | 0 | $self->{blank_after_header} = []; | ||||
196 | } | ||||||
197 | 0 0 | 0 0 | if (scalar(@{$self->{changes}})) { | ||||
198 | 0 0 | 0 0 | s/\s+$//g foreach @{$self->{changes}}; | ||||
199 | 0 | 0 | $self->{blank_after_changes} = ['']; | ||||
200 | } else { | ||||||
201 | 0 | 0 | $self->{blank_after_changes} = []; | ||||
202 | } | ||||||
203 | 0 | 0 | if (defined($self->{trailer})) { | ||||
204 | 0 | 0 | $self->{trailer} =~ s/\s+$//g; | ||||
205 | 0 | 0 | $self->{blank_after_trailer} = ['']; | ||||
206 | } else { | ||||||
207 | 0 | 0 | $self->{blank_after_trailer} = []; | ||||
208 | } | ||||||
209 | } | ||||||
210 | |||||||
211 - 215 | =item $src = $entry->get_source() Return the name of the source package associated to the changelog entry. =cut | ||||||
216 | |||||||
217 | sub get_source { | ||||||
218 | 0 | 1 | 0 | return; | |||
219 | } | ||||||
220 | |||||||
221 - 225 | =item $ver = $entry->get_version() Return the version associated to the changelog entry. =cut | ||||||
226 | |||||||
227 | sub get_version { | ||||||
228 | 0 | 1 | 0 | return; | |||
229 | } | ||||||
230 | |||||||
231 - 235 | =item @dists = $entry->get_distributions() Return a list of target distributions for this version. =cut | ||||||
236 | |||||||
237 | sub get_distributions { | ||||||
238 | 0 | 1 | 0 | return; | |||
239 | } | ||||||
240 | |||||||
241 - 246 | =item $ctrl = $entry->get_optional_fields() Return a set of optional fields exposed by the changelog entry. It always returns a L<Dpkg::Control> object (possibly empty though). =cut | ||||||
247 | |||||||
248 | sub get_optional_fields { | ||||||
249 | 0 | 1 | 0 | return Dpkg::Control::Changelog->new(); | |||
250 | } | ||||||
251 | |||||||
252 - 256 | =item $urgency = $entry->get_urgency() Return the urgency of the associated upload. =cut | ||||||
257 | |||||||
258 | sub get_urgency { | ||||||
259 | 0 | 1 | 0 | return; | |||
260 | } | ||||||
261 | |||||||
262 - 266 | =item $maint = $entry->get_maintainer() Return the string identifying the person who signed this changelog entry. =cut | ||||||
267 | |||||||
268 | sub get_maintainer { | ||||||
269 | 0 | 1 | 0 | return; | |||
270 | } | ||||||
271 | |||||||
272 - 276 | =item $time = $entry->get_timestamp() Return the timestamp of the changelog entry. =cut | ||||||
277 | |||||||
278 | sub get_timestamp { | ||||||
279 | 0 | 1 | 0 | return; | |||
280 | } | ||||||
281 | |||||||
282 - 288 | =item $time = $entry->get_timepiece() Return the timestamp of the changelog entry as a L<Time::Piece> object. This function might return undef if there was no timestamp. =cut | ||||||
289 | |||||||
290 | sub get_timepiece { | ||||||
291 | 0 | 1 | 0 | return; | |||
292 | } | ||||||
293 | |||||||
294 - 299 | =item $str = $entry->get_dpkg_changes() Returns a string that is suitable for usage in a C<Changes> field in the output format of C<dpkg-parsechangelog>. =cut | ||||||
300 | |||||||
301 | sub get_dpkg_changes { | ||||||
302 | 2214 | 1 | 1481 | my $self = shift; | |||
303 | 2214 | 2267 | my $header = $self->get_part('header') // ''; | ||||
304 | 2214 | 3883 | $header =~ s/\s+$//; | ||||
305 | 2214 2214 | 1902 1805 | return "\n$header\n\n" . join("\n", @{$self->get_part('changes')}); | ||||
306 | } | ||||||
307 | |||||||
308 | =back | ||||||
309 | |||||||
310 - 320 | =head1 CHANGES =head2 Version 1.01 (dpkg 1.18.8) New method: $entry->get_timepiece(). =head2 Version 1.00 (dpkg 1.15.6) Mark the module as public. =cut | ||||||
321 | |||||||
322 | 1; |