File Coverage

blib/lib/Dpkg/Control/Info.pm
Criterion Covered Total %
statement 65 74 87.8
branch 12 20 60.0
condition 1 3 33.3
subroutine 15 16 93.7
pod 8 8 100.0
total 101 121 83.4


line stmt bran cond sub pod time code
1             # Copyright © 2007-2010 Raphaël Hertzog
2             # Copyright © 2009, 2012-2015 Guillem Jover
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 .
16              
17             package Dpkg::Control::Info;
18              
19 1     1   1664 use strict;
  1         2  
  1         31  
20 1     1   6 use warnings;
  1         2  
  1         40  
21              
22             our $VERSION = '1.01';
23              
24 1     1   6 use Dpkg::Control;
  1         1  
  1         89  
25 1     1   8 use Dpkg::ErrorHandling;
  1         2  
  1         65  
26 1     1   6 use Dpkg::Gettext;
  1         2  
  1         66  
27              
28 1     1   8 use parent qw(Dpkg::Interface::Storable);
  1         2  
  1         5  
29              
30             use overload
31 1     1   117 '@{}' => sub { return [ $_[0]->{source}, @{$_[0]->{packages}} ] };
  1     2   3  
  1         8  
  2         12  
  2         10  
32              
33             =encoding utf8
34              
35             =head1 NAME
36              
37             Dpkg::Control::Info - parse files like debian/control
38              
39             =head1 DESCRIPTION
40              
41             It provides a class to access data of files that follow the same
42             syntax as F.
43              
44             =head1 METHODS
45              
46             =over 4
47              
48             =item $c = Dpkg::Control::Info->new(%opts)
49              
50             Create a new Dpkg::Control::Info object. Loads the file from the filename
51             option, if no option is specified filename defaults to F.
52             If a scalar is passed instead, it will be used as the filename. If filename
53             is "-", it parses the standard input. If filename is undef no loading will
54             be performed.
55              
56             =cut
57              
58             sub new {
59 1     1 1 13 my ($this, @args) = @_;
60 1   33     8 my $class = ref($this) || $this;
61 1         5 my $self = {
62             source => undef,
63             packages => [],
64             };
65 1         3 bless $self, $class;
66              
67 1         2 my %opts;
68 1 50       5 if (scalar @args == 0) {
    50          
69 0         0 $opts{filename} = 'debian/control';
70             } elsif (scalar @args == 1) {
71 1         3 $opts{filename} = $args[0];
72             } else {
73 0         0 %opts = @args;
74             }
75              
76 1 50       376 $self->load($opts{filename}) if $opts{filename};
77              
78 1         4 return $self;
79             }
80              
81             =item $c->reset()
82              
83             Resets what got read.
84              
85             =cut
86              
87             sub reset {
88 1     1 1 2 my $self = shift;
89 1         38 $self->{source} = undef;
90 1         4 $self->{packages} = [];
91             }
92              
93             =item $c->parse($fh, $description)
94              
95             Parse a control file from the given filehandle. Exits in case of errors.
96             $description is used to describe the filehandle, ideally it's a filename
97             or a description of where the data comes from. It is used in error messages.
98             The data in the object is reset before parsing new control files.
99              
100             =cut
101              
102             sub parse {
103 1     1 1 4 my ($self, $fh, $desc) = @_;
104 1         4 $self->reset();
105 1         6 my $cdata = Dpkg::Control->new(type => CTRL_INFO_SRC);
106 1 50       15 return if not $cdata->parse($fh, $desc);
107 1         3 $self->{source} = $cdata;
108 1 50       2 unless (exists $cdata->{Source}) {
109 0         0 $cdata->parse_error($desc, g_('first block lacks a Source field'));
110             }
111 1         3 while (1) {
112 4         15 $cdata = Dpkg::Control->new(type => CTRL_INFO_PKG);
113 4 100       45 last if not $cdata->parse($fh, $desc);
114 3         7 push @{$self->{packages}}, $cdata;
  3         7  
115 3 50       9 unless (exists $cdata->{Package}) {
116 0         0 $cdata->parse_error($desc, g_("block lacks the '%s' field"),
117             'Package');
118             }
119 3 50       7 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             =item $c->load($file)
128              
129             Load the content of $file. Exits in case of errors. If file is "-", it
130             loads from the standard input.
131              
132             =item $c->[0]
133              
134             =item $c->get_source()
135              
136             Returns a Dpkg::Control object containing the fields concerning the
137             source package.
138              
139             =cut
140              
141             sub get_source {
142 1     1 1 1180 my $self = shift;
143 1         4 return $self->{source};
144             }
145              
146             =item $c->get_pkg_by_idx($idx)
147              
148             Returns a Dpkg::Control object containing the fields concerning the binary
149             package numbered $idx (starting at 1).
150              
151             =cut
152              
153             sub get_pkg_by_idx {
154 2     2 1 6 my ($self, $idx) = @_;
155 2         7 return $self->{packages}[--$idx];
156             }
157              
158             =item $c->get_pkg_by_name($name)
159              
160             Returns a Dpkg::Control object containing the fields concerning the binary
161             package named $name.
162              
163             =cut
164              
165             sub get_pkg_by_name {
166 1     1 1 3 my ($self, $name) = @_;
167 1         3 foreach my $pkg (@{$self->{packages}}) {
  1         4  
168 3 100       7 return $pkg if ($pkg->{Package} eq $name);
169             }
170 0         0 return;
171             }
172              
173              
174             =item $c->get_packages()
175              
176             Returns a list containing the Dpkg::Control objects for all binary packages.
177              
178             =cut
179              
180             sub get_packages {
181 0     0 1 0 my $self = shift;
182 0         0 return @{$self->{packages}};
  0         0  
183             }
184              
185             =item $str = $c->output([$fh])
186              
187             Return the content info into a string. If $fh is specified print it into
188             the filehandle.
189              
190             =cut
191              
192             sub output {
193 1     1 1 890 my ($self, $fh) = @_;
194 1         3 my $str;
195 1         12 $str .= $self->{source}->output($fh);
196 1         3 foreach my $pkg (@{$self->{packages}}) {
  1         4  
197 3 50       8 print { $fh } "\n" if defined $fh;
  3         5  
198 3         9 $str .= "\n" . $pkg->output($fh);
199             }
200 1         3 return $str;
201             }
202              
203             =item "$c"
204              
205             Return a string representation of the content.
206              
207             =item @{$c}
208              
209             Return a list of Dpkg::Control objects, the first one is corresponding to
210             source information and the following ones are the binary packages
211             information.
212              
213             =back
214              
215             =head1 CHANGES
216              
217             =head2 Version 1.01 (dpkg 1.18.0)
218              
219             New argument: The $c->new() constructor accepts an %opts argument.
220              
221             =head2 Version 1.00 (dpkg 1.15.6)
222              
223             Mark the module as public.
224              
225             =cut
226              
227             1;