File Coverage

lib/CGI/ValidOp/Op.pm

Criterion	Covered	Total	%
statement	52	52	100.0
branch	16	18	88.8
condition	6	6	100.0
subroutine	10	10	100.0
pod	0	4	0.0
total	84	90	93.3

package CGI::ValidOp::Op;
use strict;
use warnings;

use base qw/ CGI::ValidOp::Base /;
use CGI::ValidOp::Param;
use Data::Dumper;
use Carp;

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub PROPERTIES {
    {
        name        => undef,
        alias       => undef,
        error_op    => undef,
        -error_decoration    => undef,
        on_error_return => 'undef',
    }
}

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# the argument parsing means:
# 1) if an argument is an existing method, take it as a config option
# 2) else take it as a param
# FIXME should have a params key instead; this is too magical
sub init {
    my $self = shift;
    my( $args ) = @_;

    $self->SUPER::init; # FIXME nasty hack to get around methods not being
                        # defined 'cause we return if no input
    $self->set_name( $args )
        or croak 'Name required in CGI::ValidOp::Op::init.';

    return $self unless ref $args eq 'HASH';
    my( %config, %params );
    for( keys %$args ) {
        $self->can( $_ )
            ? $config{ $_ } = $args->{ $_ }
            : $params{ $_ } = $args->{ $_ };
    }
    $self->SUPER::init( \%config );
    for( keys %params ) {
        $params{ $_ }->{ name } = $_;
        $self->add_param( $params{ $_ });
    }
    $self;
}

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# takes a hashref specifying a parameter
sub add_param {
    my $self = shift;
    my( $vars ) = @_;

    if( defined $vars and ref $vars eq '' ) {
        $vars = { name => $vars };
    }

    $vars->{ on_error_return } = $self->on_error_return;
    croak 'no param created'
        unless my $param = CGI::ValidOp::Param->new( $vars );
    $param->error_decoration( $self->error_decoration );
    $self->{ _params }{ $param->name } = $param;
    $param;
}

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# returns all Param objects unless asked for one
# also sets new checks for a param if they're given
sub Param {
    my $self = shift;
    my( $param_name, $checks ) = @_;

    if( $param_name ) {
        my $param = $self->{ _params }{ $param_name };
        $param->checks( $checks ) if $param and $checks;
        return $param;
    }

    my @params;
    push @params => $self->{ _params }{ $_ }
        for sort keys %{ $self->{ _params }};
    return unless @params;
    wantarray ? @params : \@params;
}

1;

__END__