chiark - git - mdw - dpkg/blob - 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 package Dpkg::Control::Info;
  18
  19 use strict;
  20 use warnings;
  21
  22 our $VERSION = '1.01';
  23
  24 use Dpkg::Control;
  25 use Dpkg::ErrorHandling;
  26 use Dpkg::Gettext;
  27
  28 use parent qw(Dpkg::Interface::Storable);
  29
  30 use overload
  31     '@{}' => sub { return [ $_[0]->{source}, @{$_[0]->{packages}} ] };
  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 an object to access data of files that follow the same
  42 syntax as F<debian/control>.
  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<debian/control>.
  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     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
  83 Resets what got read.
  84
  85 =cut
  86
  87 sub reset {
  88     my $self = shift;
  89     $self->{source} = undef;
  90     $self->{packages} = [];
  91 }
  92
  93 =item $c->load($file)
  94
  95 Load the content of $file. Exits in case of errors. If file is "-", it
  96 loads from the standard input.
  97
  98 =item $c->parse($fh, $description)
  99
 100 Parse a control file from the given filehandle. Exits in case of errors.
 101 $description is used to describe the filehandle, ideally it's a filename
 102 or a description of where the data comes from. It is used in error messages.
 103 The data in the object is reset before parsing new control files.
 104
 105 =cut
 106
 107 sub parse {
 108     my ($self, $fh, $desc) = @_;
 109     $self->reset();
 110     my $cdata = Dpkg::Control->new(type => CTRL_INFO_SRC);
 111     return if not $cdata->parse($fh, $desc);
 112     $self->{source} = $cdata;
 113     unless (exists $cdata->{Source}) {
 114         $cdata->parse_error($desc, g_('first block lacks a Source field'));
 115     }
 116     while (1) {
 117         $cdata = Dpkg::Control->new(type => CTRL_INFO_PKG);
 118         last if not $cdata->parse($fh, $desc);
 119         push @{$self->{packages}}, $cdata;
 120         unless (exists $cdata->{Package}) {
 121             $cdata->parse_error($desc, g_("block lacks the '%s' field"),
 122                                 'Package');
 123         }
 124         unless (exists $cdata->{Architecture}) {
 125             $cdata->parse_error($desc, g_("block lacks the '%s' field"),
 126                                 'Architecture');
 127         }
 128
 129     }
 130 }
 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     my $self = shift;
 143     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     my ($self, $idx) = @_;
 155     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     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
 176 Returns a list containing the Dpkg::Control objects for all binary packages.
 177
 178 =cut
 179
 180 sub get_packages {
 181     my $self = shift;
 182     return @{$self->{packages}};
 183 }
 184
 185 =item $c->output($filehandle)
 186
 187 Dump the content into a filehandle.
 188
 189 =cut
 190
 191 sub output {
 192     my ($self, $fh) = @_;
 193     my $str;
 194     $str .= $self->{source}->output($fh);
 195     foreach my $pkg (@{$self->{packages}}) {
 196         print { $fh } "\n" if defined $fh;
 197         $str .= "\n" . $pkg->output($fh);
 198     }
 199     return $str;
 200 }
 201
 202 =item "$c"
 203
 204 Return a string representation of the content.
 205
 206 =item @{$c}
 207
 208 Return a list of Dpkg::Control objects, the first one is corresponding to
 209 source information and the following ones are the binary packages
 210 information.
 211
 212 =back
 213
 214 =head1 CHANGES
 215
 216 =head2 Version 1.01 (dpkg 1.18.0)
 217
 218 New argument: The $c->new() constructor accepts an %opts argument.
 219
 220 =head2 Version 1.00 (dpkg 1.15.6)
 221
 222 Mark the module as public.
 223
 224 =cut
 225
 226 1;