scripts/Dpkg/Control/Info.pm

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