view release on metacpan or  search on metacpan

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

  $outm;
}

sub output_date {
  local($mo, $yr, $how) = @_;
  local($date);

  $how = 'short' unless defined $how;

  if (defined $mo) {
    $mo = &bp_util'output_month($mo, $how);
    if (defined $yr) {
      $date = "$mo $yr";
    } else {
      $date = $mo;
    }
  } else {
    $date = $yr if defined $yr;
  }

  $date;
}

#
# Generates a key for a canonical record.
#
# XXXXX This should take an option string and parse it to generate a key.
#

sub genkey {
  local(%cent) = @_;
  local($key, $keytype, $sy);

  # first pick out the field we're going to use
  GETKEY: {
    defined $cent{'Authors'} && do
       { $keytype = 'author';  $key = $cent{'Authors'};      last GETKEY; };
    defined $cent{'CorpAuthor'} && do
       { $keytype = 'org';     $key = $cent{'CorpAuthor'};   last GETKEY; };
    defined $cent{'Editors'} && do
       { $keytype = 'author';  $key = $cent{'Editors'};      last GETKEY; };
    defined $cent{'Publisher'} && do
       { $keytype = 'org';     $key = $cent{'Publisher'};    last GETKEY; };
    defined $cent{'Organization'} && do
       { $keytype = 'org';     $key = $cent{'Organization'}; last GETKEY; };
    # nothing defined
         $keytype = 'text';    $key = "Anonymous";
  }

  # next we want to reduce the name to a reasonable key

#print STDERR "$key -> ";

  if ($keytype eq 'author') {
    #    # turn "Stephen van Rensselaer, Jr." into "vanRensselaerJr".
    #    #$key =~ s/^([^\/]*)\/([^\/]*)\/([^\/]*)\/([^\|]*).*/$2$1$4/;
    #    # turn "Stephen van Rensselaer, Jr." into "Rensselaer"
    #    #$key =~ s/^([^\/]*)\/.*/$1/;
    # Remove everything past the first seperator
    local($split_sep) = index($key, $bib'cs_sep2);
    substr($key, $split_sep) = ''  if $split_sep >= $[;
  } elsif ($keytype eq 'org') {
    $key =~ s/^(\S*).*/$1/;
  } else {
    # text
  }
#print STDERR "$key -> ";
  $key = &bib'nocharset($key);
#print STDERR "$key -> ";
  $key =~ tr/A-Za-z0-9\/\-//cd;

  # reduce it to fit normal lengths
  substr($key, 14) = '' if length($key) > 14;

  # Now find the year
  if ( (defined $cent{'Year'})  &&  ($cent{'Year'} =~ /(\d\d\d\d)/) ) {
    $sy = $1;
  } elsif ( (defined $cent{'Month'})  &&  ($cent{'Month'} =~ /(\d\d\d\d)/) ) {
    $sy = $1;
  } else {
    $sy = "????";
  }
  # We lop off the century part
  substr($sy, 0, 2) = '';

  # and add on the shortyear to the end of our key
  $key .= $sy;

  $key;
}

#
# Register a key in our global key registry, returning the possibly changed
# key.  All this does is maintain a registry of keys, and if there is already
# a key that matches, it adds letters from a -> z -> aa -> az -> ba -> bz -> ...
# to the end of the key.  A format uses these routines with something like:
#
#    $can{'CiteKey'} = &bp_util'genkey(%can) unless defined $can{'CiteKey'};
#    $can{'CiteKey'} = &bp_util'regkey($can{'CiteKey'});
#
# in it's fromcanon routines.  This generates a key if necessary, and then
# registers it.  A format may wish to do its own key generation, or even
# throw out the citekey it was given and make a new one, so generation and
# registration are seperate routines.
#
# It is recommended that keys be registered here rather than in the format, as
# we would like one registry even for multiple formats.
#
# XXXXX is this necessary?  This goes to an output routine after all.  As long
#       as they register them all, or none, do we care?
#

sub regkey {
  local($key) = @_;
  local($rkey, $nextkey, $rkeylen);

  $rkey = $key;
  $rkey =~ tr/A-Z/a-z/;
  $rkeylen = length($rkey);

  if (defined $glb_keyreg{$rkey}) {