# $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 BibTeXpackage 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 semicolonssub 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::AuthorListsub 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::Journalsub journal {  my $self = shift;  return undef unless $self->exists('journal');  return new Bibliotech::CitationSource::Result::Journal::Simple ({name => $self->get('journal')});}# return article volume identifiersub 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 identifiersub 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 pagesub 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-paddedsub 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 undefsub last_modified_date {  undef;}1;__END__