File: | Dpkg/Control/Info.pm |
Coverage: | 83.5% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | # Copyright © 2007-2010 Raphaël Hertzog <hertzog@debian.org> | ||||||
2 | # Copyright © 2009, 2012-2015 Guillem Jover <guillem@debian.org> | ||||||
3 | # | ||||||
4 | # This program is free software; you can redistribute it and/or modify | ||||||
5 | # it under the terms of the GNU General Public License as published by | ||||||
6 | # the Free Software Foundation; either version 2 of the License, or | ||||||
7 | # (at your option) any later version. | ||||||
8 | # | ||||||
9 | # This program is distributed in the hope that it will be useful, | ||||||
10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||||
11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||||
12 | # GNU General Public License for more details. | ||||||
13 | # | ||||||
14 | # You should have received a copy of the GNU General Public License | ||||||
15 | # along with this program. If not, see <https://www.gnu.org/licenses/>. | ||||||
16 | |||||||
17 | package Dpkg::Control::Info; | ||||||
18 | |||||||
19 | 1 1 1 | 2 1 12 | use strict; | ||||
20 | 1 1 1 | 1 1 22 | use warnings; | ||||
21 | |||||||
22 | our $VERSION = '1.01'; | ||||||
23 | |||||||
24 | 1 1 1 | 2 0 29 | use Dpkg::Control; | ||||
25 | 1 1 1 | 2 0 27 | use Dpkg::ErrorHandling; | ||||
26 | 1 1 1 | 2 1 18 | use Dpkg::Gettext; | ||||
27 | |||||||
28 | 1 1 1 | 4 0 2 | use parent qw(Dpkg::Interface::Storable); | ||||
29 | |||||||
30 | use overload | ||||||
31 | 1 1 1 2 2 | 41 0 3 1 4 | '@{}' => sub { return [ $_[0]->{source}, @{$_[0]->{packages}} ] }; | ||||
32 | |||||||
33 | =encoding utf8 | ||||||
34 | |||||||
35 - 56 | =head1 NAME Dpkg::Control::Info - parse files like debian/control =head1 DESCRIPTION It provides a class to access data of files that follow the same syntax as F<debian/control>. =head1 METHODS =over 4 =item $c = Dpkg::Control::Info->new(%opts) Create a new Dpkg::Control::Info object. Loads the file from the filename option, if no option is specified filename defaults to F<debian/control>. If a scalar is passed instead, it will be used as the filename. If filename is "-", it parses the standard input. If filename is undef no loading will be performed. =cut | ||||||
57 | |||||||
58 | sub new { | ||||||
59 | 1 | 1 | 2 | my ($this, @args) = @_; | |||
60 | 1 | 4 | my $class = ref($this) || $this; | ||||
61 | 1 | 2 | my $self = { | ||||
62 | source => undef, | ||||||
63 | packages => [], | ||||||
64 | }; | ||||||
65 | 1 | 1 | bless $self, $class; | ||||
66 | |||||||
67 | 1 | 1 | my %opts; | ||||
68 | 1 | 2 | if (scalar @args == 0) { | ||||
69 | 0 | 0 | $opts{filename} = 'debian/control'; | ||||
70 | } elsif (scalar @args == 1) { | ||||||
71 | 1 | 2 | $opts{filename} = $args[0]; | ||||
72 | } else { | ||||||
73 | 0 | 0 | %opts = @args; | ||||
74 | } | ||||||
75 | |||||||
76 | 1 | 5 | $self->load($opts{filename}) if $opts{filename}; | ||||
77 | |||||||
78 | 1 | 4 | return $self; | ||||
79 | } | ||||||
80 | |||||||
81 - 85 | =item $c->reset() Resets what got read. =cut | ||||||
86 | |||||||
87 | sub reset { | ||||||
88 | 1 | 1 | 1 | my $self = shift; | |||
89 | 1 | 13 | $self->{source} = undef; | ||||
90 | 1 | 3 | $self->{packages} = []; | ||||
91 | } | ||||||
92 | |||||||
93 - 100 | =item $c->parse($fh, $description) Parse a control file from the given filehandle. Exits in case of errors. $description is used to describe the filehandle, ideally it's a filename or a description of where the data comes from. It is used in error messages. The data in the object is reset before parsing new control files. =cut | ||||||
101 | |||||||
102 | sub parse { | ||||||
103 | 1 | 1 | 1 | my ($self, $fh, $desc) = @_; | |||
104 | 1 | 1 | $self->reset(); | ||||
105 | 1 | 3 | my $cdata = Dpkg::Control->new(type => CTRL_INFO_SRC); | ||||
106 | 1 | 3 | return if not $cdata->parse($fh, $desc); | ||||
107 | 1 | 2 | $self->{source} = $cdata; | ||||
108 | 1 | 1 | unless (exists $cdata->{Source}) { | ||||
109 | 0 | 0 | $cdata->parse_error($desc, g_('first block lacks a Source field')); | ||||
110 | } | ||||||
111 | 1 | 1 | while (1) { | ||||
112 | 4 | 4 | $cdata = Dpkg::Control->new(type => CTRL_INFO_PKG); | ||||
113 | 4 | 4 | last if not $cdata->parse($fh, $desc); | ||||
114 | 3 3 | 2 3 | push @{$self->{packages}}, $cdata; | ||||
115 | 3 | 2 | unless (exists $cdata->{Package}) { | ||||
116 | 0 | 0 | $cdata->parse_error($desc, g_("block lacks the '%s' field"), | ||||
117 | 'Package'); | ||||||
118 | } | ||||||
119 | 3 | 3 | unless (exists $cdata->{Architecture}) { | ||||
120 | 0 | 0 | $cdata->parse_error($desc, g_("block lacks the '%s' field"), | ||||
121 | 'Architecture'); | ||||||
122 | } | ||||||
123 | |||||||
124 | } | ||||||
125 | } | ||||||
126 | |||||||
127 - 139 | =item $c->load($file) Load the content of $file. Exits in case of errors. If file is "-", it loads from the standard input. =item $c->[0] =item $c->get_source() Returns a Dpkg::Control object containing the fields concerning the source package. =cut | ||||||
140 | |||||||
141 | sub get_source { | ||||||
142 | 1 | 1 | 1 | my $self = shift; | |||
143 | 1 | 2 | return $self->{source}; | ||||
144 | } | ||||||
145 | |||||||
146 - 151 | =item $c->get_pkg_by_idx($idx) Returns a Dpkg::Control object containing the fields concerning the binary package numbered $idx (starting at 1). =cut | ||||||
152 | |||||||
153 | sub get_pkg_by_idx { | ||||||
154 | 2 | 1 | 2 | my ($self, $idx) = @_; | |||
155 | 2 | 3 | return $self->{packages}[--$idx]; | ||||
156 | } | ||||||
157 | |||||||
158 - 163 | =item $c->get_pkg_by_name($name) Returns a Dpkg::Control object containing the fields concerning the binary package named $name. =cut | ||||||
164 | |||||||
165 | sub get_pkg_by_name { | ||||||
166 | 1 | 1 | 2 | my ($self, $name) = @_; | |||
167 | 1 1 | 0 2 | foreach my $pkg (@{$self->{packages}}) { | ||||
168 | 3 | 3 | return $pkg if ($pkg->{Package} eq $name); | ||||
169 | } | ||||||
170 | 0 | 0 | return; | ||||
171 | } | ||||||
172 | |||||||
173 | |||||||
174 - 178 | =item $c->get_packages() Returns a list containing the Dpkg::Control objects for all binary packages. =cut | ||||||
179 | |||||||
180 | sub get_packages { | ||||||
181 | 0 | 1 | 0 | my $self = shift; | |||
182 | 0 0 | 0 0 | return @{$self->{packages}}; | ||||
183 | } | ||||||
184 | |||||||
185 - 190 | =item $str = $c->output([$fh]) Return the content info into a string. If $fh is specified print it into the filehandle. =cut | ||||||
191 | |||||||
192 | sub output { | ||||||
193 | 1 | 1 | 1 | my ($self, $fh) = @_; | |||
194 | 1 | 1 | my $str; | ||||
195 | 1 | 4 | $str .= $self->{source}->output($fh); | ||||
196 | 1 1 | 1 1 | foreach my $pkg (@{$self->{packages}}) { | ||||
197 | 3 3 | 2 3 | print { $fh } "\n" if defined $fh; | ||||
198 | 3 | 2 | $str .= "\n" . $pkg->output($fh); | ||||
199 | } | ||||||
200 | 1 | 1 | return $str; | ||||
201 | } | ||||||
202 | |||||||
203 - 225 | =item "$c" Return a string representation of the content. =item @{$c} Return a list of Dpkg::Control objects, the first one is corresponding to source information and the following ones are the binary packages information. =back =head1 CHANGES =head2 Version 1.01 (dpkg 1.18.0) New argument: The $c->new() constructor accepts an %opts argument. =head2 Version 1.00 (dpkg 1.15.6) Mark the module as public. =cut | ||||||
226 | |||||||
227 | 1; |