OLD | NEW |
| (Empty) |
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 package Dpkg::Changelog::Entry; | |
17 | |
18 use strict; | |
19 use warnings; | |
20 | |
21 our $VERSION = '1.00'; | |
22 | |
23 use Carp; | |
24 | |
25 use Dpkg::Gettext; | |
26 use Dpkg::ErrorHandling; | |
27 use Dpkg::Control::Changelog; | |
28 | |
29 use overload | |
30 '""' => \&output, | |
31 'eq' => sub { defined($_[1]) and "$_[0]" eq "$_[1]" }, | |
32 fallback => 1; | |
33 | |
34 =encoding utf8 | |
35 | |
36 =head1 NAME | |
37 | |
38 Dpkg::Changelog::Entry - represents a changelog entry | |
39 | |
40 =head1 DESCRIPTION | |
41 | |
42 This object 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 FUNCTIONS | |
47 | |
48 =over 4 | |
49 | |
50 =item my $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 my ($this) = @_; | |
59 my $class = ref($this) || $this; | |
60 | |
61 my $self = { | |
62 header => undef, | |
63 changes => [], | |
64 trailer => undef, | |
65 blank_after_header => [], | |
66 blank_after_changes => [], | |
67 blank_after_trailer => [], | |
68 }; | |
69 bless $self, $class; | |
70 return $self; | |
71 } | |
72 | |
73 =item my $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 my $lines = shift; | |
88 return join('', map { $_ . "\n" } @{$lines}); | |
89 } | |
90 | |
91 sub output { | |
92 my ($self, $fh) = @_; | |
93 my $str = ''; | |
94 $str .= $self->{header} . "\n" if defined($self->{header}); | |
95 $str .= _format_output_block($self->{blank_after_header}); | |
96 $str .= _format_output_block($self->{changes}); | |
97 $str .= _format_output_block($self->{blank_after_changes}); | |
98 $str .= $self->{trailer} . "\n" if defined($self->{trailer}); | |
99 $str .= _format_output_block($self->{blank_after_trailer}); | |
100 print { $fh } $str if defined $fh; | |
101 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 my ($self, $part) = @_; | |
115 croak "invalid part of changelog entry: $part" unless exists $self->{$part}; | |
116 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 my ($self, $part, $value) = @_; | |
128 croak "invalid part of changelog entry: $part" unless exists $self->{$part}; | |
129 if (ref($self->{$part})) { | |
130 if (ref($value)) { | |
131 $self->{$part} = $value; | |
132 } else { | |
133 $self->{$part} = [ $value ]; | |
134 } | |
135 } else { | |
136 $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 my ($self, $part, $value, @rest) = @_; | |
150 croak "invalid part of changelog entry: $part" unless exists $self->{$part}; | |
151 if (ref($self->{$part})) { | |
152 if (ref($value)) { | |
153 push @{$self->{$part}}, @$value; | |
154 } else { | |
155 push @{$self->{$part}}, $value; | |
156 } | |
157 } else { | |
158 if (defined($self->{$part})) { | |
159 if (ref($value)) { | |
160 $self->{$part} = [ $self->{$part}, @$value ]; | |
161 } else { | |
162 $self->{$part} .= $value; | |
163 } | |
164 } else { | |
165 $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 my ($self) = @_; | |
180 return !(defined($self->{header}) || defined($self->{trailer}) || | |
181 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 my ($self) = @_; | |
193 if (defined($self->{header})) { | |
194 $self->{header} =~ s/\s+$//g; | |
195 $self->{blank_after_header} = ['']; | |
196 } else { | |
197 $self->{blank_after_header} = []; | |
198 } | |
199 if (scalar(@{$self->{changes}})) { | |
200 s/\s+$//g foreach @{$self->{changes}}; | |
201 $self->{blank_after_changes} = ['']; | |
202 } else { | |
203 $self->{blank_after_changes} = []; | |
204 } | |
205 if (defined($self->{trailer})) { | |
206 $self->{trailer} =~ s/\s+$//g; | |
207 $self->{blank_after_trailer} = ['']; | |
208 } else { | |
209 $self->{blank_after_trailer} = []; | |
210 } | |
211 } | |
212 | |
213 =item my $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 return; | |
221 } | |
222 | |
223 =item my $ver = $entry->get_version() | |
224 | |
225 Return the version associated to the changelog entry. | |
226 | |
227 =cut | |
228 | |
229 sub get_version { | |
230 return; | |
231 } | |
232 | |
233 =item my @dists = $entry->get_distributions() | |
234 | |
235 Return a list of target distributions for this version. | |
236 | |
237 =cut | |
238 | |
239 sub get_distributions { | |
240 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 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 return; | |
262 } | |
263 | |
264 =item my $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 return; | |
272 } | |
273 | |
274 =item my $time = $entry->get_timestamp() | |
275 | |
276 Return the timestamp of the changelog entry. | |
277 | |
278 =cut | |
279 | |
280 sub get_timestamp { | |
281 return; | |
282 } | |
283 | |
284 =item my $str = $entry->get_dpkg_changes() | |
285 | |
286 Returns a string that is suitable for usage in a C<Changes> field | |
287 in the output format of C<dpkg-parsechangelog>. | |
288 | |
289 =cut | |
290 | |
291 sub get_dpkg_changes { | |
292 my ($self) = @_; | |
293 my $header = $self->get_part('header') || ''; | |
294 $header =~ s/\s+$//; | |
295 return "\n$header\n\n" . join("\n", @{$self->get_part('changes')}); | |
296 } | |
297 | |
298 =back | |
299 | |
300 =head1 AUTHOR | |
301 | |
302 Raphaël Hertzog <hertzog@debian.org>. | |
303 | |
304 =cut | |
305 | |
306 1; | |
OLD | NEW |