File Coverage

blib/lib/Data/CPAN/DSLIP/Explain.pm

Criterion	Covered	Total	%
statement	36	36	100.0
branch	3	4	75.0
condition			n/a
subroutine	8	8	100.0
pod	3	3	100.0
total	50	51	98.0

package Data::CPAN::DSLIP::Explain;

use warnings;
use strict;

our $VERSION = '0.04';

use Carp;

sub new {
    my $class = shift;
    croak "Must have even number of arguments to ->new()"
        if @_ & 1;
    my %args = @_;
    $args{ lc $_ } = delete $args{ $_ } for keys %args;
    return bless \%args, $class;
}

sub dslip {
    my $self = shift;
    my $dslip = $self->_convert_dslip( @_ );
    if ( wantarray ) {
        return @$dslip;
    }
    else {
        return $dslip->[0];
    }
}

sub _convert_dslip {
    my $self = shift;
    my @dslips = @_;

    my $explanation_of = $self->_get_dslip_explanations;
    my @result;
    foreach my $dslip ( @dslips ) {
        my %codes;
        @codes{ qw(D S L I P) } = map { lc } split //, $dslip;

        $codes{ $_ } = $explanation_of->{ $_ }{ $codes{$_} }
            for keys %codes;

        push @result, \%codes;
    }

    return \@result;
}

sub explain_dslip_letter {
    my $self = shift;
    my $dslip_letter = uc shift;
    my $explanation_of = $self->_get_dslip_explanations;
    return $explanation_of->{ $dslip_letter }{info};
}

sub _get_dslip_explanations {
    my $self = shift;
    return {
        D => {
            info   => 'Development Stage (Note: *NO IMPLIED TIMESCALES*)',
            i      => 'Idea, listed to gain consensus or as a placeholder',
            c      => 'under construction but pre-alpha (not yet released)',
            a      => 'Alpha testing',
            b      => 'Beta testing',
            r      => 'Released',
            'm'    => 'Mature (no rigorous definition)',
            's'    => 'Standard, supplied with Perl',
        },

        S => {
            info    => 'Support Level',
            'm'     => 'Mailing-list',
            d       => 'Developer',
            u       => 'Usenet newsgroup comp.lang.perl.modules',
            n       => 'None known, try comp.lang.perl.modules',
        },

        L => {
            info    => 'Language Used',
            p       => 'Perl-only, no compiler needed, '
                        . 'should be platform independent',
            c       => 'C and perl, a C compiler will be needed',
            h       => 'written in perl with optional C code, '
                            . 'no compiler needed',
            '+'     => 'C++ and perl, a C++ compiler will be needed',
            o       => 'perl and another language other than C or C++',
        },

        I => {
            info    => 'Interface Style',
            f       => 'plain Functions, no references used',
            h       => 'hybrid, object and function interfaces available',
            n       => 'no interface at all (huh?)',
            r       => 'some use of unblessed References or ties',
            o       => 'Object oriented using blessed references '
                        . 'and/or inheritance',
        },

        P => {
            info    => 'Public License',
            p       => 'Standard-Perl: user may choose between GPL '
                            . 'and Artistic',
            g       => 'GPL: GNU General Public License',
            l       => 'LGPL: "GNU Lesser General Public License"'
                        . '(previously known as "GNU Library '
                        . 'General Public License")',
            b       => 'BSD: The BSD License',
            a       => 'Artistic license alone',
            o       => 'other (but distribution allowed '
                            . 'without restrictions)',
        }
    }
}

1;
__END__