IOException.pm

Code Index:


#
# 	olivier.stahl@toulouse.inra.fr
#	Created: May 15, 2007
#	Last Updated: Jun 12, 2007
#

package LipmError::IOException;


NAME

        LipmError::IOException - a class to define specific exception of Input/Output


SYNOPSIS


        new LipmError::IOException($io_file [,$test_type]);

        throw LipmError::IOException('io_file' [,$test_type]);
        where $test_type is 'f' or 'file' or 'd' or 'dir' or 'directory'
        catch LipmError::IOException with {...}


DESCRIPTION

        With this class you can describe all type of exception encountered by Input/Output.
        
=head2 ERROR MESSAGES
        keyword                 =>      message
        'default'               =>      "no IO error has been found",
        'exist'                 =>      "exist",
        '!exist'                =>      "not exist",
        '!readable'             =>      "is not readable",
        '!writable'             =>      "can't be write",
        '!executable'   =>      "is not executable",
        'file'                  =>      "is a file",
        '!file'                 =>      "is not a file",
        'dir'                   =>      "is a directory",
        '!dir'                  =>      "is not a directory",
        'pipe'                  =>      "is a pipe",
        '!pipe'                 =>      "is not a pipe",
        'empty'                 =>      "this file is empty"
        
=head2 ERROR KEYS
        -handler                => handler which cause the error
        -keyword                => keyword that describe the error (see below)
        
=head1 SUBROUTINES
        Explain
        ErrorTypeToString
        TestDir
        TestFile
        TestIO


AUTHOR

        Olivier Stahl : olivier.stahl@toulouse.inra.fr
use warnings;
use strict;

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

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

my %h_msg = (
             'default'     => "no IO error has been found",
             'exist'       => "exist",
             '!exist'      => "not exist",
             '!readable'   => "is not readable",
             '!writable'   => "can't be write",
             '!executable' => "is not executable",
             'file'        => "is a file",
             '!file'       => "is not a file",
             'dir'         => "is a directory",
             '!dir'        => "is not a directory",
             'pipe'        => "is a pipe",
             '!pipe'       => "is not a pipe",
             'empty'       => "this file is empty"
             );

##################################################
###########			Constructor		 #############
##################################################

Function new

 Title        : new
 Usage        : throw LipmError::IOException($io_file [,$test_type])
 Prerequisite : it's better for an error to be catch !
 Function     : Constructor
 Returns      : an Error object that should be catch
 Args         : $io_file
                                $test_type      => 'f'|'file'  or  'd'|'dir'|'directory'
 Globals      : none
sub new
{
    my $class = shift;
    my ($io_file, $test_type) = (shift, shift);
    my @args           = (@_);    # @_ to propagate other options
    my $keyword        = "";
    my $bool_arg_error = 0;

    # Test parameters :
    $bool_arg_error = 1 if (!defined $io_file);
    if (!defined $test_type)
    {
        $keyword = $class->TestIO($io_file);
    }
    elsif ($test_type =~ /f|file/)
    {
        $keyword = $class->TestFile($io_file);
    }
    elsif ($test_type =~ /d|dir|directory/)
    {
        $keyword = $class->TestDir($io_file);
    }
    else
    {
        $bool_arg_error = 1;
    }

    # Set stacktrace parameters
    local $Error::Depth = $Error::Depth + 1;
    local $Error::Debug = 1;

    # Construct the exception object
    my $self;
    if ($bool_arg_error == 1)
    {
        $self = $class->SUPER::new(@args);
    }
    else
    {
        $self = $class->SUPER::new(
                                   -handler => $io_file,
                                   -keyword => $keyword,
                                   -text    => $io_file . " " . $h_msg{$keyword} . "\n",
                                   @args
                                   );
    }

    return $self;
}

##################################################
###########			Function		 #############
##################################################

Function Explain

 Title        : Explain
 Usage        : $msg = $err->Explain();
 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;

    return $self->text if ($self->{-keyword} eq 'default');

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

    return $msg;
}

Function ErrorTypeToString

 Title        : ErrorTypeToString
 Usage        : $string = LipmError::IOException -> ErrorTypeToString($keyword);
 Prerequisite : none
 Function     : return the explanation corresponding to an error type
 Returns      : the string corresponding to the error type explanation
 Args         : $keyword -> the error type keyword
 Globals      : none
sub ErrorTypeToString
{
    my ($class, $keyword) = (shift, shift) or return;
    my $error_type = $h_msg{$keyword} or return "Unknown error keyword.";

    return $error_type;
}

Function TestIO

 Title        : TestIO
 Usage        : $error_type = $self -> TestIO($io_file);
 Prerequisite : none
 Function     : test the io_file and return the error type
 Returns      : the keyword corresponding to the error type
 Args         : $io_file -> the name of the handler to test
 Globals      : none
sub TestIO
{
    my ($self, $io_file) = (shift, shift);
    my $error_type = 'default';

    if (!-e $io_file)
    {
        return $error_type = '!exist';
    }
    elsif (!-r $io_file)
    {
        return $error_type = '!readable';
    }
    elsif (!-w $io_file)
    {
        return $error_type = '!writable';
    }

    return $error_type;
}

Function TestFile

 Title        : TestFile
 Usage        : $error_type = $self -> TestFile($io_file);
 Prerequisite : none
 Function     : test the io_file to return specific file errors
 Returns      : the keyword corresponding to the error type
 Args         : $io_file -> the file to test
 Globals      : none
sub TestFile
{
    my ($self, $io_file) = (shift, shift) or return;
    my $error_type   = 'default';
    my $primary_test = $self->TestIO($io_file);

    return $primary_test if ($primary_test eq '!exist');

    if (-f $io_file)
    {
        $error_type = $primary_test unless ($primary_test eq 'default');
        $error_type = 'empty' if (-z $io_file && $primary_test eq 'default');
    }
    else
    {
        $error_type = '!file';
    }

    return $error_type;
}

Function TestDir

 Title        : TestDir
 Usage        : $error_type = $self -> TestDir($io_dir);
 Prerequisite : none
 Function     : test the io_dir to return specific directory errors
 Returns      : the keyword corresponding to the error type
 Args         : $io_dir -> the directory to test
 Globals      : none

sub TestDir
{
    my ($self, $io_dir) = (shift, shift) or return;
    my $error_type   = 'default';
    my $primary_test = $self->TestIO($io_dir);

    return $primary_test if ($primary_test eq '!exist');

    if (!-d $io_dir)
    {
        $error_type = '!dir';
    }

    return $error_type;
}

1;