doi.pm

一个论文管理系统

# $Id: DOI.pm,v 1.8 2005/09/12 11:44:45 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::CitationSource::DOI class recognises DOIs
# in the URI-like doi: construction or as http://dx.doi.org/...
# URLs and queries CrossRef for the metadata.
#
# NOTE: This module relies on membership of CrossRef.  You must
# have a CrossRef web services query account and permission to
# use it for this purpose. More details via:
# http://www.crossref.org/ 

package Bibliotech::CitationSource::DOI;

use strict;
use warnings;

use Bibliotech::CitationSource;
use base 'Bibliotech::CitationSource';

use Bibliotech::CitationSource::Simple;

use Data::Dumper;
use XML::LibXML;
use LWP::UserAgent;
use HTML::Entities;
use URI::Escape;
use constant CR_URL => 'http://doi.crossref.org/servlet/query';

sub api_version
{
  1;
}

sub name
{
  'DOI';
}

sub version
{
  '$Revision: 1.8 $';
}

sub understands
{
    my ($self, $uri) = @_;

    #reset query result cache
    $self->{'query_result'} = undef;

    return 0 unless $self->crossref_account;
    my $scheme = $uri->scheme;
    return 1 if $scheme eq 'doi';
    return 1 if $scheme eq 'http' and $uri->host eq 'dx.doi.org' && $uri->path =~ m!^/10\.\d{4}/.+!;
    return 0;
}

sub filter
{
  my ($self, $uri) = @_;
  my $doi = $self->get_doi($uri);
  if($doi)
  {
    #Do the CrossRef query now
    #This is so we can fail and return a nice error message if the DOI is not registered
    if(!$self->resolved($doi))
    {
	$self->errstr("DOI $doi cannot be resolved.  It may not be in the CrossRef database, or you may have mis-entered it.  Please check it and try again.\n");
	return '';
    }
    #in case doi contains a hash
    $doi =~ s!#!%23!g;
    return new URI('http://dx.doi.org/'.$doi)
  }
  else
  {
    return undef;
  }
}

sub citations
{
     my ($self, $uri) = @_;
     return undef unless($self->understands($uri));
     
     my $doi = $self->get_doi($uri);
     return undef unless $doi;

     my $query_result = $self->query_result($doi);
     return undef unless $query_result;

     #check it's worth returning
     unless($query_result->{'journal'} && $query_result->{'pubdate'})
     {
	$self->errstr('Insufficient metadata extracted for doi:' . $doi);
	return undef;
     }

     return new Bibliotech::CitationSource::ResultList(Bibliotech::CitationSource::Result::Simple->new($query_result));
}


sub resolved
{
    my ($self, $doi) = @_;
    my $query_result = $self->query_result($doi);

    return 1 if $query_result->{'status'} && $query_result->{'status'} eq 'resolved';
    return 0;
}
sub query_result
{
    my ($self, $doi) = @_;
    return $self->{'query_result'}->{$doi} if $self->{'query_result'}->{$doi};
    my $xml = $self->crossref_query_uri($doi); 
    my $query_result = $self->parse_crossref_xml($xml, $doi);
    return undef unless $query_result;
    $self->{'query_result'}->{$doi} = $query_result;
    return $query_result;
}

sub parse_crossref_xml
{
    my ($self, $xml, $doi) = @_;
    return undef unless $xml;
    $xml =~ s/<crossref_result.*?>/<crossref_result>/;

    my $parser = XML::LibXML->new();
    my $tree = $parser->parse_string($xml);
    unless ($tree) {
		$self->errstr('XML parse failed');
		return undef;
    }

    my $root = $tree->getDocumentElement;
    unless ($root) {
		$self->errstr("no root");
    }


    #sanity check
    unless($root->findvalue('query_result/body/query/doi') eq $doi) {
		$self->errstr("DOI mismatch\n");
		return undef;
    }
    return { status => 'unresolved' } if $root->findvalue('query_result/body/query/@status') eq 'unresolved';	

    #CrossRef XML has double-encoded entities, hence the decode_entities below

    return {
             status => 'resolved',
	     pubdate => $self->get_QueryValue($root, 'year'),
             journal => { name => decode_entities($self->get_QueryValue($root, 'journal_title')), 
                          issn => $self->get_QueryValue($root, 'issn[@type="print"]') 
			}, 
	     page => $self->get_QueryValue($root, 'first_page'), 
             volume => $self->get_QueryValue($root, 'volume'),
             issue => $self->get_QueryValue($root, 'issue'),
             pubdate => $self->get_QueryValue($root, 'year'),
             title => decode_entities($self->get_QueryValue($root, 'article_title')), 
             doi => $doi
        }; 
}

sub get_QueryValue {
  my ($self, $root, $key) = @_;
    
	
  my $value;
  $value = $root->findvalue('query_result/body/query/' . $key); 
  unless ($value) {
    $self->errstr("No value for key $key\n");
    return undef;
  }
  return $value;
}

sub get_doi {
    my ($self, $uri) = @_;
    my $doi;
    if($uri->scheme eq 'doi') {
	$doi = $uri;
	$doi =~ s!^doi:!!;
    }
    elsif ( $uri->scheme eq 'http' && $uri->host eq 'dx.doi.org' && $uri->path =~ m!^/10\.\d{4}/.+! ) {
        #DOI may contain a hash, so just manipulate raw string
        $doi = $uri->as_string;
        $doi =~ s!^http://dx\.doi\.org/!!i;
	#$doi = $uri->path;
	#$doi =~ s!^/!!;
    }
    #URI module escapes unsafe characters 
    return uri_unescape($doi);
}


sub crossref_query_uri {
    my ($self, $doi) = @_;

    my ($user, $passwd) = $self->crossref_account;
	my $ua = new LWP::UserAgent;
	my $req = new HTTP::Request(POST => CR_URL);
	my $db = 'db=mddb';

	my $content = "usr=" . $user . "&pwd=" . $passwd . "&$db&report=Brief&format=XSD_XML&qdata=";
	$content .= uri_escape($self->build_query($doi));

	$req->content_type('application/x-www-form-urlencoded');
	$req->content($content);

	#set timeout 
	$ua->{timeout} = 900;

	my $response = $ua->request($req);
	my($headers) = $response->headers;


	if($response->is_success) {
			my($results) = $response->content;

			#
			# trap error message from crossref
			#       where there are data errors
			#       dump to browser
			#
			if($headers->title) {
					$self->errstr($headers->title . "\n");
					$self->errstr ($results);
					return undef;
			}

			return($results);
	}

	$self->errstr("WARNING: " . $response->status_line . "\n");
	return undef;
}

sub build_query {

    my ($self, $doi) = @_;
    $doi = encode_entities($doi);
    my $q = q{<?xml version = "1.0" encoding="UTF-8"?>
<query_batch version="2.0" xmlns = "http://www.crossref.org/qschema/2.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
   <head>
      <email_address>};
    $q .= $self->bibliotech->siteemail;
    $q .= q{</email_address>
      <doi_batch_id>DOI-B1</doi_batch_id>                  
   </head>
   <body>
      <query key="MyKey1" enable-multiple-hits="false" expanded-results="true">         
  };
  $q .= "<doi>\n    $doi\n    </doi>\n";
  $q .= q{</query>      
   </body>
</query_batch>  };
  return $q;
}

sub crossref_account {
    my ($self) = shift;
    my $user = $self->cfg('CR_USER');
    my $password = $self->cfg('CR_PASSWORD');
    ($user && $password) ? return ($user, $password) : return undef;
}

#true!
1;