X-Git-Url: http://git.kpe.io/?p=pubmed.git;a=blobdiff_plain;f=entrez.lisp;fp=entrez.lisp;h=89db4c7a4d8f16884890eca3b03afbc44ccc4986;hp=0000000000000000000000000000000000000000;hb=cbb63ee2a1ead34ef393ed47eed6d1a0d6e6bd94;hpb=8fbe5b9885498e0aa375061f83c0ea7e0c42c719;ds=sidebyside
diff --git a/entrez.lisp b/entrez.lisp
new file mode 100644
index 0000000..89db4c7
--- /dev/null
+++ b/entrez.lisp
@@ -0,0 +1,376 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: entrez.lisp
+;;;; Purpose: Library to access NCBI Entrez web application
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: April 2013
+;;;;
+;;;; This file, part of cl-entrez, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; cl-entrez users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the GNU Lesser General Public License
+;;;; (http://www.gnu.org/licenses/lgpl.html)
+;;;; *************************************************************************
+
+(in-package #:entrez)
+
+
+(defparameter +entrez-host+ "eutils.ncbi.nlm.nih.gov")
+(defparameter +entrez-search-url+ "/entrez/eutils/esearch.fcgi")
+(defparameter +entrez-fetch-url+ "/entrez/eutils/efetch.fcgi")
+(defparameter +entrez-summary-url+ "/entrez/eutils/esummary.fcgi")
+(defparameter *proxy-host* nil)
+
+
+(define-condition entrez-condition ()
+ ())
+
+
+(define-condition entrez-server-error (error entrez-condition)
+ ((response :initarg :response
+ :initform nil
+ :reader entrez-condition-response))
+ (:report (lambda (c stream)
+ (format stream "A Entrez server error occurred.")
+ (awhen (entrez-condition-response c)
+ (format stream " The server response was:~&~S" it)))))
+
+(define-condition entrez-query-error (error entrez-condition)
+ ((response :initarg :response
+ :initform nil
+ :reader entrez-condition-response))
+ (:report (lambda (c stream)
+ (format stream "A Entrez server error occurred.")
+ (awhen (entrez-condition-response c)
+ (format stream " The server response was:~&~S" it)))))
+
+;;; Article-Set and Article Classes
+
+(defclass pm-article-set ()
+ ((query :type string :initarg :query :accessor articles-query)
+ (webenv :type string :initarg :webenv :accessor articles-webenv)
+ (qkey :type string :initarg :qkey :accessor articles-qkey)
+ (articles :type list :initarg :articles :accessor articles)
+ (total :type fixnum :initarg :total :accessor articles-total)
+ (count :type fixnum :initarg :count :accessor articles-count)
+ (start :type fixnum :initarg :start :accessor articles-start))
+ (:documentation "Entrez Article Set Class")
+ (:default-initargs :total 0 :start 0 :count 0 :query nil
+ :articles nil :qkey nil :webenv nil))
+
+(defclass equery ()
+ ((query :type string :initarg :query :accessor query)
+ (wenv :type string :initarg :webenv :accessor wenv)
+ (qkey :type string :initarg :qkey :accessor qkey)
+ (qcount :type fixnum :initarg :qcount :accessor qcount))
+ (:documentation "Entrez EQuery Results Class")
+ (:default-initargs :qcount 0 :query nil :qkey nil :webenv nil))
+
+(defclass pm-article ()
+ (
+ (pmid :type integer :accessor article-pmid)
+ (title :type string :accessor article-title)
+ (authors :type list :accessor article-authors)
+ (affiliation :type string :accessor article-affiliation)
+ (journal :type string :accessor article-journal)
+ (date :type string :accessor article-date)
+ (volume :type string :accessor article-volume)
+ (issue :type string :accessor article-issue)
+ (pages :type string :accessor article-pages)
+ (abstract :type string :accessor article-abstract)
+ (mesh-headings :type list :accessor article-mesh-headings))
+ (:documentation "Entrez Article Class"))
+
+(defmethod print-object ((obj pm-article-set) (s stream))
+ (print-unreadable-object (obj s :type t :identity t)
+ (format s "~d total articles, ~d articles starting at #~d"
+ (articles-total obj)
+ (articles-count obj)
+ (articles-start obj)
+ )))
+
+(defmethod print-object ((obj equery) (s stream))
+ (print-unreadable-object (obj s :type t :identity t)
+ (format s "Found ~d with qkey ~a & wenv ~a"
+ (qcount obj)
+ (qkey obj)
+ (wenv obj))))
+
+(defmethod print-object ((obj pm-article) (s stream))
+ (print-unreadable-object (obj s :type t :identity t)
+ (format s "pmid:~d, title:~S" (article-pmid obj)
+ (article-title obj))))
+
+(defun article-equal-p (a b)
+ (check-type a pm-article)
+ (check-type b pm-article)
+ (eql (article-pmid a) (article-pmid b)))
+
+(defun article-ref (art)
+ "Return a string of publication data for an article"
+ (let ((ref ""))
+ (awhen (article-date art)
+ (string-append ref (format nil "~a; " it)))
+ (awhen (article-volume art)
+ (string-append ref it))
+ (awhen (article-issue art)
+ (string-append ref (format nil "(~a)" it)))
+ (awhen (article-pages art)
+ (string-append ref (format nil ":~a" it)))
+ ref))
+
+(defmethod print-article-set ((artset pm-article-set)
+ &key (os *standard-output*) (format :text)
+ (complete nil) (print-link nil))
+ "Display an article set to specified stream in specified format"
+ (dotimes (i (articles-count artset) artset)
+ (if (nth i (articles artset))
+ (print-article (nth i (articles artset)) :os os :format format
+ :complete complete :print-link print-link)
+ (princ "NULL Article" os))))
+
+(defmethod print-article ((art pm-article) &key (os *standard-output*)
+ (format :text) (complete nil) (print-link nil))
+ "Display an article"
+ (ecase format
+ (:text
+ (format os "~a~%~a~%~a~a ~a~%~a~%"
+ (article-title art)
+ (list-to-delimited-string (article-authors art) ", ")
+ (aif (article-affiliation art)
+ (format nil "~a~%" it) "")
+ (article-journal art) (article-ref art)
+ (aif (article-abstract art)
+ (if complete
+ it
+ "Abstract available")
+ "No abstract available")
+ (when complete
+ (format os "~a~%" (article-mesh-headings art)))))
+ (:html
+ (let ((has-link (or (article-abstract art) (article-mesh-headings art))))
+ (when (and print-link has-link)
+ (format os "" (funcall print-link
+ (article-pmid art))))
+ (format os "