Простой веб-скребок в общий Лисп (SBCL)


Я написал простой веб-скребок в общий Лисп, и высоко ценим любую обратную связь:

(defpackage :myfitnessdata
  (:use :common-lisp)
  (:export #:main))

(in-package :myfitnessdata)

(require :sb-posix)
(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))
(ql:quickload '("drakma" 
        "closure-html" 
        "cxml-stp" 
        "net-telent-date"))

(defun show-usage () 
  (format t "MyFitnessData - a CSV web scraper for the MyFitnessPal website.~%")
  ;; snip
  (format t "'c:\\Users\\bob\\weights.csv', overwriting it if it exists.~%"))

(defun login (username password)
  "Logs in to www.myfitnesspal.com.  Returns a cookie-jar containing authentication details."
  (let ((cookie-jar (make-instance 'drakma:cookie-jar)))
    (drakma:http-request "http://www.myfitnesspal.com/account/login"
             :method :post
             :parameters `(("username" . ,username) ("password" . ,password))
             :cookie-jar cookie-jar)
    cookie-jar))

(defun logged-in? (cookie-jar)       
  "Returns true if a cookie-jar contains login information for www.myfitnesspal.com, and nil otherwise."
  (let ((logged-in? nil))
    (loop for cookie in (drakma:cookie-jar-cookies cookie-jar) do
      (if (and (equal (drakma:cookie-name cookie) "known_user")
           (equal (drakma:cookie-domain cookie) "www.myfitnesspal.com")
           (drakma:cookie-value cookie))
          (setq logged-in? t)))
    logged-in?))

(defun get-page (page-num cookie-jar)
  "Downloads a potentially invalid HTML page containing data to scrape.  Returns a string containing the HTML."
  (let ((url (concatenate 'string "http://www.myfitnesspal.com/measurements/edit?type=1&page=" (write-to-string page-num))))
    (let ((body (drakma:http-request url :cookie-jar cookie-jar)))
      (if (search "No measurements found." body)
      nil
    body))))

(defun scrape-body (body)
  "Scrapes data from a potentially invalid HTML document, returning a list of lists of values."
  (let ((valid-xhtml (chtml:parse body (cxml:make-string-sink))))
    (let ((xhtml-tree (chtml:parse valid-xhtml (cxml-stp:make-builder))))
      (scrape-xhtml xhtml-tree))))

(defun scrape-xhtml (xhtml-tree)
  "Scrapes data from an XHTML tree, returning a list of lists of values."
  (let ((results nil))
    (stp:do-recursively (element xhtml-tree)
            (when (and (typep element 'stp:element)
                   (equal (stp:local-name element) "tr"))
              (if (scrape-row element)
                  (setq results (append results (list (scrape-row element)))))))
    results))

(defun scrape-row (row)
  "Scrapes data from a table row into a list of values."
  (if (equal 4 (stp:number-of-children row))
      (let ((measurement-type (nth-child-data 0 row))
        (measurement-date (nth-child-data 1 row))
        (measurement-value (nth-child-data 2 row)))
    (if (not (equal measurement-type "Measurement"))
        (list measurement-date measurement-value)))))

(defun nth-child-data (number row)
  (stp:data (stp:nth-child 0 (stp:nth-child number row))))

(defun recursive-scrape-page (page-num cookie-jar)
  "Recursively scrapes data from a page and all successive pages.  Returns a list of lists of values."
  (let ((body (get-page page-num cookie-jar)))
    (if body
    (append (scrape-body body)
        (recursive-scrape-page (+ 1 page-num) cookie-jar)))))

(defun show-login-failure ()
  (format t "Login failed.~%"))

(defun write-csv (data csv-pathname)
  "Takes a list of lists of values, converts them to CSV, and writes them to a file."
  (with-open-file (stream csv-pathname 
              :direction :output
              :if-exists :overwrite
              :if-does-not-exist :create)
          (format stream (make-csv data))))

(defun separate-values (value-list)
  "Takes a list of values, and returns a string containing a CSV row that represents the values."
  (format nil "~{~A~^,~}" value-list))

(defun make-csv (list)
  "Takes a list of lists of values, and returns a string containing a CSV file representing each top-level list as a row."
  (let ((csv "")
    (sorted-list (sort list #'first-column-as-date-ascending)))
    (mapcar (lambda (row) (setq csv (concatenate 'string csv (separate-values row) (format nil "~%")))) sorted-list)
    csv))

(defun first-column-as-date-ascending (first-row second-row)
  "Compares two rows by their first column, which is parsed as a time."
  (< (net.telent.date:parse-time (car first-row))
     (net.telent.date:parse-time (car second-row))))

(defun scrape (username password csv-pathname)
  "Attempts to log in, and if successful scrapes all data to the file specified by csv-pathname."
  (let ((cookie-jar (login username password)))
    (if (logged-in? cookie-jar)
    (write-csv (recursive-scrape-page 1 cookie-jar) csv-pathname)
      (show-login-failure))))

(defun main (args)
  "The entry point for the application when compiled with buildapp."
  (if (= (length args) 4)
      (let ((username (nth 1 args))
        (password (nth 2 args))
        (csv-pathname (nth 3 args)))
    (scrape username password csv-pathname))
    (show-usage)))

Есть несколько областей, я вы не уверены, & особенно будем благодарны за отзывы на:

  • использование давайте setq (я ошибся в прошлом)
  • структуры, именования и комментарии (как Lisper, вы хотели бы унаследовать этот codebase?)

Весь приложение является здесь, на github , если вы заинтересованы.



2439
6
задан 6 мая 2011 в 09:05 Источник Поделиться
Комментарии
1 ответ

Возможно, вы захотите взглянуть на определения впрыска систем вместо того, чтобы использовать quicklisp для загрузки зависимостей внутренне.

Стандартный способ сделать это, чтобы настроить АСД файла. Вот неплохая прогулка-через этот процесс. Это более многословно, чем КЖ:факт, но это позволяет людям, которые не имеют quicklisp используйте свой пакет в любом случае.

На второй мысли, винт эти ребята, так держать.


(defun logged-in? (cookie-jar)       
"Returns true if a cookie-jar contains login information for www.myfitnesspal.com, and nil otherwise."
(let ((logged-in? nil))
(loop for cookie in (drakma:cookie-jar-cookies cookie-jar) do
(if (and (equal (drakma:cookie-name cookie) "known_user")
(equal (drakma:cookie-domain cookie) "www.myfitnesspal.com")
(drakma:cookie-value cookie))
(setq logged-in? t)))
logged-in?))

Есть петли стенография для "убедитесь, что каждый член списка удовлетворяет предикату". Вышеперечисленные функции могут быть написаны как

(defun logged-in? (cookie-jar)       
"Returns true if a cookie-jar contains login information for www.myfitnesspal.com, and nil otherwise."
(loop for cookie in (drakma:cookie-jar-cookies cookie-jar)
always (and (equal (drakma:cookie-name cookie) "known_user")
(equal (drakma:cookie-domain cookie) "www.myfitnesspal.com"))))


фу? конвенция схемы для предикатов. Общие ХЛ конвенций фооп или ФОО-п. Лично я предпочитаю фу? слишком, просто знайте, что это не стандарт.


...
(sorted-list (sort list #'first-column-as-date-ascending)))
...

Это может получить вас в беде. Общий Лисп вроде действительно должен быть назван подобного!, потому что это деструктивный (так отсортированный список будет содержать отсортированный список, но список не будет по-прежнему будет неотсортированном списке, и мы не гарантируем полную последовательность больше). Если вы можете использовать список снова позже, вместо этого

...
(sorted-list (sort (copy-list list) #'first-column-as-date-ascending)))
...


(if (search "No measurements found." body)
nil
body)

Может быть записан как

(unless (search "No measurements found." body) body)


Редактировать:

формат может принимать вложенных итераций в директиве, так что вы можете исключить отдельные значения путем записи сделать-КШМ как

(defun make-csv (list)
"Takes a list of lists of values, and returns a string containing a CSV file representing each top-level list as a row."
(let ((sorted-list (sort list #'first-column-as-date-ascending)))
(format nil "~{~{~A~^,~}~^~%~}" sorted-list)))

Вы могли бы устранить сделать-КШМ полностью, поставив выше вроде+директива прямо на записи CSV-файла (это может также спасти вас в путешествие через в CSV-строку, которая может или не может существенно повлиять).


рекурсивный-скрести-страницы может быть упрощен до

(defun scrape-page (page-num cookie-jar)
(loop for i from page-num
if (get-page i cookie-jar) collect it into pg
else return pg))

Как правило, общий Лисп не гарантирует, хвост-звонки на схеме делает, так это вообще лучше использовать петли , чем сырые рекурсии. SBCL поддерживает некоторые хвостовые вызовы, но это не гарантировано (хотя эта ситуация выглядит достаточно просто того, что он может, сделать некоторые профилирования и сравнения).

Вы должны быть в состоянии упростить наскрести-с XHTML подобным образом, чтобы исключить (пусть ((результатов ноль)).

Обратите внимание, что я не проверял или профилированного этого, поскольку у меня нет "записью MyFitnessPal". Проверить, что он работает в первую очередь.


Редактирование второго:

 ...
(let ((valid-xhtml (chtml:parse body (cxml:make-string-sink))))
(let ((xhtml-tree (chtml:parse valid-xhtml (cxml-stp:make-builder))))
...

Вы используете этот вложенных давайте идиома в паре мест. Я предполагаю, что это просто потому, что ценность в XHTML-дерева зависит от значения действительной в формате HTML. В этом случае, вместо этого можно написать

 ...
(let* ((valid-xhtml (chtml:parse body (cxml:make-string-sink)))
(xhtml-tree (chtml:parse valid-xhtml (cxml-stp:make-builder))))
...

6
ответ дан 6 мая 2011 в 07:05 Источник Поделиться