view release on metacpan or  search on metacpan

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

# string.  This allows multiple character approximations.
#
# XXXXX Think about C3's idea of multiple approximations.
#
# A map of 0000 means that it maps to the null string -- our "approximation"
# is to get rid of it.  This is what we can do if it isn't terribly harmful
# to remove it.

sub meta_approx {
  local($orig) = @_;

  require "${glb_bpprefix}p-cstab.pl" unless defined %bib'mapprox_tab;

  if (defined $mapprox_tab{$orig}) {
    return '' if $mapprox_tab{$orig} eq '0000';
    return "${bib'cs_meta}$mapprox_tab{$orig}";
  }
  undef;
}

sub unicode_approx {
  local($orig) = @_;

  # XXXXX Should we warn them that they're getting an approx?

  require "${glb_bpprefix}p-cstab.pl" unless defined %bib'uapprox_tab;

  $uapprox_tab{$orig};
}

######
#
# Font change checker.  Verifies and tries to correct font changes.
#
# After fonts are converted in your tocanon routine, call this.  In your
# fromcanon routine, you can assume this has been called.
#
# XXXXX Should we call this in bp.pl's conversion routines?  That would
#       guarantee that it has been run.  Right now, we let each module
#       decide when and if it needs to be run.
#
# It takes a string that has font changes in it and makes sure they always
# match up and that there isn't an odd number (more starts than ends, more
# ends than starts).
#

sub font_check {
  local($_) = @_;

  # XXXXX Ought to read meta information from 00 or as input.
  return $_ unless /${bib'cs_meta}01[01]/;

  local(@fontstack) = ();
  local($fontsmatch, $font, $pfont);

  # Check for this special occurance:  They don't have end fonts (or don't
  # use them).  They just make everything a begin font (troff often does this).
  # Solution: Try to fix it up by replacing each begin after the first with
  #           an endprevious / begin pair.  Then remove the last begin.
  if (!/${bib'cs_meta}011/) {
    local($pos) = $[;
    local($lpos) = 0;
    local($distance) = length($bib'cs_meta) + 3;
    local($n) = 0;
    while (($pos = index($_, "${bib'cs_meta}010", $pos)) >= $[) {
      $n++;
      if ($n == 1) {
        $lpos = $pos;
        $pfont = substr($_, $pos + $distance, 1);
        $pos++;
        next;
      }
      $lpos = $pos;
      $font = substr($_, $pos + $distance, 1);
      substr($_, $pos, 0) = "${bib'cs_meta}0110";
      $pos += ($distance*2); # need to skip over the one we just put in.
    }
    if ($n > 1) {
      # now remove the last begin
      substr($_, $lpos + $distance + 1, $distance + 1) = '';
    } elsif ($n == 1) {
      # only one begin?  Add a previous to the end.
      $_ .= "${bib'cs_meta}0110";
    } else {
      &panic("Bug in font_check, file bp-p-cs.");
    }
#print STDERR "F: end of troff: $_\n";
    # XXXXX XXF return $_;
  }
      
  do {
    # We assume that everything is ok until something goes wrong.
    $fontsmatch = 1;
    while (/${bib'cs_meta}01(.)(.)/g) {
      $font = $2;
      if ($1 eq '0') {                   # font begin
#print STDERR "F: check begin font $font\n";
        if ($font eq '0') {
          &bib'gotwarn("Someone used default font begin.  Naughty.");
          s/${bib'cs_meta}0100/${bib'cs_meta}0110/go;
          $fontsmatch = 0;
          last;
        }
        push(@fontstack, $font);
      } else {                           # font end
#print STDERR "F: check end   font $font\n";
        if (@fontstack) {
          $pfont = pop(@fontstack);
          next if $font eq '0';  # previous font.  We don't care what it was.
          if ($pfont ne $font) {
            # _____ ended font that wasn't equal to the last begin
            &bib'gotwarn("Nesting problem.  Ended $font after $pfont");
            # just make it end the previous one.
            if ($] >= 5.000) {
              s/(${bib'cs_meta}010$pfont)(.*?)${bib'cs_meta}011$font/$1$2{bib'cs_meta}011$pfont/;
            } else {
              s/(${bib'cs_meta}010$pfont)(.*)${bib'cs_meta}011$font/$1$2{bib'cs_meta}011$pfont/;
            }
            $fontsmatch = 0;
            last;
          }
        } else {
          # _____ end font used without a begin
          &bib'gotwarn("Ended font $font before begin seen");
          # This is really lousy, but without pulling the whole string apart,