Class::Param::Base - Abstract class for param implementations

Class-Param documentation Contained in the Class-Param distribution.

Index

Code Index:

NAME

Top

Class::Param::Base - Abstract class for param implementations

SYNOPSIS

Top

    package MyParam;
    use base 'Class::Param::Base';

    sub get    { }
    sub set    { }
    sub names  { }
    sub remove { }

    1;

DESCRIPTION

Top

Abstract class for param implementations

METHODS

Top

param
    # get
    @names   = $param->param;
    $value   = $param->param($name);
    @values  = $param->param($name);

    # set
    $param->param( $name => $value   );
    $param->param( $name => @values  );

    # remove
    $param->param( $name => undef    );
add
    $param->add( $name => $value );
    $param->add( $name => @values );
has
    $boolean = $param->has($name);
clear
    $param->clear;
count
    $count = $param->count;
scan
    $param->scan( sub {
        my ( $name, @values ) = @_;
    });
as_hash
    %hash = $param->as_hash;
    $hash = $param->as_hash;

SUBCLASS

Top

Subclasses must implement the following methods.

new
get
    $value = $param->get($name);
set
    $param->set( $name => $value );
names
    @names = $param->names;
remove
    $removed = $param->remove($name);

SEE ASLO

Top

Class::Param.

AUTHOR

Top

Christian Hansen chansen@cpan.org

COPYRIGHT

Top

This program is free software, you can redistribute it and/or modify it under the same terms as Perl itself.

Class-Param documentation Contained in the Class-Param distribution. 
package Class::Param::Base;

use strict;
use warnings;

use Carp qw[];

BEGIN {

    my @abstract = qw[ new get set names remove ];

    foreach my $abstract ( @abstract ) {

        no strict 'refs';

        *$abstract = sub {
             my $class = ref $_[0] ? ref shift : shift;
             Carp::croak qq/Abstract method '$abstract' must be implemented in '$class'./;
        };
    }
}

sub add {
    my ( $self, $name, @add ) = @_;

    unless ( $self->has($name) ) {

        my $value;

        if ( @add == 1 ) {
            $value = ref $add[0] eq 'ARRAY' ? [ $add[0] ] : $add[0];
        }
        else {
            $value = \@add;
        }

        return $self->set( $name => $value );
    }

    my $value = $self->get($name);

    unless ( ref $value eq 'ARRAY' ) {
        $value = [ $value ];
    }

    push @{ $value }, @add;

    return $self->set( $name => $value );
}

sub has {
    my ( $self, $name ) = @_;

    foreach ( $self->names ) {
        return 1 if $_ eq $name;
    }

    return 0;
}

sub clear {
    my $self = shift;

    foreach ( $self->names ) {
        $self->remove($_);
    }

    return 1;
}

sub count {
    return scalar shift->names;
}

sub param {
    my ( $self, $name, @values ) = @_;

    if ( @_ == 1 ) {
        return $self->names;
    }

    unless ( defined $name ) {
        return wantarray ? () : undef;
    }

    if ( @_ == 2 ) {

        unless ( $self->has($name) ) {
            return wantarray ? () : undef;
        }

        my $value = $self->get($name);

        if ( ref $value eq 'ARRAY' ) {
            return wantarray ? @{ $value } : $value->[0];
        }
        else {
            return wantarray ? ( $value ) : $value;
        }
    }

    if ( @values == 1 && ! defined $values[0] ) {
        return $self->remove($name);
    }

    return $self->set( $name => @values > 1 ? \@values : $values[0] );
}

sub scan {
    my ( $self, $callback ) = @_;

    foreach ( $self->names ) {
        &$callback( $_, $self->param($_) );
    }

    return 1;
}

sub as_hash {
    my $self = shift;
    my %hash = ();

    $self->scan( sub {
        $hash{ shift() } = @_ > 2 ? \@_ : $_[1];
    });

    return wantarray ? %hash : \%hash;
}

1;

__END__