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)