view release on metacpan or  search on metacpan

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

#
# bibliography package for Perl
#
# utility subroutines
#
# Dana Jacobsen (dana@acm.org)
# 11 January 1995
#

package bp_util;

######

$opt_complex = 1;

# The global key registry.
%glb_keyreg = ();

#
# mname_to_canon takes a name string and returns it back as a Canonical name.
#
# Example input:
#
#       John von Jones, Jr., Ed Krol, Ludwig von Beethoven
#
# output:
#
#       Jones,von,John,Jr./Krol,Ed,/Beethoven,von,Ludwig,
#
# (the actual seperators are $cs_sep for '/' and $cs_sep2 for ',')
#
# This is a total heuristic hack, and if you know where names are split,
# use multiple calls to name_to_canon instead.  Use this routine if you
# expect the input to be some sort of free-form such that you can't
# easily seperate the names yourself.
#
# This routine assumes there can be multiple authors per line, seperated by
# "and" or commas, and it's going to try to guess how to break them up,
# given that it can get "name1, name2, jr, name3" as a 3 name string with
# "name2, jr" as the second name.  This method precludes the ability to
# also correctly parse "last, first" format strings.  If that is the format
# your string is in, call the function with a "1" as the second argument.
#
# Note that no-break-space ("tie", ~ in TeX, \0 in troff) is \240.
#
sub mname_to_canon {
  local($allnames, $revauthor) = @_;
  local($firstn, $vonn, $lastn, $jrn);
  local(@names, $name, $oname, $nname, $rest);
  local(@cnames) = ();
 
  # Squeeze all spaces into one space.
  $allnames =~ s/\s+/ /g;
  # remove any beginning and trailing ands.
  $allnames =~ s/^and //;
  $allnames =~ s/ and$//;

  @names = split(/,? and /, $allnames);
  while (@names) {
    $oname = $name = shift @names;
    $firstn = $vonn = $lastn = $jrn = '';
    # name has no spaces at beginning or end

    # squeeze all spaces around commas.  They aren't telling us anything that
    # we can rely on, and it simplifies matching.  Also combine them.
    $name =~ s/,+/,/g;
    $name =~ s/ ,/,/g;
    $name =~ s/, /,/g;

    if ( $revauthor && ($name =~ /,/) ) {
      if ($name =~ s/[, ]+([sj]r\.?|I+)$//i) {
        $jrn = ",$1";
      }
      $name =~ s/^(.*),(.*)/$2 $1$jrn/g;
      # name has no spaces at beg or end
    }

    $name =~ s/[ \240]+([sj]r\.?|\(?edi?t?o?r?s?\.?\)?|I+)(,|$)/,$1/i;
    ($nname, $rest, $jrn) = split(/,([^\240])/, $name, 2);
    $jrn = (defined $jrn)  ? "$rest$jrn"  :  '';
    #$jrn =~ s/,+$//;
    # nname has no spaces at beg or end.
    # jrn   has no spaces at beg or end.
    if ($jrn =~ / /) {
      ($jrn, $rest) = $jrn =~ /([sj]r\.?|\(?edi?t?o?r?s?\.?\)?|I+)?,?(.*)$/i;
      unshift(@names, $rest) if defined $rest;
      $jrn = '' unless defined $jrn;
    }
    ($firstn) = $nname =~ /^((\S* )*)/;
    $nname = substr($nname, length($firstn));
    # nname has no spaces at beg or end.
    $lastn = $nname;
    $lastn  =~ s/\240+/ /g;
    $firstn =~ s/\240+/ /g;
    $jrn    =~ s/\240+/ /g;
    while ($firstn =~ / ([a-z]+ )$/) {
      $rest = $1;
      substr($vonn, 0, 0) = $rest;