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