perl 异常处理

摘录自 https://www.oreilly.com/library/view/mastering-perl/9780596527242/ch12.html

内置变量

• $! ($ERRNO and $OS_ERROR)
  系统调用的错误码。
• $? ($CHILD_ERROR)
  子进程状态， (status from the last wait() call)
• $@ ($EVAL_ERROR)
  Error from the last eval()
• $^E ($EXTENDED_OS_ERROR)
  特定于操作系统的错误信息 (Error information specific to the operating system)

第一个例子

open my( $fh ), '<', 'does_not_exist.txt' or die "Couldn't open file! $!";

当代码调用某些系统调用，但是操作系统无法执行该操作，perl将会把错误原因设置在 $!中。在上面的例子中，如果文件不存在，则无法打开，返回false并且显示打开失败。

打印错误码以及错误码的信息

for ($! = 0; $! <= 102; $!++)
        {
        printf("%d: %s\n", $!, $! );
        }

第二个例子

#!/usr/bin/perl

use File::Spec;

my $file = 'does_not_exist.txt';
my $dir  = 'some_dir';
my $fh;

my $try = 0;
OPEN: {
last if $try++ >= 2;
my $path = File::Spec->catfile( $dir, $file );
last if open $fh, '>', $path;

warn "Could not open file: $!...\n";

if( $!{ENOENT} )     # File doesn't exist
        {                # Ensure the directory is there
        warn "\tTrying to make directory $dir...\n";
        mkdir $dir, 0755;
        }
elsif( $!{ENOSPC} )  # Full disk
        {                # Try a different disk or mount point
        warn "\tDisk full, try another partition...\n";
        $dir = File::Spec->catfile(
                File::Spec->rootdir,
                'some_other_disk',
                'some_other_dir'
                );
        }
elsif( $!{EACCES} )  # Permission denied
        {
        warn "\tNo permission! Trying to reset permissions...\n";
        system( '/usr/local/bin/reset_perms' );
        }
else
        {
        # give up and email it directly...
        last;
        }

redo;
}

print $fh "Something very important\n";

%! 也是一个特殊的内置散列，枚举所有的错误码，通过它可以确定特定的错误类型，比如通过$!{EACCES} 就可以确定是
不是权限引起的错误。

第三个例子

system( ... );
`....`;
open my($pipe), "| some_command";
exec( 'some command' );
my $pid = fork(); ...; wait( $pid );

通过以上方式可以调用外部程序，要运行外部程序，perl 首先派生或复制当前进程，然后使用exec
将自身转换为我想要的命令。在父进程中，当子进程停止运行，它将其退出值传递回父级，perl 将
其放入$?

使用例子

close( $pipe ) or die "Child error: $?";
wait( $pid ) or die "Child error: $?";

$? 的值比其他错误变量稍微复杂一些。它实际上是一个单词（两个字节）。高位字节是子进程的退出状态。我可以把所有的位移到正确的八个位置来得到那个数字。此编号特定于我运行的程序，因此我需要检查其文档以指定正确的含义：

my $exit_value = $? >> 8;
my $signal = $? & 127; # or use 0b0111_1111

如果子进程发生内核转储，则需要执行的为下列操作。
my $core_dumped = $? & 128; # or use 0b1000_000;

特定于操作系统的错误

mac环境下的错误

#!/usr/bin/perl
# mac-realplayer.pl

use Mac::Errors qw($MacError);
use Mac::Glue;

print "Trying machine $ENV{REALPLAYER_MACHINE}...\n";

my $realplayer = Mac::Glue->new(
        'Realplayer',
        eppc => 'RealPlayer',
        $ENV{REALPLAYER_MACHINE},
        undef, undef,
        map { $ENV{"REALPLAYER_MACHICE_$_"} } qw( USER PASS )
        );

$realplayer->open_clip( with_url => $ARGV[0] );

