Commit | Line | Data |
---|---|---|
1479465f GJ |
1 | # Copyright © 2007-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::Control::FieldsCore; | |
17 | ||
18 | use strict; | |
19 | use warnings; | |
20 | ||
21 | our $VERSION = '1.00'; | |
22 | our @EXPORT = qw( | |
23 | field_capitalize | |
24 | field_is_official | |
25 | field_is_allowed_in | |
26 | field_transfer_single | |
27 | field_transfer_all | |
28 | field_list_src_dep | |
29 | field_list_pkg_dep | |
30 | field_get_dep_type | |
31 | field_get_sep_type | |
32 | field_ordered_list | |
33 | field_register | |
34 | field_insert_after | |
35 | field_insert_before | |
36 | FIELD_SEP_UNKNOWN | |
37 | FIELD_SEP_SPACE | |
38 | FIELD_SEP_COMMA | |
39 | FIELD_SEP_LINE | |
40 | ); | |
41 | ||
42 | use Exporter qw(import); | |
43 | ||
44 | use Dpkg::Gettext; | |
45 | use Dpkg::ErrorHandling; | |
46 | use Dpkg::Control::Types; | |
47 | use Dpkg::Checksums; | |
48 | ||
49 | use constant { | |
50 | ALL_PKG => CTRL_INFO_PKG | CTRL_INDEX_PKG | CTRL_PKG_DEB | CTRL_FILE_STATUS, | |
51 | ALL_SRC => CTRL_INFO_SRC | CTRL_INDEX_SRC | CTRL_PKG_SRC, | |
52 | ALL_CHANGES => CTRL_FILE_CHANGES | CTRL_CHANGELOG, | |
53 | ALL_COPYRIGHT => CTRL_COPYRIGHT_HEADER | CTRL_COPYRIGHT_FILES | CTRL_COPYRIGHT_LICENSE, | |
54 | }; | |
55 | ||
56 | use constant { | |
57 | FIELD_SEP_UNKNOWN => 0, | |
58 | FIELD_SEP_SPACE => 1, | |
59 | FIELD_SEP_COMMA => 2, | |
60 | FIELD_SEP_LINE => 4, | |
61 | }; | |
62 | ||
63 | # The canonical list of fields | |
64 | ||
65 | # Note that fields used only in dpkg's available file are not listed | |
66 | # Deprecated fields of dpkg's status file are also not listed | |
67 | our %FIELDS = ( | |
68 | 'Architecture' => { | |
69 | allowed => (ALL_PKG | ALL_SRC | CTRL_FILE_BUILDINFO | CTRL_FILE_CHANGES) & (~CTRL_INFO_SRC), | |
70 | separator => FIELD_SEP_SPACE, | |
71 | }, | |
72 | 'Architectures' => { | |
73 | allowed => CTRL_REPO_RELEASE, | |
74 | separator => FIELD_SEP_SPACE, | |
75 | }, | |
76 | 'Auto-Built-Package' => { | |
77 | allowed => ALL_PKG & ~CTRL_INFO_PKG, | |
78 | separator => FIELD_SEP_SPACE, | |
79 | }, | |
80 | 'Binary' => { | |
81 | allowed => CTRL_PKG_SRC | CTRL_FILE_BUILDINFO | CTRL_FILE_CHANGES, | |
82 | # XXX: This field values are separated either by space or comma | |
83 | # depending on the context. | |
84 | separator => FIELD_SEP_SPACE | FIELD_SEP_COMMA, | |
85 | }, | |
86 | 'Binary-Only' => { | |
87 | allowed => ALL_CHANGES, | |
88 | }, | |
89 | 'Binary-Only-Changes' => { | |
90 | allowed => CTRL_FILE_BUILDINFO, | |
91 | }, | |
92 | 'Breaks' => { | |
93 | allowed => ALL_PKG, | |
94 | separator => FIELD_SEP_COMMA, | |
95 | dependency => 'union', | |
96 | dep_order => 7, | |
97 | }, | |
98 | 'Bugs' => { | |
99 | allowed => (ALL_PKG | CTRL_INFO_SRC | CTRL_FILE_VENDOR) & (~CTRL_INFO_PKG), | |
100 | }, | |
101 | 'Build-Architecture' => { | |
102 | allowed => CTRL_FILE_BUILDINFO, | |
103 | }, | |
104 | 'Build-Conflicts' => { | |
105 | allowed => ALL_SRC, | |
106 | separator => FIELD_SEP_COMMA, | |
107 | dependency => 'union', | |
108 | dep_order => 4, | |
109 | }, | |
110 | 'Build-Conflicts-Arch' => { | |
111 | allowed => ALL_SRC, | |
112 | separator => FIELD_SEP_COMMA, | |
113 | dependency => 'union', | |
114 | dep_order => 5, | |
115 | }, | |
116 | 'Build-Conflicts-Indep' => { | |
117 | allowed => ALL_SRC, | |
118 | separator => FIELD_SEP_COMMA, | |
119 | dependency => 'union', | |
120 | dep_order => 6, | |
121 | }, | |
122 | 'Build-Date' => { | |
123 | allowed => CTRL_FILE_BUILDINFO, | |
124 | }, | |
125 | 'Build-Depends' => { | |
126 | allowed => ALL_SRC, | |
127 | separator => FIELD_SEP_COMMA, | |
128 | dependency => 'normal', | |
129 | dep_order => 1, | |
130 | }, | |
131 | 'Build-Depends-Arch' => { | |
132 | allowed => ALL_SRC, | |
133 | separator => FIELD_SEP_COMMA, | |
134 | dependency => 'normal', | |
135 | dep_order => 2, | |
136 | }, | |
137 | 'Build-Depends-Indep' => { | |
138 | allowed => ALL_SRC, | |
139 | separator => FIELD_SEP_COMMA, | |
140 | dependency => 'normal', | |
141 | dep_order => 3, | |
142 | }, | |
143 | 'Build-Essential' => { | |
144 | allowed => ALL_PKG, | |
145 | }, | |
146 | 'Build-Origin' => { | |
147 | allowed => CTRL_FILE_BUILDINFO, | |
148 | }, | |
149 | 'Build-Path' => { | |
150 | allowed => CTRL_FILE_BUILDINFO, | |
151 | }, | |
152 | 'Build-Profiles' => { | |
153 | allowed => CTRL_INFO_PKG, | |
154 | separator => FIELD_SEP_SPACE, | |
155 | }, | |
156 | 'Built-For-Profiles' => { | |
157 | allowed => ALL_PKG | CTRL_FILE_CHANGES, | |
158 | separator => FIELD_SEP_SPACE, | |
159 | }, | |
160 | 'Built-Using' => { | |
161 | allowed => ALL_PKG, | |
162 | separator => FIELD_SEP_COMMA, | |
163 | dependency => 'union', | |
164 | dep_order => 10, | |
165 | }, | |
166 | 'Changed-By' => { | |
167 | allowed => CTRL_FILE_CHANGES, | |
168 | }, | |
169 | 'Changelogs' => { | |
170 | allowed => CTRL_REPO_RELEASE, | |
171 | }, | |
172 | 'Changes' => { | |
173 | allowed => ALL_CHANGES, | |
174 | }, | |
175 | 'Classes' => { | |
176 | allowed => CTRL_TESTS, | |
177 | separator => FIELD_SEP_COMMA, | |
178 | }, | |
179 | 'Closes' => { | |
180 | allowed => ALL_CHANGES, | |
181 | separator => FIELD_SEP_SPACE, | |
182 | }, | |
183 | 'Codename' => { | |
184 | allowed => CTRL_REPO_RELEASE, | |
185 | }, | |
186 | 'Comment' => { | |
187 | allowed => ALL_COPYRIGHT, | |
188 | }, | |
189 | 'Components' => { | |
190 | allowed => CTRL_REPO_RELEASE, | |
191 | separator => FIELD_SEP_SPACE, | |
192 | }, | |
193 | 'Conffiles' => { | |
194 | allowed => CTRL_FILE_STATUS, | |
195 | separator => FIELD_SEP_LINE | FIELD_SEP_SPACE, | |
196 | }, | |
197 | 'Config-Version' => { | |
198 | allowed => CTRL_FILE_STATUS, | |
199 | }, | |
200 | 'Conflicts' => { | |
201 | allowed => ALL_PKG, | |
202 | separator => FIELD_SEP_COMMA, | |
203 | dependency => 'union', | |
204 | dep_order => 6, | |
205 | }, | |
206 | 'Copyright' => { | |
207 | allowed => CTRL_COPYRIGHT_HEADER | CTRL_COPYRIGHT_FILES, | |
208 | }, | |
209 | 'Date' => { | |
210 | allowed => ALL_CHANGES | CTRL_REPO_RELEASE, | |
211 | }, | |
212 | 'Depends' => { | |
213 | allowed => ALL_PKG | CTRL_TESTS, | |
214 | separator => FIELD_SEP_COMMA, | |
215 | dependency => 'normal', | |
216 | dep_order => 2, | |
217 | }, | |
218 | 'Description' => { | |
219 | allowed => ALL_PKG | CTRL_FILE_CHANGES | CTRL_REPO_RELEASE, | |
220 | }, | |
221 | 'Disclaimer' => { | |
222 | allowed => CTRL_COPYRIGHT_HEADER, | |
223 | }, | |
224 | 'Directory' => { | |
225 | allowed => CTRL_INDEX_SRC, | |
226 | }, | |
227 | 'Distribution' => { | |
228 | allowed => ALL_CHANGES, | |
229 | }, | |
230 | 'Enhances' => { | |
231 | allowed => ALL_PKG, | |
232 | separator => FIELD_SEP_COMMA, | |
233 | dependency => 'union', | |
234 | dep_order => 5, | |
235 | }, | |
236 | 'Environment' => { | |
237 | allowed => CTRL_FILE_BUILDINFO, | |
238 | separator => FIELD_SEP_LINE, | |
239 | }, | |
240 | 'Essential' => { | |
241 | allowed => ALL_PKG, | |
242 | }, | |
243 | 'Features' => { | |
244 | allowed => CTRL_TESTS, | |
245 | separator => FIELD_SEP_SPACE, | |
246 | }, | |
247 | 'Filename' => { | |
248 | allowed => CTRL_INDEX_PKG, | |
249 | separator => FIELD_SEP_LINE | FIELD_SEP_SPACE, | |
250 | }, | |
251 | 'Files' => { | |
252 | allowed => CTRL_PKG_SRC | CTRL_FILE_CHANGES | CTRL_COPYRIGHT_FILES, | |
253 | separator => FIELD_SEP_LINE | FIELD_SEP_SPACE, | |
254 | }, | |
255 | 'Format' => { | |
256 | allowed => CTRL_PKG_SRC | CTRL_FILE_CHANGES | CTRL_COPYRIGHT_HEADER | CTRL_FILE_BUILDINFO, | |
257 | }, | |
258 | 'Homepage' => { | |
259 | allowed => ALL_SRC | ALL_PKG, | |
260 | }, | |
261 | 'Installed-Build-Depends' => { | |
262 | allowed => CTRL_FILE_BUILDINFO, | |
263 | separator => FIELD_SEP_COMMA, | |
264 | dependency => 'union', | |
265 | dep_order => 11, | |
266 | }, | |
267 | 'Installed-Size' => { | |
268 | allowed => ALL_PKG & ~CTRL_INFO_PKG, | |
269 | }, | |
270 | 'Installer-Menu-Item' => { | |
271 | allowed => ALL_PKG, | |
272 | }, | |
273 | 'Kernel-Version' => { | |
274 | allowed => ALL_PKG, | |
275 | }, | |
276 | 'Label' => { | |
277 | allowed => CTRL_REPO_RELEASE, | |
278 | }, | |
279 | 'License' => { | |
280 | allowed => ALL_COPYRIGHT, | |
281 | }, | |
282 | 'Origin' => { | |
283 | allowed => (ALL_PKG | ALL_SRC | CTRL_REPO_RELEASE) & (~CTRL_INFO_PKG), | |
284 | }, | |
285 | 'Maintainer' => { | |
286 | allowed => CTRL_PKG_DEB| CTRL_FILE_STATUS | ALL_SRC | ALL_CHANGES, | |
287 | }, | |
288 | 'Multi-Arch' => { | |
289 | allowed => ALL_PKG, | |
290 | }, | |
291 | 'Package' => { | |
292 | allowed => ALL_PKG, | |
293 | }, | |
294 | 'Package-List' => { | |
295 | allowed => ALL_SRC & ~CTRL_INFO_SRC, | |
296 | separator => FIELD_SEP_LINE | FIELD_SEP_SPACE, | |
297 | }, | |
298 | 'Package-Type' => { | |
299 | allowed => ALL_PKG, | |
300 | }, | |
301 | 'Parent' => { | |
302 | allowed => CTRL_FILE_VENDOR, | |
303 | }, | |
304 | 'Pre-Depends' => { | |
305 | allowed => ALL_PKG, | |
306 | separator => FIELD_SEP_COMMA, | |
307 | dependency => 'normal', | |
308 | dep_order => 1, | |
309 | }, | |
310 | 'Priority' => { | |
311 | allowed => CTRL_INFO_SRC | CTRL_INDEX_SRC | ALL_PKG, | |
312 | }, | |
313 | 'Provides' => { | |
314 | allowed => ALL_PKG, | |
315 | separator => FIELD_SEP_COMMA, | |
316 | dependency => 'union', | |
317 | dep_order => 9, | |
318 | }, | |
319 | 'Recommends' => { | |
320 | allowed => ALL_PKG, | |
321 | separator => FIELD_SEP_COMMA, | |
322 | dependency => 'normal', | |
323 | dep_order => 3, | |
324 | }, | |
325 | 'Replaces' => { | |
326 | allowed => ALL_PKG, | |
327 | separator => FIELD_SEP_COMMA, | |
328 | dependency => 'union', | |
329 | dep_order => 8, | |
330 | }, | |
331 | 'Restrictions' => { | |
332 | allowed => CTRL_TESTS, | |
333 | separator => FIELD_SEP_SPACE, | |
334 | }, | |
335 | 'Section' => { | |
336 | allowed => CTRL_INFO_SRC | CTRL_INDEX_SRC | ALL_PKG, | |
337 | }, | |
338 | 'Size' => { | |
339 | allowed => CTRL_INDEX_PKG, | |
340 | separator => FIELD_SEP_LINE | FIELD_SEP_SPACE, | |
341 | }, | |
342 | 'Source' => { | |
343 | allowed => (ALL_PKG | ALL_SRC | ALL_CHANGES | CTRL_COPYRIGHT_HEADER | CTRL_FILE_BUILDINFO) & | |
344 | (~(CTRL_INDEX_SRC | CTRL_INFO_PKG)), | |
345 | }, | |
346 | 'Standards-Version' => { | |
347 | allowed => ALL_SRC, | |
348 | }, | |
349 | 'Status' => { | |
350 | allowed => CTRL_FILE_STATUS, | |
351 | separator => FIELD_SEP_SPACE, | |
352 | }, | |
353 | 'Subarchitecture' => { | |
354 | allowed => ALL_PKG, | |
355 | }, | |
356 | 'Suite' => { | |
357 | allowed => CTRL_REPO_RELEASE, | |
358 | }, | |
359 | 'Suggests' => { | |
360 | allowed => ALL_PKG, | |
361 | separator => FIELD_SEP_COMMA, | |
362 | dependency => 'normal', | |
363 | dep_order => 4, | |
364 | }, | |
365 | 'Tag' => { | |
366 | allowed => ALL_PKG, | |
367 | separator => FIELD_SEP_COMMA, | |
368 | }, | |
369 | 'Task' => { | |
370 | allowed => ALL_PKG, | |
371 | }, | |
372 | 'Test-Command' => { | |
373 | allowed => CTRL_TESTS, | |
374 | }, | |
375 | 'Tests' => { | |
376 | allowed => CTRL_TESTS, | |
377 | separator => FIELD_SEP_SPACE, | |
378 | }, | |
379 | 'Tests-Directory' => { | |
380 | allowed => CTRL_TESTS, | |
381 | }, | |
382 | 'Testsuite' => { | |
383 | allowed => ALL_SRC, | |
384 | separator => FIELD_SEP_COMMA, | |
385 | }, | |
386 | 'Testsuite-Triggers' => { | |
387 | allowed => ALL_SRC, | |
388 | separator => FIELD_SEP_COMMA, | |
389 | }, | |
390 | 'Timestamp' => { | |
391 | allowed => CTRL_CHANGELOG, | |
392 | }, | |
393 | 'Triggers-Awaited' => { | |
394 | allowed => CTRL_FILE_STATUS, | |
395 | separator => FIELD_SEP_SPACE, | |
396 | }, | |
397 | 'Triggers-Pending' => { | |
398 | allowed => CTRL_FILE_STATUS, | |
399 | separator => FIELD_SEP_SPACE, | |
400 | }, | |
401 | 'Uploaders' => { | |
402 | allowed => ALL_SRC, | |
403 | separator => FIELD_SEP_COMMA, | |
404 | }, | |
405 | 'Upstream-Name' => { | |
406 | allowed => CTRL_COPYRIGHT_HEADER, | |
407 | }, | |
408 | 'Upstream-Contact' => { | |
409 | allowed => CTRL_COPYRIGHT_HEADER, | |
410 | }, | |
411 | 'Urgency' => { | |
412 | allowed => ALL_CHANGES, | |
413 | }, | |
414 | 'Valid-Until' => { | |
415 | allowed => CTRL_REPO_RELEASE, | |
416 | }, | |
417 | 'Vcs-Browser' => { | |
418 | allowed => ALL_SRC, | |
419 | }, | |
420 | 'Vcs-Arch' => { | |
421 | allowed => ALL_SRC, | |
422 | }, | |
423 | 'Vcs-Bzr' => { | |
424 | allowed => ALL_SRC, | |
425 | }, | |
426 | 'Vcs-Cvs' => { | |
427 | allowed => ALL_SRC, | |
428 | }, | |
429 | 'Vcs-Darcs' => { | |
430 | allowed => ALL_SRC, | |
431 | }, | |
432 | 'Vcs-Git' => { | |
433 | allowed => ALL_SRC, | |
434 | }, | |
435 | 'Vcs-Hg' => { | |
436 | allowed => ALL_SRC, | |
437 | }, | |
438 | 'Vcs-Mtn' => { | |
439 | allowed => ALL_SRC, | |
440 | }, | |
441 | 'Vcs-Svn' => { | |
442 | allowed => ALL_SRC, | |
443 | }, | |
444 | 'Vendor' => { | |
445 | allowed => CTRL_FILE_VENDOR, | |
446 | }, | |
447 | 'Vendor-Url' => { | |
448 | allowed => CTRL_FILE_VENDOR, | |
449 | }, | |
450 | 'Version' => { | |
451 | allowed => (ALL_PKG | ALL_SRC | CTRL_FILE_BUILDINFO | ALL_CHANGES) & | |
452 | (~(CTRL_INFO_SRC | CTRL_INFO_PKG)), | |
453 | }, | |
454 | ); | |
455 | ||
456 | my @checksum_fields = map { &field_capitalize("Checksums-$_") } checksums_get_list(); | |
457 | my @sum_fields = map { $_ eq 'md5' ? 'MD5sum' : &field_capitalize($_) } | |
458 | checksums_get_list(); | |
459 | &field_register($_, CTRL_PKG_SRC | CTRL_FILE_CHANGES | CTRL_FILE_BUILDINFO) foreach @checksum_fields; | |
460 | &field_register($_, CTRL_INDEX_PKG | CTRL_REPO_RELEASE, | |
461 | separator => FIELD_SEP_LINE | FIELD_SEP_SPACE) foreach @sum_fields; | |
462 | ||
463 | our %FIELD_ORDER = ( | |
464 | CTRL_PKG_DEB() => [ | |
465 | qw(Package Package-Type Source Version Built-Using Kernel-Version | |
466 | Built-For-Profiles Auto-Built-Package Architecture Subarchitecture | |
467 | Installer-Menu-Item Essential Origin Bugs | |
468 | Maintainer Installed-Size), &field_list_pkg_dep(), | |
469 | qw(Section Priority Multi-Arch Homepage Description Tag Task) | |
470 | ], | |
471 | CTRL_PKG_SRC() => [ | |
472 | qw(Format Source Binary Architecture Version Origin Maintainer | |
473 | Uploaders Homepage Standards-Version Vcs-Browser | |
474 | Vcs-Arch Vcs-Bzr Vcs-Cvs Vcs-Darcs Vcs-Git Vcs-Hg Vcs-Mtn | |
475 | Vcs-Svn Testsuite Testsuite-Triggers), &field_list_src_dep(), | |
476 | qw(Package-List), @checksum_fields, qw(Files) | |
477 | ], | |
478 | CTRL_FILE_BUILDINFO() => [ | |
479 | qw(Format Source Binary Architecture Version | |
480 | Binary-Only-Changes), | |
481 | @checksum_fields, | |
482 | qw(Build-Origin Build-Architecture Build-Date Build-Path | |
483 | Installed-Build-Depends Environment), | |
484 | ], | |
485 | CTRL_FILE_CHANGES() => [ | |
486 | qw(Format Date Source Binary Binary-Only Built-For-Profiles Architecture | |
487 | Version Distribution Urgency Maintainer Changed-By Description | |
488 | Closes Changes), | |
489 | @checksum_fields, qw(Files) | |
490 | ], | |
491 | CTRL_CHANGELOG() => [ | |
492 | qw(Source Binary-Only Version Distribution Urgency Maintainer | |
493 | Timestamp Date Closes Changes) | |
494 | ], | |
495 | CTRL_FILE_STATUS() => [ # Same as fieldinfos in lib/dpkg/parse.c | |
496 | qw(Package Essential Status Priority Section Installed-Size Origin | |
497 | Maintainer Bugs Architecture Multi-Arch Source Version Config-Version | |
498 | Replaces Provides Depends Pre-Depends Recommends Suggests Breaks | |
499 | Conflicts Enhances Conffiles Description Triggers-Pending | |
500 | Triggers-Awaited) | |
501 | ], | |
502 | CTRL_REPO_RELEASE() => [ | |
503 | qw(Origin Label Suite Codename Changelogs Date Valid-Until | |
504 | Architectures Components Description), @sum_fields | |
505 | ], | |
506 | CTRL_COPYRIGHT_HEADER() => [ | |
507 | qw(Format Upstream-Name Upstream-Contact Source Disclaimer Comment | |
508 | License Copyright) | |
509 | ], | |
510 | CTRL_COPYRIGHT_FILES() => [ | |
511 | qw(Files Copyright License Comment) | |
512 | ], | |
513 | CTRL_COPYRIGHT_LICENSE() => [ | |
514 | qw(License Comment) | |
515 | ], | |
516 | ); | |
517 | # Order for CTRL_INDEX_PKG is derived from CTRL_PKG_DEB | |
518 | $FIELD_ORDER{CTRL_INDEX_PKG()} = [ @{$FIELD_ORDER{CTRL_PKG_DEB()}} ]; | |
519 | &field_insert_before(CTRL_INDEX_PKG, 'Section', 'Filename', 'Size', @sum_fields); | |
520 | # Order for CTRL_INDEX_SRC is derived from CTRL_PKG_SRC | |
521 | $FIELD_ORDER{CTRL_INDEX_SRC()} = [ @{$FIELD_ORDER{CTRL_PKG_SRC()}} ]; | |
522 | @{$FIELD_ORDER{CTRL_INDEX_SRC()}} = map { $_ eq 'Source' ? 'Package' : $_ } | |
523 | @{$FIELD_ORDER{CTRL_PKG_SRC()}}; | |
524 | &field_insert_after(CTRL_INDEX_SRC, 'Version', 'Priority', 'Section'); | |
525 | &field_insert_before(CTRL_INDEX_SRC, 'Checksums-Md5', 'Directory'); | |
526 | ||
527 | =encoding utf8 | |
528 | ||
529 | =head1 NAME | |
530 | ||
531 | Dpkg::Control::FieldsCore - manage (list of official) control fields | |
532 | ||
533 | =head1 DESCRIPTION | |
534 | ||
535 | The modules contains a list of fieldnames with associated meta-data explaining | |
536 | in which type of control information they are allowed. The types are the | |
537 | CTRL_* constants exported by Dpkg::Control. | |
538 | ||
539 | =head1 FUNCTIONS | |
540 | ||
541 | =over 4 | |
542 | ||
543 | =item $f = field_capitalize($field_name) | |
544 | ||
545 | Returns the field name properly capitalized. All characters are lowercase, | |
546 | except the first of each word (words are separated by a hyphen in field names). | |
547 | ||
548 | =cut | |
549 | ||
550 | sub field_capitalize($) { | |
551 | my $field = lc(shift); | |
552 | # Some special cases due to history | |
553 | return 'MD5sum' if $field eq 'md5sum'; | |
554 | return uc($field) if checksums_is_supported($field); | |
555 | # Generic case | |
556 | return join '-', map { ucfirst } split /-/, $field; | |
557 | } | |
558 | ||
559 | =item field_is_official($fname) | |
560 | ||
561 | Returns true if the field is official and known. | |
562 | ||
563 | =cut | |
564 | ||
565 | sub field_is_official($) { | |
566 | my $field = field_capitalize(shift); | |
567 | ||
568 | return exists $FIELDS{$field}; | |
569 | } | |
570 | ||
571 | =item field_is_allowed_in($fname, @types) | |
572 | ||
573 | Returns true (1) if the field $fname is allowed in all the types listed in | |
574 | the list. Note that you can use type sets instead of individual types (ex: | |
575 | CTRL_FILE_CHANGES | CTRL_CHANGELOG). | |
576 | ||
577 | field_allowed_in(A|B, C) returns true only if the field is allowed in C | |
578 | and either A or B. | |
579 | ||
580 | Undef is returned for non-official fields. | |
581 | ||
582 | =cut | |
583 | ||
584 | sub field_is_allowed_in($@) { | |
585 | my ($field, @types) = @_; | |
586 | $field = field_capitalize($field); | |
587 | return unless field_is_official($field); | |
588 | ||
589 | return 0 if not scalar(@types); | |
590 | foreach my $type (@types) { | |
591 | next if $type == CTRL_UNKNOWN; # Always allowed | |
592 | return 0 unless $FIELDS{$field}{allowed} & $type; | |
593 | } | |
594 | return 1; | |
595 | } | |
596 | ||
597 | =item field_transfer_single($from, $to, $field) | |
598 | ||
599 | If appropriate, copy the value of the field named $field taken from the | |
600 | $from Dpkg::Control object to the $to Dpkg::Control object. | |
601 | ||
602 | Official fields are copied only if the field is allowed in both types of | |
603 | objects. Custom fields are treated in a specific manner. When the target | |
604 | is not among CTRL_PKG_SRC, CTRL_PKG_DEB or CTRL_FILE_CHANGES, then they | |
605 | are always copied as is (the X- prefix is kept). Otherwise they are not | |
606 | copied except if the target object matches the target destination encoded | |
607 | in the field name. The initial X denoting custom fields can be followed by | |
608 | one or more letters among "S" (Source: corresponds to CTRL_PKG_SRC), "B" | |
609 | (Binary: corresponds to CTRL_PKG_DEB) or "C" (Changes: corresponds to | |
610 | CTRL_FILE_CHANGES). | |
611 | ||
612 | Returns undef if nothing has been copied or the name of the new field | |
613 | added to $to otherwise. | |
614 | ||
615 | =cut | |
616 | ||
617 | sub field_transfer_single($$;$) { | |
618 | my ($from, $to, $field) = @_; | |
619 | $field //= $_; | |
620 | my ($from_type, $to_type) = ($from->get_type(), $to->get_type()); | |
621 | $field = field_capitalize($field); | |
622 | ||
623 | if (field_is_allowed_in($field, $from_type, $to_type)) { | |
624 | $to->{$field} = $from->{$field}; | |
625 | return $field; | |
626 | } elsif ($field =~ /^X([SBC]*)-/i) { | |
627 | my $dest = $1; | |
628 | if (($dest =~ /B/i and $to_type == CTRL_PKG_DEB) or | |
629 | ($dest =~ /S/i and $to_type == CTRL_PKG_SRC) or | |
630 | ($dest =~ /C/i and $to_type == CTRL_FILE_CHANGES)) | |
631 | { | |
632 | my $new = $field; | |
633 | $new =~ s/^X([SBC]*)-//i; | |
634 | $to->{$new} = $from->{$field}; | |
635 | return $new; | |
636 | } elsif ($to_type != CTRL_PKG_DEB and | |
637 | $to_type != CTRL_PKG_SRC and | |
638 | $to_type != CTRL_FILE_CHANGES) | |
639 | { | |
640 | $to->{$field} = $from->{$field}; | |
641 | return $field; | |
642 | } | |
643 | } elsif (not field_is_allowed_in($field, $from_type)) { | |
644 | warning(g_("unknown information field '%s' in input data in %s"), | |
645 | $field, $from->get_option('name') || g_('control information')); | |
646 | } | |
647 | return; | |
648 | } | |
649 | ||
650 | =item field_transfer_all($from, $to) | |
651 | ||
652 | Transfer all appropriate fields from $from to $to. Calls | |
653 | field_transfer_single() on all fields available in $from. | |
654 | ||
655 | Returns the list of fields that have been added to $to. | |
656 | ||
657 | =cut | |
658 | ||
659 | sub field_transfer_all($$) { | |
660 | my ($from, $to) = @_; | |
661 | my (@res, $res); | |
662 | foreach my $k (keys %$from) { | |
663 | $res = field_transfer_single($from, $to, $k); | |
664 | push @res, $res if $res and defined wantarray; | |
665 | } | |
666 | return @res; | |
667 | } | |
668 | ||
669 | =item field_ordered_list($type) | |
670 | ||
671 | Returns an ordered list of fields for a given type of control information. | |
672 | This list can be used to output the fields in a predictable order. | |
673 | The list might be empty for types where the order does not matter much. | |
674 | ||
675 | =cut | |
676 | ||
677 | sub field_ordered_list($) { | |
678 | my $type = shift; | |
679 | return @{$FIELD_ORDER{$type}} if exists $FIELD_ORDER{$type}; | |
680 | return (); | |
681 | } | |
682 | ||
683 | =item field_list_src_dep() | |
684 | ||
685 | List of fields that contains dependencies-like information in a source | |
686 | Debian package. | |
687 | ||
688 | =cut | |
689 | ||
690 | sub field_list_src_dep() { | |
691 | my @list = sort { | |
692 | $FIELDS{$a}{dep_order} <=> $FIELDS{$b}{dep_order} | |
693 | } grep { | |
694 | field_is_allowed_in($_, CTRL_PKG_SRC) and | |
695 | exists $FIELDS{$_}{dependency} | |
696 | } keys %FIELDS; | |
697 | return @list; | |
698 | } | |
699 | ||
700 | =item field_list_pkg_dep() | |
701 | ||
702 | List of fields that contains dependencies-like information in a binary | |
703 | Debian package. The fields that express real dependencies are sorted from | |
704 | the stronger to the weaker. | |
705 | ||
706 | =cut | |
707 | ||
708 | sub field_list_pkg_dep() { | |
709 | my @keys = keys %FIELDS; | |
710 | my @list = sort { | |
711 | $FIELDS{$a}{dep_order} <=> $FIELDS{$b}{dep_order} | |
712 | } grep { | |
713 | field_is_allowed_in($_, CTRL_PKG_DEB) and | |
714 | exists $FIELDS{$_}{dependency} | |
715 | } @keys; | |
716 | return @list; | |
717 | } | |
718 | ||
719 | =item field_get_dep_type($field) | |
720 | ||
721 | Return the type of the dependency expressed by the given field. Can | |
722 | either be "normal" for a real dependency field (Pre-Depends, Depends, ...) | |
723 | or "union" for other relation fields sharing the same syntax (Conflicts, | |
724 | Breaks, ...). Returns undef for fields which are not dependencies. | |
725 | ||
726 | =cut | |
727 | ||
728 | sub field_get_dep_type($) { | |
729 | my $field = field_capitalize(shift); | |
730 | ||
731 | return unless field_is_official($field); | |
732 | return $FIELDS{$field}{dependency} if exists $FIELDS{$field}{dependency}; | |
733 | return; | |
734 | } | |
735 | ||
736 | =item field_get_sep_type($field) | |
737 | ||
738 | Return the type of the field value separator. Can be one of FIELD_SEP_UNKNOWN, | |
739 | FIELD_SEP_SPACE, FIELD_SEP_COMMA or FIELD_SEP_LINE. | |
740 | ||
741 | =cut | |
742 | ||
743 | sub field_get_sep_type($) { | |
744 | my $field = field_capitalize(shift); | |
745 | ||
746 | return $FIELDS{$field}{separator} if exists $FIELDS{$field}{separator}; | |
747 | return FIELD_SEP_UNKNOWN; | |
748 | } | |
749 | ||
750 | =item field_register($field, $allowed_types, %opts) | |
751 | ||
752 | Register a new field as being allowed in control information of specified | |
753 | types. %opts is optional | |
754 | ||
755 | =cut | |
756 | ||
757 | sub field_register($$;@) { | |
758 | my ($field, $types, %opts) = @_; | |
759 | $field = field_capitalize($field); | |
760 | $FIELDS{$field} = { | |
761 | allowed => $types, | |
762 | %opts | |
763 | }; | |
764 | } | |
765 | ||
766 | =item field_insert_after($type, $ref, @fields) | |
767 | ||
768 | Place field after another one ($ref) in output of control information of | |
769 | type $type. | |
770 | ||
771 | =cut | |
772 | sub field_insert_after($$@) { | |
773 | my ($type, $field, @fields) = @_; | |
774 | return 0 if not exists $FIELD_ORDER{$type}; | |
775 | ($field, @fields) = map { field_capitalize($_) } ($field, @fields); | |
776 | @{$FIELD_ORDER{$type}} = map { | |
777 | ($_ eq $field) ? ($_, @fields) : $_ | |
778 | } @{$FIELD_ORDER{$type}}; | |
779 | return 1; | |
780 | } | |
781 | ||
782 | =item field_insert_before($type, $ref, @fields) | |
783 | ||
784 | Place field before another one ($ref) in output of control information of | |
785 | type $type. | |
786 | ||
787 | =cut | |
788 | sub field_insert_before($$@) { | |
789 | my ($type, $field, @fields) = @_; | |
790 | return 0 if not exists $FIELD_ORDER{$type}; | |
791 | ($field, @fields) = map { field_capitalize($_) } ($field, @fields); | |
792 | @{$FIELD_ORDER{$type}} = map { | |
793 | ($_ eq $field) ? (@fields, $_) : $_ | |
794 | } @{$FIELD_ORDER{$type}}; | |
795 | return 1; | |
796 | } | |
797 | ||
798 | =back | |
799 | ||
800 | =head1 CHANGES | |
801 | ||
802 | =head2 Version 1.00 (dpkg 1.17.0) | |
803 | ||
804 | Mark the module as public. | |
805 | ||
806 | =cut | |
807 | ||
808 | 1; |