bibtex.pm

一个论文管理系统

# $Id: BibTeX.pm,v 1.4 2005/08/25 21:55:54 martin Exp $
#
# Copyright 2005 Nature Publishing Group
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# The Bibliotech::Import::BibTeX class imports BibTeX

package Bibliotech::Import::BibTeX;
use strict;
use base 'Bibliotech::Import';
use Text::BibTeX;
use File::Temp ();

our %TYPES = ('article'       => undef,
	      'book'          => 'BOOK',
	      'inbook'        => 'CHAP',
	      'phdthesis'     => 'THES',
	      'techreport'    => 'RPRT',
	      'inproceedings' => 'CONF',
	      'proceedings'   => 'CONF',
	      'conference'    => 'CONF',
	      'unpublished'   => 'UNPB',
	      'mastersthesis' => 'THES',
	      'misc'          => undef,
	      'booklet'       => 'PAMP',
	      'manual'        => 'BOOK',
	      'incollection'  => undef
	      );

sub name {
  'BibTeX';
}

sub version {
  1.0;
}

sub api_version {
  1;
}

sub mime_types {
  ('application/x-bibtex');
}

sub extensions {
  ('bib');
}

sub understands {
  $_[1] =~ /^\@\w+\{\S+,$/m ? 1 : 0;
}

sub parse {
  my $self = shift;
  my $doc = $self->doc;
  $doc =~ s/^\%.*$//mg;  # hack, remove any comment lines to prevent Text::BibTeX 0.36 from segfaulting
  my $tfh = new File::Temp or die 'cannot create temp file';
  print $tfh $doc;
  close $tfh;
  my $filename = $tfh->filename or die 'no filename provided';
  my $bibfile = new Text::BibTeX::File ($filename);
  my $entries = new Bibliotech::Import::EntryList;
  while (my $entry = new Text::BibTeX::Entry $bibfile) {
    $entries->push(new Bibliotech::Import::BibTeX::Entry ($entry));
  }
  $self->data($entries);
  return 1;
}

package Bibliotech::Import::BibTeX::Entry;
use strict;
use base 'Bibliotech::Import::Entry::FromData';

sub parse {
  my $self = shift;
  $self->data(new Bibliotech::Import::BibTeX::Entry::Text::BibTeX ($self->data));
  my $type = lc($self->data->type);
  die "BibTeX type \"$type\" not understood.\n" unless exists $TYPES{$type};
  $self->parse_ok(1);
  return 1;
}

sub raw_keywords {
  my $data = shift->data;
  my $kw = $data->get('Keywords') || $data->get('keywords');
  return ref($kw) eq 'ARRAY' ? @{$kw} : ($kw);
}

package Bibliotech::Import::BibTeX::Entry::Text::BibTeX;
use strict;
use base ('Bibliotech::CitationSource::Result', 'Text::BibTeX::Entry');
use Bibliotech::CitationSource::Simple;

sub new {
  my ($class, $text_bibtex_obj) = @_;
  return bless $text_bibtex_obj, ref($class) || $class;
}

sub type {
  return Text::BibTeX::Entry::type(@_);  # Bibliotech::CitationSource::Result one is undef
}

# override get() to remove those silly braces
# also split on semicolons
sub get {
  my ($self, $key) = @_;
  my $value = $self->SUPER::get($key) or return undef;
  $value =~ s/[\{\}]//g;
  my @values = split(/;\s+/s, $value);
  return $value if @values <= 1;
  return wantarray ? @values : \@values;
}

sub uri {
  my $self = shift;

  # check for the easiest ways
  return $self->get('uri') if $self->exists('uri');
  return $self->get('url') if $self->exists('url');

  # handle lines like this:
  #  note = "Available at \url{http://www.cs.brown.edu/people/tld/postscript/GreenwaldandDeanNETWORKS-96.ps}",
  if ($self->exists('note')) {
    my $note = $self->get('note');
    if ($note =~ m|(https?://\S+)|) {
      my $url = $1;
      $url =~ s/\}$//;
      return $url;
    }
  }

  return undef;
}

sub identifier_field_or_key {
  my ($self, @keys) = @_;
  foreach (@keys) {
    return $self->get($_) if $self->exists($_);
  }
  my $alternation = join('|', @keys);
  if (my $key = $self->key) {
    return $1 if $key =~ /^(?:$alternation)_*(.+)$/i;
  }
  foreach ('note', 'notes', 'bibnote') {
    if ($self->exists($_)) {
      my $note = $self->get($_);
      return $1 if $note =~ /\b(?:$alternation)\s*([:=]\s*)?(\S+)/i;
    }
  }
  return undef;
}

sub pubmed {
  shift->identifier_field_or_key('pmid', 'pubmed');
}

sub doi {
  shift->identifier_field_or_key('doi');
}

sub asin {
  my $self = shift;
  $self->identifier_field_or_key('asin') || $self->identifier_field_or_key('isbn');
}

sub identifiers {
  my $self = shift;
  my %id;
  foreach my $func ('pubmed', 'doi', 'asin') {
    my $value = $self->$func or next;
    $id{$func} = $value;
  }
  return %id ? \%id : undef;
}

sub title {
  my $self = shift;
  return $self->get('title') if $self->exists('title');
  return $self->get('booktitle') if $self->exists('booktitle');
  return undef;
}

sub description {
  my $self = shift;
  return $self->get('annote') if $self->exists('annote');
  return undef;
}

sub ris_type {
  return $TYPES{lc(shift->type)};
}

# return an object of author objects: Bibliotech::CitationSource::Result::AuthorList
sub authors {
  my $self = shift;
  my $author = eval { return $self->get('author') if $self->exists('author');
		      return $self->get('authors') if $self->exists('authors'); };
  my @authors = split(/(,|\s*and)\s*/, $author);
  return new Bibliotech::CitationSource::Result::AuthorList (map(new Bibliotech::CitationSource::Result::Author::Simple ($_), @authors));
}

# return a journal object: Bibliotech::CitationSource::Result::Journal
sub journal {
  my $self = shift;
  return undef unless $self->exists('journal');
  return new Bibliotech::CitationSource::Result::Journal::Simple ({name => $self->get('journal')});
}

# return article volume identifier
sub volume {
  my $self = shift;
  return $self->get('volume') if $self->exists('volume');
  return $self->get('volumes') if $self->exists('volumes');
  return undef;
}

# return article issue identifier
sub issue {
  my $self = shift;
  return $self->get('issue') if $self->exists('issue');
  return $self->get('issues') if $self->exists('issues');
  return undef;
}

# return article issue page
sub page {
  my $self = shift;
  return $self->get('page') if $self->exists('page');
  return $self->get('pages') if $self->exists('pages');
  return undef;
}

# return date first published as YYYY-MM-DD
# where MM is digits or 3-letter English month abbreviation
# and MM and DD as digits do not need to be zero-padded
sub date {
  my $self = shift;
  if ($self->exists('year')) {
    my $year = $self->get('year');
    my $month = $self->get('month');
    my $day = $self->get('day');
    return sprintf('%04d-%02d-%02d', int($year), int($month), int($day));
  }
}

# return date record was created or last modified, same format as date()
# required - do not return undef
sub last_modified_date {
  undef;
}


1;
__END__