libdebian-source-perl 0.99 / usr / share / perl5 / Debian / Control.pm

=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<debian/control> file found in Debian source
packages.

=head1 FIELDS

=over

=item source

An instance of L<Debian::Control::Stanza::Source> 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<Debian::Control::Stanza::Binary> class.
Contains the information of the binary package stanzas of Debian source package
control file.

=item binary_tie

A L<Tie::IxHash> object tied to the B<binary> hash.

=back

=cut

package Debian::Control;

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

our $VERSION = '0.99';

__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<Debian::Control> instance.

The C<source> field is initialized with an empty instance of
L<Debian::Control::Stanza::Source> and C<binary> field is initialized with an
empty instance of L<Tie::IxHash>.

=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<file>

Parse L<debian/control> and populate C<source> and C<binary> accessors.

I<file> 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, stripComments => 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<file>

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

I<file> 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<Architecture> field of the first binary package. If it equals to C<all>,
then the package is architecture-independent; otherwise it is
architecture-dependent.

Returns I<undef> 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<Archiitecture> 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<Debian::Control::Stanza::Source>, L<Debian::Control::Stanza::Binary>,
L<Debian::Control::FromCPAN>

=head1 COPYRIGHT & LICENSE

Copyright (C) 2009 Damyan Ivanov L<dmn@debian.org>

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;