view release on metacpan or  search on metacpan

lib/Biblio/bp/lib/bp-p-debug.pl  view on Meta::CPAN

  &panic("Assertion failed: $_[$[]",$@) unless eval $_[$[];
}

sub panic {
  select(STDERR);
  print "\nBP ERROR: @_\n";

  if ($] >= 5.000) {
    local($i,$_);
    local($p,$f,$l,$s,$h,$w,$a,@a,@sub);
    for ($i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
      @a = @DB'args;
      for (@a) {
            if (/^StB\000/ && length($_) == length($_main{'_main'})) {
                $_ = sprintf("%s",$_);
            }
            else {
                s/'/\\'/g;
                s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
                s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
                s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;

lib/Biblio/bp/lib/bp-p-debug.pl  view on Meta::CPAN

  # False
  return if $debl == 0;
  # True
  return if (  ($debl == 1)  &&  ($opt_default_debug_level > $level)  );
  # some number
  return if $debl > $level;

  local($p,$f,$l,$s,$h,$w);
  if ($] >= 5.000) {
    ($p,$f,$l,$s,$h,$w) = caller(1);
    $s = '' unless defined $s;  # to initialize
    $s =~ s/^bib:://;
  } else {
    # sigh -- caller is broken in perl 4 apparently, so make the best of it
    if (defined $mod) {
      $s = 'mod ' . $glb_current_fmt;
    } else {
      ($p,$f,$l) = caller;
      if ($p ne 'bib') {
        $s = 'pkg ' . $p;