# # olivier.stahl@toulouse.inra.fr # Created: May 15, 2007 # Last Updated: Jun 12, 2007 # package LipmError::IOException;
LipmError::IOException - a class to define specific exception of Input/Output
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 {...}
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
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 ############# ##################################################
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 ############# ##################################################
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; }
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; }
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; }
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; }
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;