stdapp.pm

来自「用于词法分析的词法分析器」· PM 代码 · 共 86 行

# $Id: StdApp.pm,v 1.1 1997/04/19 01:42:20 matt Exp $
#
# Standard Perl application support.
#
# (c) 1997 Matt Phillips.

package StdApp;
require 5.000;
require Exporter;
use File::Basename;

@ISA = qw(Exporter);
@EXPORT = qw(&error &warning &say &doCleanup &addCleanup
	     &removeCleanup &systemExec $VERBOSE);

$VERBOSE = 0;

$appName = basename ($0);

$SIG{'INT'} = $SIG{'QUIT'} = sub {&doCleanup; exit (1);};

END
{
  doCleanup ();
}

sub error
{
  my ($message) = @_;

  $message = 'fatal error' if !$message;

  print STDERR ("$appName: error: $message\n") ;

  exit (1);
}

sub warning
{
  print STDERR ("$appName: warning: @_\n");
}

sub say
{
  print STDERR ("$appName: trace: @_\n") if $VERBOSE;
}

sub doCleanup
{
  say ("start cleanup");

  for $_ (keys %cleanupList)
  {
    my $subroutine = $cleanupList{$_};

    if ($subroutine && !&{$subroutine})
    {
      print STDERR ("$appName: cleanup: failed $_\n");
    }
  }

  %cleanupList = ();
}

sub addCleanup
{
  $cleanupList{$_[0]} = $_[1];
}

sub removeCleanup
{
  undef ($cleanupList{$_[0]});
}

sub systemExec
{
  my ($command, $message) = @_;

  say ("exec '$command'");
  my $result = (system ($command) >> 8);

  error ($message ? $message : "command failed '$command'") if $result != 0;

  return 1;
}