Debian::Control::Stanza - single stanza of Debian source package control file


DhMakePerl documentation Contained in the DhMakePerl distribution.

Index


Code Index:

NAME

Top

Debian::Control::Stanza - single stanza of Debian source package control file

SYNOPSIS

Top

    package Binary;
    use base 'Debian::Control::Stanza';
    use constant fields => qw( Package Depends Conflicts );

    1;

DESCRIPTION

Top

Debian::Control::Stanza ins the base class for Debian::Control::Stanza::Source and Debian::Control::Stanza::Binary classes.

FIELDS

Top

Stanza fields are to be defined in the class method fields. Tyically this can be done like:

    use constant fields => qw( Foo Bar Baz );

Fields that are to contain dependency lists (as per is_dependency_list method below) are automatically converted to instances of the Debian::Dependencies class.

CONSTRUCTOR

Top

new
new( { field => value, ... } )

Creates a new Debian::Control::Stanza object and optionally initializes it with the supplied data. The object is hashref based and tied to Tie::IxHash.

You may use dashes for initial field names, but these will be converted to underscores:

    my $s = Debian::Control::Stanza::Source( {Build-Depends => "perl"} );
    print $s->Build_Depends;

METHODS

Top

is_dependency_list($field)

Returns true if $field contains a list of dependencies. By default returns true for the following fields:

Build_Depends
Build_Depends_Indep
Build_Conflicts
Build_Conflicts_Indep
Depends
Conflicts
Enhances
Replaces
Breaks
Pre_Depends
Recommends
Suggests

is_comma_separated($field)

Returns true if the given field is to contain a comma-separated list of values. This is used in stringification, when considering where to wrap long lines.

By default the following fields are flagged to contain such lists:

All fields that contain dependencies (see above)
Uploaders
Provides

get($field)

Overrides the default get method from Class::Accessor with Tie::IxHash's FETCH.

set( $field, $value )

Overrides the default set method from Class::Accessor with Tie::IxHash's STORE. In the process, converts $value to an instance of the Debian::Dependencies class if $field is to contain dependency list (as determined by the is_dependency_list method).

as_string([$width])

Returns a string representation of the object. Ready to be printed into a real debian/control file. Used as a stringification operator.

Fields that are comma-separated use one line per item, except if they are like ${some:Field}, in which case they are wrapped at $widthth column. $width defaults to 80.

COPYRIGHT & LICENSE

Top


DhMakePerl documentation Contained in the DhMakePerl distribution.
package Debian::Control::Stanza;

require v5.10.0;

use strict;

use base qw( Class::Accessor Tie::IxHash );

use Carp qw(croak);
use Debian::Control::Stanza::CommaSeparated;
use Debian::Dependencies;

use constant fields => ();

sub import {
    my( $class ) = @_;

    $class->mk_accessors( $class->fields );
}

use overload '""' => \&as_string;

sub new {
    my $class = shift;
    my $init = shift || {};

    my $self = Tie::IxHash->new;

    bless $self, $class;

    while( my($k,$v) = each %$init ) {
        $k =~ s/-/_/g;
        $self->can($k)
            or croak "Invalid field given ($k)";
        $self->$k($v);
    }

    # initialize any dependency lists with empty placeholders
    # same for comma-separated lists
    for( $self->fields ) {
        if ( $self->is_dependency_list($_) and not $self->$_ ) {
            $self->$_( Debian::Dependencies->new );
        }
        elsif ( $self->is_comma_separated($_) and not $self->$_ ) {
            $self->$_( Debian::Control::Stanza::CommaSeparated->new );
        }
    }


    return $self;
}

our %dependency_list = map(
    ( $_ => 1 ),
    qw( Build-Depends Build-Depends-Indep Build-Conflicts Build-Conflicts-Indep
    Depends Conflicts Enhances Replaces Breaks Pre-Depends Recommends Suggests ),
);

sub is_dependency_list {
    my( $self, $field ) = @_;

    $field =~ s/_/-/g;

    return exists $dependency_list{$field};
}

our %comma_separated = map(
    ( $_ => 1 ),
    keys %dependency_list,
    qw( Uploaders Provides ),
);

sub is_comma_separated {
    my( $self, $field ) = @_;

    $field =~ s/_/-/g;

    return exists $comma_separated{$field};
}

sub get {
    my( $self, $field ) = @_;

    $field =~ s/_/-/g;

    return $self->FETCH($field);
}

sub set {
    my( $self, $field, $value ) = @_;

    chomp($value);

    $field =~ s/_/-/g;

    $value = Debian::Dependencies->new($value)
        if not ref($value) and $self->is_dependency_list($field);

    $value = Debian::Control::Stanza::CommaSeparated->new($value)
        if not ref($value) and $self->is_comma_separated($field);

    return $self->STORE( $field,  $value );
}

use Text::Wrap ();

sub as_string
{
    my ( $self, $width ) = @_;
    $width //= 80;

    my @lines;

    $self->Reorder( map{ ( my $s = $_ ) =~ s/_/-/g; $s } $self->fields );

    for my $k ( $self->Keys ) {
        # We don't' want the internal fields showing in the output
        next if $k =~ /^-/;     # _ in field names is replaced with dashes
        my $v = $self->FETCH($k);
        next unless defined($v);
        next if $self->is_dependency_list($k) and "$v" eq "";
        next if $self->is_comma_separated($k) and "$v" eq "";

        my $line;

        if ( $self->is_comma_separated($k) ) {
            # FIXME: this relies on $v being sorted
            my ( @pre_dollar, @dollar, @post_dollar );
            for ( @$v ) {
                if ( /^\${.+}$/ ) {
                    push @dollar, $_;
                }
                elsif (@dollar) {
                    push @post_dollar, $_;
                }
                else {
                    push @pre_dollar, $_;
                }
            }

            if ( @pre_dollar ) {
                $line = "$k: " . join( ",\n ", @pre_dollar );
                local $Text::Warp::break = qr/, /;
                local $Text::Warp::columns = $width;
                local $Text::Wrap::separator = ",\n";
                local $Text::Wrap::huge = 'overflow';
                $line .= Text::Wrap::wrap( ' ', ' ', join( ', ', @dollar ) );
            }
            else {
                local $Text::Warp::break = qr/, /;
                local $Text::Warp::columns = $width;
                local $Text::Wrap::separator = ",\n";
                local $Text::Wrap::huge = 'overflow';
                $line
                    = Text::Wrap::wrap( "$k: ", ' ', join( ', ', @dollar ) );
            }

            $line = join( ",\n ", $line, @post_dollar );
        }
        else {
            $line = "$k: $v";
        }

        push @lines, $line if $line;
    }

    return join( "\n", @lines ) . "\n";
}

1;