if( $^E )
        {
        my $number = $^E + 0;
        die "$number: $MacError\n";
        }

window下的错误

package Text::Template::Simple;

if(IS_WINDOWS) {
 require Win32;
 $wdir = Win32::GetFullPathName($self->{cache_dir});
 if( Win32::GetLastError() ) {
    warn "[  FAIL  ] Win32::GetFullPathName\n" if DEBUG;
    $wdir = ''; # croak "Win32::GetFullPathName: $^E";
 }
 else {
    $wdir = '' unless -e $wdir && -d _;
 }
      }

On VMS, if $!{VMSERR} is true, I’ll find more information in $^E. Other operating systems may use this, too.

模块错误

方式1 通过模块变量

my $tt = Template->new() || carp $Template::ERROR, "\n";

方式2

$tt->process( 'index.html' );
if( my $error = $tt->error )
        {
        croak $error->type . ": " . $error->info;
        }

Exception

例子1

eval {
        ...;

        open my($fh), ">", $file
                or die "Could not open file! $!";
        };
if( $@ )
        {
        ...; # catch die message and handle it
        }

例子2

多层级捕获异常

#!/usr/bin/perl
# chained-die.pl

eval{
        eval {
                eval {
                        # start here
                        open my($fh), ">", "/etc/passwd" or die "$!";
                        };
                if( $@ )
                        {
                        die; # first catch
                        }
                };
        if( $@ )
                {
                die; # second catch
                }
        };
if( $@ )
        {
        print "I got $@"; # finally
        }

输出

I got Permission denied at chained-die.pl line 8.
        ...propagated at chained-die.pl line 12.
        ...propagated at chained-die.pl line 17.

例子3

添加输出信息

#!/usr/bin/perl
# chained-die-more-info.pl

eval{
        eval {
                my $file = "/etc/passwd";

                eval {
                        # start here
                        open my($fh), ">", $file or die "$!";
                        };
                if( $@ )
                        {
                        my $user = getpwuid( $< );
                        my $mode = ( stat $file )[2];
                        $@ .= sprintf "\t%s mode is %o\n", $file, $mode;
                        $@ .= sprintf( "\t%s is not writable by %s\n", $file, $user )
                                unless -w $file;
                        die; # first catch
                        }
                };
        if( $@ )
                {
                die; # second catch
                }
        };
if( $@ )
        {
        print "I got $@"; # finally
        }

输出

I got Permission denied at chained-die-more-info.pl line 10.
        /etc/passwd mode is 100644
        /etc/passwd is not writable by brian
        ...propagated at chained-die-more-info.pl line 19.
        ...propagated at chained-die-more-info.pl line 24.

例子4

自定义异常调用链信息

#!/usr/bin/perl
# chained-die-propagate.pl
use strict;
use warnings;

package Local::Error;

sub new { bless $_[1], $_[0] }

sub PROPAGATE
        {
        my( $self, $file, $line ) = @_;

        $self->{chain} = [] unless ref $self->{chain};
        push @{ $self->{chain} }, [ $file, $line ];

        $self;
        }

package main;

eval{
        eval {
                my $file = "/etc/passwd";

                eval {
                        # start here
                        unless( open my($fh), ">", $file )
                                {
                                die Local::Error->new( { errno => $! } );
                                }
                        };
                if( $@ )
                        {
                        die; # first catch
                        }
                };
        if( $@ )
                {
                die; # second catch
                }
        else
                {
                print "Here I am!\n";

                }
        };
if( $@ )
        {
        use Data::Dumper;
        print "I got " . Dumper($@) . "\n"; # finally
        }

输出

I got $VAR1 = bless( {
                                 'chain' => [
                                                          [
                                                                'chained-die-propagate.pl',
                                                                37
                                                          ],
                                                          [
                                                                'chained-die-propagate.pl',
                                                                42
                                                          ]
                                                        ],
                                 'errno' => 'Permission denied'
                           }, 'Local::Error' );