File Coverage

blib/lib/Debian/Control.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

=head1 NAME

Debian::Control - manage Debian source package control files

=head1 SYNOPSIS

    my $c = Debian::Control->new();         # construct a new
    $c->read($file);                        # parse debian/control file
    $c->write($file);                       # write to file
    print $c->source->Source;
    print $c->source->Build_Depends;        # Debian::Dependencies object
    $c->binary->{'libfoo-perl'}->Description(
        "Foo Perl module\n" .
        " Foo makes this and that"
    );

=head1 DESCRIPTION

Debian::Control can be used for representation and manipulation of Debian
source package control files in an object-oriented way. It provides easy
reading and writing of the F file found in Debian source
packages.

=head1 FIELDS

=over

=item source

An instance of L class. Contains the source
stanza of the Debian source package control file.

=item binary

A hash reference with keys being binary
package names and values instances of L class.
Contains the information of the binary package stanzas of Debian source package
control file.

=item binary_tie

A L object tied to the B hash.

=back

=cut

package Debian::Control;

use base 'Class::Accessor';
use strict;
use warnings;

our $VERSION = '0.77';

__PACKAGE__->mk_accessors(qw( source binary binary_tie _parser ));

use Parse::DebControl;
use Debian::Control::Stanza::Source;
use Debian::Control::Stanza::Binary;

=head1 CONSTRUCTOR

=over

=item new

Constructs a new L instance.

The C field is initialized with an empty instance of
L and C field is initialized with an
empty instance of L.

=back

=cut

sub new {
    my $class = shift;

    my $self = $class->SUPER::new();

    $self->_parser( Parse::DebControl->new );

    my %b;
    $self->binary_tie( tie %b, 'Tie::IxHash' );
    $self->binary( \%b );
    $self->source( Debian::Control::Stanza::Source->new );

    return $self;
}

=head1 METHODS

=over

=item read I

Parse L and populate C and C accessors.

I can be either a file name, an opened file handle or a string scalar
reference.

=cut

sub read {
    my ( $self, $file ) = @_;

    my $parser_method = 'parse_file';

    if ( ref($file) ) {
        $file          = $$file;
        $parser_method = 'parse_mem';
    }

    my $stanzas = $self->_parser->$parser_method( $file,
        { useTieIxHash => 1, verbMultiLine => 1 } );

    for (@$stanzas) {
        if ( $_->{Source} ) {
            $self->source( Debian::Control::Stanza::Source->new($_) );
        }
        elsif ( $_->{Package} ) {
            $self->binary_tie->Push(
                $_->{Package} => Debian::Control::Stanza::Binary->new($_) );
        }
        else {
            die "Got control stanza with neither Source nor Package field\n";
        }
    }
}

=item write I

Writes a debian/control-like file in I with the contents defined in the
C and C fields.

I can be either a file name, an opened file handle or a string scalar
reference.

All dependency lists are sorted before writing.

=cut

sub write {
    my ( $self, $file ) = @_;

    for my $s ( $self->source, $self->binary_tie->Values ) {
        for ( $s->fields ) {
            $s->$_->sort if $s->is_dependency_list($_);
        }
    }

    if ( ref($file) and ref($file) eq 'SCALAR' ) {
        $$file = join( "\n", $self->source, $self->binary_tie->Values );
    }
    elsif ( ref($file) and ref($file) eq 'GLOB' ) {
        $file->print( join( "\n", $self->source, $self->binary_tie->Values ) );
    }
    else {
        my $fh;
        open $fh, '>', $file or die "Unable to open '$file' for writing: $!";

        print $fh join( "\n", $self->source, $self->binary_tie->Values );
    }
}

=item is_arch_dep

Returns true if the package is architecture-dependent. This is determined by
the C field of the first binary package. If it equals to C,
then the package is architecture-independent; otherwise it is
architecture-dependent.

Returns I if it is not possible to determine whether the package is
architecture-dependent or not. This is the case when there are no binary
package stanzas present or the first has no C field.

=cut

sub is_arch_dep {
    my $self = shift;

    my $bin = $self->binary_tie->Values(0);

    return undef unless $bin;

    my $arch = $bin->Architecture;

    return undef unless defined($arch);

    return ( $arch ne 'all' );
}

=back

=head1 SEE ALSO

L, L,
L

=head1 COPYRIGHT & LICENSE

Copyright (C) 2009 Damyan Ivanov L

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License version 2 as published by the Free
Software Foundation.

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.

=cut

1;