File Coverage

blib/lib/Biblio/bp/lib/bp-p-errors.pl

Criterion	Covered	Total	%
statement	26	64	40.6
branch	18	72	25.0
condition	2	6	33.3
subroutine	1	3	33.3
pod			n/a
total	47	145	32.4

#
# bibliography package for Perl
#
# Error routines
#
# Dana Jacobsen ([e-mail])
# 12 January 1995 (last modified on 17 November 1995)

#
# ignore (0)  don't even record them
# delay  (1)  record them for later
# print  (2)  print immediately (implies report for warns or errors)
# exit   (3)  print and exit (implies report for warns or errors)
#
# totals      returns totals with no other action.
# report      prints all accumulated warns/errors, and clears their strings.
# clear       clears all our strings and totals
#
# All the commands return a list containing 4 elements:
#   num_warns   the number of warnings since the last clear
#   num_errors  the number of errors since the last clear
#   str_warns   the accumulated warning string we have.
#   str_errors  the accumulated error string we have.
#
# (actually, the strings are cleared upon calling report or clear, and the one
#  in question is cleared with a print or exit, so we would no longer actually
#  have the strings any more)
#
# If $glb_error_saveline is set, then the delay strings also include the
# location information.  This is useful if you have delay on for more than
# one record.
#
# The values returned are the values previous to the effect of this command.
# In other words, although a call to bib'errors('clear') will clear out all
# our totals and strings, it will return to you the old totals and strings.
# So you could call clear, but check the return values for any special
# situations.  Note that the strings are cleared upon clear, report, or
# print/exit, but the strings are returned to you.  Unless you did a clear,
# you probably don't need to worry about it.
#

# Example:
#
# &bib'errors('print', 'exit');
# ...do a bunch of normal processing...
# ...getting ready for interesting stuff...
# &bib'errors('delay', 'exit');
# foreach (@records) {
#    ...do a bunch of stuff on each record, accumulating all our warnings...
#    # print out all the warnings for this record with our new citekey
#    &bib'errors('report',undef," ($citekey)");
# }

sub errors {
  local($wlev, $elev, $header) = @_;
  local(@ret);

  &panic("errors called with no arguments") unless defined $wlev;

  # check sanity of arguments given
  if ($wlev !~ /^(ignore|delay|print|exit|report|totals|clear)$/) {
    return &bib'error("Unknown first argument to errors routine");
  }
  if (defined $elev) {
    if ($elev !~ /^(ignore|delay|print|exit)$/) {
      return &bib'error("Unknown second argument to errors routine");
    }
  } else {
    $elev = '';
  }

  @ret = ($glb_num_warns, $glb_num_errors, $glb_str_warns, $glb_str_errors);

  return @ret  if $wlev eq 'totals';

  if ($wlev eq 'clear') {
    $glb_num_errors = 0;
    $glb_num_warns  = 0;
    $glb_str_errors = undef;
    $glb_str_warns  = undef;
    return @ret;
  }

  $glb_warn_level = 0  if ($wlev eq 'ignore');
  $glb_warn_level = 1  if ($wlev eq 'delay');
  $glb_warn_level = 2  if ($wlev eq 'print');
  $glb_warn_level = 3  if ($wlev eq 'exit');

  # Setting the error level to ignore is a Bad Thing.  I suppose there may
  # be cases (debugging, etc.) where we just may want it.  We can't really
  # warn them, since they just told us to shut up...

  $glb_error_level = 0  if ($elev eq 'ignore');
  $glb_error_level = 1  if ($elev eq 'delay');
  $glb_error_level = 2  if ($elev eq 'print');
  $glb_error_level = 3  if ($elev eq 'exit');

  if ( ($wlev =~ /^(report|print|exit)$/) && (defined $glb_str_warns) ) {
    $header = '' unless defined $header;
    foreach $warn ( split(/\n/, $glb_str_warns) ) {
      print STDERR "bp warning$header: $warn\n";
    }
    $glb_str_warns = undef;
  }

  if ( ($elev =~ /^(report|print|exit)$/) && (defined $glb_str_errors) ) {
    $header = '' unless defined $header;
    foreach $error ( split(/\n/, $glb_str_errors) ) {
      print STDERR "bp error$header: $error\n";
    }
    $glb_str_errors = undef;
  }

  @ret;
}

#
# This must return undef, so programs can use 'return &goterror("ack!")'
#
sub goterror {
  local($error, $linenum) = @_;

  &panic("Error, but no error message") unless defined $error;

  $glb_num_errors++;
  return undef if $glb_error_level == 0;

  if (defined $linenum) {
    # $linenum = $linenum;
  } elsif (defined $glb_vloc) {
    $linenum = $glb_vloc;
  } elsif (defined $glb_Ifilename) {
    $linenum = sprintf("record %4d", $glb_filelocmap{$glb_Ifilename});
  } else {
    $linenum = 'main';
  }

  die          "bp error ($linenum): $error\n" if $glb_error_level == 3;
  print STDERR "bp error ($linenum): $error\n" if $glb_error_level == 2;
  if ($glb_error_level == 1) {
    $glb_str_errors .= "($linenum): " if $glb_error_saveline;
    $glb_str_errors .= "$error\n"
  }

  undef;
}

sub gotwarn {
  local($warn, $linenum) = @_;

  &panic("Warning, but no warning message") unless defined $warn;

  $glb_num_warns++;
  return undef if $glb_warn_level == 0;

  if (defined $linenum) {
    # $linenum = $linenum;
  } elsif (defined $glb_vloc) {
    $linenum = $glb_vloc;
  } elsif (defined $glb_Ifilename) {
    $linenum = sprintf("record %4d", $glb_filelocmap{$glb_Ifilename});
  } else {
    $linenum = 'main';
  }

  die          "bp warning ($linenum): $warn\n" if $glb_warn_level == 3;
  print STDERR "bp warning ($linenum): $warn\n" if $glb_warn_level == 2;
  if ($glb_warn_level == 1) {
    $glb_str_warns .= "($linenum): " if $glb_error_saveline;
    $glb_str_warns .= "$warn\n";
  }

  undef;
}

1;