File Coverage

blib/lib/Debian/Copyright/Stanza.pm

Criterion	Covered	Total	%
statement	53	53	100.0
branch	7	10	70.0
condition	2	4	50.0
subroutine	12	12	100.0
pod	5	5	100.0
total	79	84	94.0

=head1 NAME

Debian::Copyright::Stanza - single stanza of Debian copyright file

=head1 VERSION

This document describes Debian::Copyright::Stanza version 0.2 .

=head1 SYNOPSIS

    package Header;
    use base 'Debian::Copyright::Stanza';
    use constant fields => qw(
        Format_Specification
        Name
        Source
        Maintainer
        X_Comment
    );

    1;

=head1 DESCRIPTION

Debian::Copyright::Stanza is the base class for
L, L and
L classes.

=cut

package Debian::Copyright::Stanza;

require v5.10.1;
use strict;
use base qw( Class::Accessor Tie::IxHash );
use Carp qw(croak);
use Debian::Copyright::Stanza::OrSeparated;

our $VERSION = '0.2';

=head1 FIELDS

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

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

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

=cut

use constant fields => ();

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

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

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

=head1 CONSTRUCTOR

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

Creates a new L object and optionally initialises it
with the supplied data. The object is hashref based and tied to L.

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

    my $s = Debian::Copyright::Stanza::Header( {Name => "Blah"} );
    print $s->Name;

=cut

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)";
        if ( $self->is_or_separated($k) ) {
            $self->$k( Debian::Copyright::Stanza::OrSeparated->new( $v ) );
        }
        else {
            $self->$k($v);
        }
    }

    return $self;
}

=head1 METHODS

=head2 is_or_separated($field)

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

=cut

sub is_or_separated {
    my( $self, $field ) = @_;
    return 0;
}

=head2 get($field)

Overrides the default get method from L with L's
FETCH.

=cut

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

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

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

=head2 set( $field, $value )

Overrides the default set method from L with L's
STORE.

=cut

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

    chomp($value);

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

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

=head2 as_string([$width])

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

=cut

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);

        my $line = "$k: $v";
        push @lines, $line if $line;
    }

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

=head1 COPYRIGHT & LICENSE

Copyright (C) 2011 Nicholas Bamber

This module is substantially based upon L.
Copyright (C) 2009 Damyan Ivanov L [Portions]

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;