ParameterException.pm

Code Index:


#
# 	sebastien.letort@toulouse.inra.fr
#	Created: May 04, 2007
#	Last Updated: september 18, 2007
#

package LipmError::ParameterException;


NAME

        LipmError::ParameterException - a class to define specific exception of Parameter


SYNOPSIS

        throw LipmError::ParameterException('param', 'missing');
        record LipmError::ParameterException('param', 'type', -text => "seul les entiers sont valides pour ce parametre");
        new LipmError::ParameterException('param', 'value', -should_be => "without figures");
        catch LipmError::ParameterException with {...}


DESCRIPTION

        This class deals with Parameters exceptions like 'missing', 'wrong-parameter'.
        it has built-in messages, all you have to do is to specify which kind of error you have


SUBROUTINES

        new
        Explain


AUTHOR

        Sebastien Letort : sebastien.letort@toulouse.inra.fr
use warnings;
use strict;

## this class inherit from LipmError.pm
use base qw(LipmError);

use UNIVERSAL qw( isa );

BEGIN
{
    our $VERSION = do {my @r = (q$Rev$ =~ /\d+/g); $r[0]};
}

# closure to make sure that %_h_msg will not be changed by other classes
# 	should i use constant ?
{

    my %_h_msg = (
                  'missing' => " is missing where it is needed.",
                  'type'    => " has a wrong type.",
                  'value'   => " has an incorrect value.",
                  'x'       => "no information transmitted"
                  );

    sub _GetMessage
    {
        my ($keyword) = @_;
        return $_h_msg{$keyword};
    }
}

Function new

 Title        : new
 Usage        : throw LipmError::ParameterException
                                ($param, $keyword [, -should_be => $string, -depth => $depth])
 Prerequisite : it's better for an error to be catch !
 Function     : Constructor
 Returns      : an Error object that should be catched.
 Args         : $param, name of the parameter that cause the Error thrown.
                $keyword, une clef du hash de message predefini
                $string,        a message explaining what it should be cf Explain().
                $depth, to specify how deep the error is thrown.
                        I don't know yet when you have to set it,
                        but (for now) in most cases, just forget it.
 Globals      : none
sub new
{
    my $class = shift;
    my ($param, $keyword) = (shift, shift);
    my %h_param = (
                   -should_be => '',
                   -depth     => 0,
                   @_
                   );

    local $Error::Depth = $Error::Depth + 1 + $h_param{-depth};
    local $Error::Debug = 1;                                      # Enables storing of stacktrace

    my $text = $param . " " . _GetMessage($keyword) . "\n";
    my $o_err = $class->SUPER::new(
                                   -param_name => $param,
                                   -msg        => _GetMessage($keyword),
                                   -text       => $text,
                                   %h_param
                                   );

    return $o_err;
}

Function Explain

 Title        : Explain
 Usage        : $error_msg = $err->Explain($bool);
 Prerequisite : none
 Function     : provide a short explanation. It's for developement purpose, not user information
 Returns      : a string describing the error
 Args         : $bool, if true, will (try to) explain what must be changed to be correct.
 Globals      : none
sub Explain
{
    my $self = shift;
    my ($boolean) = @_;

    # Test boolean :
    $boolean = 0 if (!defined($boolean));
    if ($boolean =~ /1|true|True/)
    {
        $boolean = 1;
    }
    else
    {
        $boolean = 0;
    }

    # Construct message
    my $msg = $self->GetMsg() . $self->text();

    if ((1 == $boolean) and ($self->{-should_be} ne ''))
    {
        $msg .= "It should be " . $self->{-should_be} . " to be correct.\n";
    }

    return $msg;
}

Function Procedure

 Title        : Assert
 Usage        : LipmError::ParameterException::Assert( 'var'=>$var, 'name'=>$name );
 Prerequisite : static method
 Procedure    : throw a PE error if one of %h_vars values is undef, with the 'missing' keyword
 Args         : %h_vars, keys are variable names and values are variable value
 Globals      : none
 Error        : a ParameterException
sub Assert
{
    my (%h_vars) = @_;

    # to allow the use of the class without Enum class.
    my $enum_lib;
    eval('use Enum;');
    $enum_lib = 1 if (!$@);

    # the enum option
    my $o_enum = delete $h_vars{-enum};
    $o_enum = undef unless (UNIVERSAL::isa($o_enum, 'Enum'));

    # the min-max option
    # TODO

    my @a_keys = keys %h_vars;

    foreach my $var (@a_keys)
    {

        # I raise the depth of this error not to have an error marked as comming from this file.
        if (!defined $h_vars{$var}) {throw LipmError::ParameterException($var, 'missing', -depth => 1);}

        if (    defined $enum_lib
            and defined $o_enum
            and !$o_enum->IsOk($h_vars{$var}))
        {
            my $list = join ' ', $o_enum->ListItems();
            throw LipmError::ParameterException($var, 'value', -depth => 1, -should_be => "one of the value ( $list )");
        }
    }

    return;
}

1;