| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193 |
- # Copyright © 2007 Raphaël Hertzog <hertzog@debian.org>
- #
- # This program is free software; you can redistribute it and/or modify
- # it under the terms of the GNU General Public License as published by
- # the Free Software Foundation; either version 2 of the License, or
- # (at your option) any later version.
- #
- # This program is distributed in the hope that it will be useful,
- # but WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- # GNU General Public License for more details.
- #
- # You should have received a copy of the GNU General Public License
- # along with this program. If not, see <http://www.gnu.org/licenses/>.
- package Dpkg::Control::Info;
- use strict;
- use warnings;
- use Dpkg::Control;
- use Dpkg::ErrorHandling;
- use Dpkg::Gettext;
- =head1 NAME
- Dpkg::Control::Info - parse files like debian/control
- =head1 DESCRIPTION
- It provides an object to access data of files that follow the same
- syntax than debian/control.
- =head1 FUNCTIONS
- =over 4
- =item $c = Dpkg::Control::Info->new($file)
- Create a new Dpkg::Control::Info object for $file. If $file is omitted, it parses
- debian/control. If file is "-", it parses the standard input.
- =cut
- sub new {
- my ($this, $arg) = @_;
- my $class = ref($this) || $this;
- my $self = {
- 'source' => undef,
- 'packages' => [],
- };
- bless $self, $class;
- if ($arg) {
- if ($arg eq "-") {
- $self->parse_fh(\*STDIN, _g("standard input"));
- } else {
- $self->parse($arg);
- }
- } else {
- $self->parse("debian/control");
- }
- return $self;
- }
- =item $c->reset()
- Resets what got read.
- =cut
- sub reset {
- my $self = shift;
- $self->{source} = undef;
- $self->{packages} = [];
- }
- =item $c->parse($file)
- Parse the content of $file. Exits in case of errors.
- =cut
- sub parse {
- my ($self, $file) = @_;
- open(CDATA, "<", $file) || syserr(_g("cannot read %s"), $file);
- $self->parse_fh(\*CDATA, $file);
- close(CDATA);
- }
- =item $c->parse_fh($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's used in error
- messages.
- =cut
- sub parse_fh {
- my ($self, $fh, $desc) = @_;
- $self->reset();
- my $cdata = Dpkg::Control->new(type => CTRL_INFO_SRC);
- return if not $cdata->parse_fh($fh, $desc);
- $self->{source} = $cdata;
- unless (exists $cdata->{Source}) {
- syntaxerr($desc, _g("first block lacks a source field"));
- }
- while (1) {
- $cdata = Dpkg::Control->new(type => CTRL_INFO_PKG);
- last if not $cdata->parse_fh($fh, $desc);
- push @{$self->{packages}}, $cdata;
- unless (exists $cdata->{Package}) {
- syntaxerr($desc, _g("block lacks a package field"));
- }
- }
- }
- =item $c->get_source()
- Returns a Dpkg::Control object containing the fields concerning the
- source package.
- =cut
- sub get_source {
- my $self = shift;
- return $self->{source};
- }
- =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
- sub get_pkg_by_idx {
- my ($self, $idx) = @_;
- return $self->{packages}[--$idx];
- }
- =item $c->get_pkg_by_name($name)
- Returns a Dpkg::Control object containing the fields concerning the binary
- package named $name.
- =cut
- sub get_pkg_by_name {
- my ($self, $name) = @_;
- foreach my $pkg (@{$self->{packages}}) {
- return $pkg if ($pkg->{Package} eq $name);
- }
- return undef;
- }
- =item $c->get_packages()
- Returns a list containing the Dpkg::Control objects for all binary packages.
- =cut
- sub get_packages {
- my $self = shift;
- return @{$self->{packages}};
- }
- =item $c->dump($filehandle)
- Dump the content into a filehandle.
- =cut
- sub dump {
- my ($self, $fh) = @_;
- $self->{source}->output($fh);
- foreach my $pkg (@{$self->{packages}}) {
- print $fh "\n";
- $pkg->output($fh);
- }
- }
- =back
- =head1 AUTHOR
- Raphael Hertzog <hertzog@debian.org>.
- =cut
- 1;
|