afba18ad9ecf616723f75f432783711ff9b39bec
[org-ref.git] / doi-utils.el
1
2 ;;; doi-utils.el --- get bibtex entries and pdfs from a DOI
3
4 ;; Copyright(C) 2014 John Kitchin
5
6 ;; Author: John Kitchin <jkitchin@andrew.cmu.edu>
7 ;; This file is not currently part of GNU Emacs.
8
9 ;; This program is free software; you can redistribute it and/or
10 ;; modify it under the terms of the GNU General Public License as
11 ;; published by the Free Software Foundation; either version 2, or (at
12 ;; your option) any later version.
13
14 ;; This program is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 ;; General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program ; see the file COPYING.  If not, write to
21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
23
24 ;;; Commentary:
25 ;;
26 ;; Lisp code to generate and update bibtex entries from a DOI, and to
27 ;; download pdfs from publisher websites from a DOI.
28 ;;
29 ;; Package-Requires: ((org-ref))
30
31 (require 'json)
32
33 (defvar *doi-utils-waiting* t
34   "stores waiting state for url retrieval.")
35
36 (defvar *doi-utils-redirect* nil
37   "stores redirect url from a callback function")
38
39 (defun doi-utils-redirect-callback (&optional status)
40   "callback for url-retrieve to set the redirect"
41   (when (plist-get status :error)
42     (signal (car (plist-get status :error)) (cdr(plist-get status :error))))
43   (when (plist-get status :redirect) ;  is nil if there none
44     (message "redirects = %s" (plist-get status :redirect))
45     (message "*doi-utils-redirect* set to %s"
46              (setq *doi-utils-redirect* (plist-get status :redirect))))
47   ;; we have done our job, so we are not waiting any more.
48   (setq *doi-utils-waiting* nil))
49
50 (defun doi-utils-get-redirect (doi)
51   "get redirect url from dx.doi.org/doi"
52   ;; we are going to wait until the url-retrieve is done
53   (setq *doi-utils-waiting* t)
54   ;; start with no redirect. it will be set in the callback.
55   (setq *doi-utils-redirect* nil) 
56   (url-retrieve 
57    (format "http://dx.doi.org/%s" doi)
58    'doi-utils-redirect-callback)
59   ; I suspect we need to wait here for the asynchronous process to
60   ; finish. we loop and sleep until the callback says it is done via
61   ; `*doi-utils-waiting*'. this works as far as i can tell. Before I
62   ; had to run this a few times to get it to work, which i suspect
63   ; just gave the first one enough time to finish.
64   (while *doi-utils-waiting* (sleep-for 0.1)))
65
66 (defvar doi-utils-pdf-url-functions nil
67   "list of functions that return a url to a pdf from a redirect url. Each function takes one argument, the redirect url. The function must return a pdf-url, or nil.")
68
69 (defun aps-pdf-url (*doi-utils-redirect*)
70   (when (string-match "^http://journals.aps.org" *doi-utils-redirect*)
71     (replace-regexp-in-string "/abstract/" "/pdf/" *doi-utils-redirect*)))
72
73 (defun science-pdf-url (*doi-utils-redirect*)
74   (when (string-match "^http://www.sciencemag.org" *doi-utils-redirect*)
75     (concat *doi-utils-redirect* ".full.pdf")))
76
77 (defun nature-pdf-url (*doi-utils-redirect*)
78   (when (string-match "^http://www.nature.com" *doi-utils-redirect*)
79     (let ((result *doi-utils-redirect*))
80       (setq result (replace-regexp-in-string "/full/" "/pdf/" result))
81       (replace-regexp-in-string "\.html$" "\.pdf" result))))
82
83 (defun doi-utils-get-wiley-pdf-url (redirect-url)
84   "wileyscience direct hides the pdf url in html. we get it out here"
85   (setq *doi-utils-waiting* t)
86   (url-retrieve redirect-url
87                 (lambda (status)
88                   (beginning-of-buffer)
89                   (re-search-forward "<iframe id=\"pdfDocument\" src=\"\\([^\"]*\\)\"" nil)
90                   (setq *doi-utils-pdf-url* (match-string 1)
91                         *doi-utils-waiting* nil)))
92   (while *doi-utils-waiting* (sleep-for 0.1))
93   *doi-utils-pdf-url*)
94
95 (defun wiley-pdf-url (*doi-utils-redirect*)
96   (when (string-match "^http://onlinelibrary.wiley.com" *doi-utils-redirect*)
97    (doi-utils-get-wiley-pdf-url (replace-regexp-in-string "/abstract" "/pdf" *doi-utils-redirect*))
98    *doi-utils-pdf-url*))
99
100 (defun springer-pdf-url (*doi-utils-redirect*)
101   (when (string-match "^http://link.springer.com" *doi-utils-redirect*)
102     (replace-regexp-in-string "/article/" "/content/pdf/" (concat *doi-utils-redirect* ".pdf"))))
103
104 (defun acs-pdf-url (*doi-utils-redirect*)
105   (when (string-match "^http://pubs.acs.org" *doi-utils-redirect*)
106     (replace-regexp-in-string "/abs/" "/pdf/" *doi-utils-redirect*)))
107
108 (defun iop-pdf-url (*doi-utils-redirect*)
109   (when (string-match "^http://iopscience.iop.org" *doi-utils-redirect*)
110     (let ((tail (replace-regexp-in-string "^http://iopscience.iop.org" "" *doi-utils-redirect*)))
111       (concat "http://iopscience.iop.org" tail "/pdf" (replace-regexp-in-string "/" "_" tail) ".pdf"))))
112
113 (defun jstor-pdf-url (*doi-utils-redirect*)
114   (when (string-match "^http://www.jstor.org" *doi-utils-redirect*)
115     (concat (replace-regexp-in-string "/stable/" "/stable/pdfplus/" *doi-utils-redirect*) ".pdf")))
116
117 (defun aip-pdf-url (*doi-utils-redirect*)
118   (when (string-match "^http://scitation.aip.org" *doi-utils-redirect*)
119     ;; get stuff after content
120     (let (p1 p2 s p3)
121       (setq p2 (replace-regexp-in-string "^http://scitation.aip.org/" "" *doi-utils-redirect*))
122       (setq s (split-string p2 "/"))
123       (setq p1 (mapconcat 'identity (-remove-at-indices '(0 6) s) "/"))
124       (setq p3 (concat "/" (nth 0 s) (nth 1 s) "/" (nth 2 s) "/" (nth 3 s)))
125       (format "http://scitation.aip.org/deliver/fulltext/%s.pdf?itemId=/%s&mimeType=pdf&containerItemId=%s"
126               p1 p2 p3))))
127
128 (defun tandfonline-pdf-url (*doi-utils-redirect*)
129   (when (string-match "^http://www.tandfonline.com" *doi-utils-redirect*)
130     (replace-regexp-in-string "/abs/\\|/full/" "/pdf/" *doi-utils-redirect*)))
131
132 (defun ecs-pdf-url (*doi-utils-redirect*)
133   (when (string-match "^http://jes.ecsdl.org" *doi-utils-redirect*)
134     (replace-regexp-in-string "\.abstract$" ".full.pdf" *doi-utils-redirect*)))
135
136 (defun ecst-pdf-url (*doi-utils-redirect*)
137   (when (string-match "^http://ecst.ecsdl.org" *doi-utils-redirect*)
138     (concat *doi-utils-redirect* ".full.pdf")))
139
140 (defun rsc-pdf-url (*doi-utils-redirect*)
141   (when (string-match "^http://pubs.rsc.org" *doi-utils-redirect*)
142     (let ((url (downcase *doi-utils-redirect*)))
143       (setq url (replace-regexp-in-string "articlelanding" "articlepdf" url))
144       url)))
145
146 (defvar *doi-utils-pdf-url* nil
147   "stores url to pdf download from a callback function")
148
149 (defun doi-utils-get-science-direct-pdf-url (redirect-url)
150   "science direct hides the pdf url in html. we get it out here"
151   (setq *doi-utils-waiting* t)
152   (url-retrieve redirect-url
153                 (lambda (status)
154                   (beginning-of-buffer)
155                   (re-search-forward "pdfurl=\"\\([^\"]*\\)\"" nil t)
156                   (setq *doi-utils-pdf-url* (match-string 1)
157                         *doi-utils-waiting* nil)))
158   (while *doi-utils-waiting* (sleep-for 0.1))
159   *doi-utils-pdf-url*)
160
161
162 (defun science-direct-pdf-url (*doi-utils-redirect*)
163   (when (string-match "^http://www.sciencedirect.com" *doi-utils-redirect*)
164     (doi-utils-get-science-direct-pdf-url *doi-utils-redirect*)
165     *doi-utils-pdf-url*))
166
167 ;; sometimes I get
168 ;; http://linkinghub.elsevier.com/retrieve/pii/S0927025609004558
169 ;; which actually redirect to
170 ;; http://www.sciencedirect.com/science/article/pii/S0927025609004558
171 (defun linkinghub-elsevier-pdf-url (*doi-utils-redirect*)
172   (when (string-match "^http://linkinghub.elsevier.com/retrieve" *doi-utils-redirect*)
173     (let ((second-redirect (replace-regexp-in-string
174                             "http://linkinghub.elsevier.com/retrieve"
175                             "http://www.sciencedirect.com/science/article"
176                             *doi-utils-redirect*)))
177       (message "getting pdf url from %s" second-redirect)
178       ;(doi-utils-get-science-direct-pdf-url second-redirect)
179       *doi-utils-pdf-url*)))
180
181 (defun pnas-pdf-url (*doi-utils-redirect*)
182   (when (string-match "^http://www.pnas.org" *doi-utils-redirect*)
183     (concat *doi-utils-redirect* ".full.pdf?with-ds=yes")))
184
185 (setq doi-utils-pdf-url-functions
186       (list
187        'aps-pdf-url
188        'science-pdf-url
189        'nature-pdf-url
190        'wiley-pdf-url        
191        'springer-pdf-url
192        'acs-pdf-url
193        'iop-pdf-url
194        'jstor-pdf-url
195        'aip-pdf-url
196        'science-direct-pdf-url
197        'linkinghub-elsevier-pdf-url
198        'tandfonline-pdf-url
199        'ecs-pdf-url
200        'ecst-pdf-url
201        'rsc-pdf-url
202        'pnas-pdf-url))
203
204 (defun doi-utils-get-pdf-url (doi)
205   "returns a url to a pdf for the doi if one can be
206 calculated. Loops through the functions in `doi-utils-pdf-url-functions'
207 until one is found"
208   (doi-utils-get-redirect doi)
209   
210   (unless *doi-utils-redirect*
211     (error "No redirect found for %s" doi))
212   (message "applying functions")
213   (catch 'pdf-url
214     (dolist (func doi-utils-pdf-url-functions)
215      (message "calling %s" func)
216       (let ((this-pdf-url (funcall func *doi-utils-redirect*)))
217 (message "t: %s" this-pdf-url)
218         (when this-pdf-url
219           (message "found pdf url: %s" this-pdf-url)
220           (throw 'pdf-url this-pdf-url))))))
221
222 (defun doi-utils-get-bibtex-entry-pdf ()
223   "download pdf for entry at point if the pdf does not already
224 exist locally. The entry must have a doi. The pdf will be saved
225 to `org-ref-pdf-directory', by the name %s.pdf where %s is the
226 bibtex label. Files will not be overwritten. The pdf will be
227 checked to make sure it is a pdf, and not some html failure
228 page. you must have permission to access the pdf. We open the pdf
229 at the end."
230   (interactive)
231   (save-excursion
232     (bibtex-beginning-of-entry) 
233     (let (;; get doi, removing http://dx.doi.org/ if it is there.
234           (doi (replace-regexp-in-string
235                 "http://dx.doi.org/" ""
236                 (bibtex-autokey-get-field "doi")))             
237           (key)
238           (pdf-url)
239           (pdf-file)
240           (content))
241       ;; get the key and build pdf filename.
242       (re-search-forward bibtex-entry-maybe-empty-head)
243       (setq key (match-string bibtex-key-in-head))
244       (setq pdf-file (concat org-ref-pdf-directory key ".pdf"))
245
246       ;; now get file if needed.
247       (when (and doi (not (file-exists-p pdf-file)))
248         (setq pdf-url (doi-utils-get-pdf-url doi))
249         (if pdf-url
250             (progn
251               (url-copy-file pdf-url pdf-file)
252               ;; now check if we got a pdf
253               (with-temp-buffer
254                 (insert-file-contents pdf-file)
255                 ;; PDFS start with %PDF-1.x as the first few characters.
256                 (if (not (string= (buffer-substring 1 6) "%PDF-"))
257                     (progn
258                       (message "%s" (buffer-string))
259                       (delete-file pdf-file))
260                   (message "%s saved" pdf-file)))
261         
262               (when (file-exists-p pdf-file)
263                 (org-open-file pdf-file)))
264           (message "No pdf-url found for %s at %s" doi *doi-utils-redirect* ))
265           pdf-file))))
266
267 (defun doi-utils-get-json-metadata (doi)
268   (let ((url-request-method "GET") 
269        (url-mime-accept-string "application/citeproc+json")
270        (json-object-type 'plist))
271     (with-current-buffer
272         (url-retrieve-synchronously
273          (concat "http://dx.doi.org/" doi))
274       (json-read-from-string (buffer-substring url-http-end-of-headers (point-max))))))       
275
276 (defun doi-utils-expand-template (s)
277   "expand a template containing %{} with the eval of its contents"
278   (replace-regexp-in-string "%{\\([^}]+\\)}"
279                             (lambda (arg)
280                               (let ((sexp (substring arg 2 -1)))
281                                 (format "%s" (eval (read sexp))))) s))
282
283 (defun doi-utils-doi-to-bibtex-string (doi)
284   "return a bibtex entry as a string for the doi. Only articles are currently supported"
285   (let (type
286         results
287         author
288         title
289         journal
290         year
291         volume
292         number
293         pages
294         month
295         url
296         json-data)
297     (setq results (doi-utils-get-json-metadata doi)
298           json-data (format "%s" results)
299           type (plist-get results :type)
300           author (mapconcat (lambda (x) (concat (plist-get x :given) " " (plist-get x :family)))
301                             (plist-get results :author) " and ")
302           title (plist-get results :title)
303           journal (plist-get results :container-title)
304           volume (plist-get results :volume)
305           issue (plist-get results :issue)
306           year (elt (elt (plist-get (plist-get results :issued) :date-parts) 0) 0)
307           pages (plist-get results :page)
308           doi (plist-get results :DOI)
309           url (plist-get results :URL))
310     (cond
311      ((string= type "journal-article")
312       (doi-utils-expand-template "@article{,
313   author =       {%{author}},
314   title =        {%{title}},
315   journal =      {%{journal}},
316   year =         {%{year}},
317   volume =       {%{volume}},
318   number =       {%{issue}},
319   pages =        {%{pages}},
320   doi =          {%{doi}},
321   url =          {%{url}},
322 }"))
323     (t (message-box "%s not supported yet." type)))))
324
325 (defun doi-utils-insert-bibtex-entry-from-doi (doi)
326   "insert bibtex entry from a doi. Also cleans entry using
327 org-ref, and tries to download the corresponding pdf."
328   (interactive "sDOI: ")
329   (insert (doi-utils-doi-to-bibtex-string doi))
330   (backward-char)
331   (if (bibtex-key-in-head nil)
332        (org-ref-clean-bibtex-entry t)
333      (org-ref-clean-bibtex-entry))
334    ;; try to get pdf
335    (doi-utils-get-bibtex-entry-pdf)
336    (save-selected-window
337      (org-ref-open-bibtex-notes)))
338
339 (defun doi-utils-add-bibtex-entry-from-doi (doi)
340   "add entry to end of first entry in `org-ref-default-bibliography'."
341   (interactive "sDOI: ")
342   (find-file (car org-ref-default-bibliography))
343   (end-of-buffer)
344   (insert "\n\n")
345   (doi-utils-insert-bibtex-entry-from-doi doi))
346
347 (defun doi-utils-add-bibtex-entry-from-region (start end)
348   "add entry assuming region is a doi to end of first entry in `org-ref-default-bibliography'."
349   (interactive "r")
350   (let ((doi (buffer-substring start end)))
351     (find-file (car org-ref-default-bibliography))
352     (end-of-buffer)
353     (insert "\n")
354     (doi-utils-insert-bibtex-entry-from-doi doi)))
355
356 (defun bibtex-set-field (field value)
357   "set field to value in bibtex file. create field if it does not exist"
358   (interactive "sfield: \nsvalue: ")
359   (bibtex-beginning-of-entry)
360   (let ((found))
361     (if (setq found (bibtex-search-forward-field field t))
362         ;; we found a field
363         (progn
364           (goto-char (car (cdr found)))
365           (when value
366             (bibtex-kill-field)
367             (bibtex-make-field field)
368             (backward-char)
369             (insert value)))
370       ;; make a new field
371       (message "new field being made")
372       (bibtex-beginning-of-entry)
373       (forward-line) (beginning-of-line)
374       (bibtex-next-field nil)
375       (forward-char)
376       (bibtex-make-field field)
377       (backward-char)
378       (insert value))))
379
380 (defun plist-get-keys (plist)
381    "return keys in a plist"
382   (loop
383    for key in results by #'cddr collect key))
384
385 (defun doi-utils-update-bibtex-entry-from-doi (doi)
386   "update fields in a bibtex entry from the doi. Every field will be updated, so previous changes will be lost."
387   (interactive (list
388                 (or (replace-regexp-in-string "http://dx.doi.org/" "" (bibtex-autokey-get-field "doi"))
389                     (read-string "DOI: "))))
390   (let* ((results (doi-utils-get-json-metadata doi))
391          (type (plist-get results :type))
392          (author (mapconcat
393                   (lambda (x) (concat (plist-get x :given)
394                                     " " (plist-get x :family)))
395                   (plist-get results :author) " and "))
396          (title (plist-get results :title))
397          (journal (plist-get results :container-title))
398          (year (format "%s"
399                        (elt
400                         (elt
401                          (plist-get
402                           (plist-get results :issued) :date-parts) 0) 0)))      
403         (volume (plist-get results :volume))
404         (number (or (plist-get results :issue) ""))
405         (pages (or (plist-get results :page) ""))
406         (url (or (plist-get results :URL) ""))
407         (doi (plist-get results :DOI)))
408     
409     ;; map the json fields to bibtex fields. The code each field is mapped to is evaluated.
410     (setq mapping '((:author . (bibtex-set-field "author" author))
411                     (:title . (bibtex-set-field "title" title))
412                     (:container-title . (bibtex-set-field "journal" journal))
413                     (:issued . (bibtex-set-field "year" year))
414                     (:volume . (bibtex-set-field "volume" volume))
415                     (:issue . (bibtex-set-field "number" number))
416                     (:page . (bibtex-set-field "pages" pages))
417                     (:DOI . (bibtex-set-field "doi" doi))
418                     (:URL . (bibtex-set-field "url" url))))
419
420     ;; now we have code to run for each entry. we map over them and evaluate the code
421     (mapcar
422      (lambda (key)
423        (eval (cdr (assoc key mapping))))
424      (plist-get-keys results)))
425   
426   ; reclean entry, but keep key if it exists.
427   (if (bibtex-key-in-head)
428       (org-ref-clean-bibtex-entry t)
429     (org-ref-clean-bibtex-entry)))
430
431 (provide 'doi-utils)