cgit.sxemacs.org Git - emchat/blob - emchat-curl.el

   1 ;; emchat-curl.el --- Download files from log buffer   -*- Emacs-Lisp -*-
   2
   3 ;; Copyright (C) 2007 - 2011 Steve Youngs
   4
   5 ;; Author:     Steve Youngs <steve@emchat.org>
   6 ;; Maintainer: Steve Youngs <steve@emchat.org>
   7 ;; Created:    <2007-08-31>
   8 ;; Homepage:   http://www.emchat.org/
   9 ;; Keywords:   curl download ICQ emchat file
  10
  11 ;; This file is part of EMchat.
  12
  13 ;; Redistribution and use in source and binary forms, with or without
  14 ;; modification, are permitted provided that the following conditions
  15 ;; are met:
  16 ;;
  17 ;; 1. Redistributions of source code must retain the above copyright
  18 ;;    notice, this list of conditions and the following disclaimer.
  19 ;;
  20 ;; 2. Redistributions in binary form must reproduce the above copyright
  21 ;;    notice, this list of conditions and the following disclaimer in the
  22 ;;    documentation and/or other materials provided with the distribution.
  23 ;;
  24 ;; 3. Neither the name of the author nor the names of any contributors
  25 ;;    may be used to endorse or promote products derived from this
  26 ;;    software without specific prior written permission.
  27 ;;
  28 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  29 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  30 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  31 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  32 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  33 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  34 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  35 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  36 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  37 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  38 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  39
  40 ;;; Commentary:
  41 ;;
  42 ;;    Download stuff from URls in your log buffer via ffi-curl.el.
  43 ;;    That means you need SXEmacs to use this.
  44
  45 ;;; Todo:
  46 ;;
  47 ;;
  48
  49 ;;; Code:
  50 (eval-when-compile
  51   (require 'emchat-utils)
  52   (autoload #'curl:download& "ffi-curl")
  53   (autoload #'curl:easy-getinfo "ffi-curl")
  54   (defvar curl:errors-alist))
  55
  56 (define-error 'emchat-curl
  57   (if (featurep 'sxemacs)
  58       "Your SXEmacs lacks FFI support"
  59     "FFI not available in your emacs, consider upgrading to SXEmacs"))
  60
  61 (defgroup emchat-curl nil
  62   "EMchat's FFI/Curl"
  63   :prefix "emchat-curl-"
  64   :group 'emchat)
  65
  66 (defcustom emchat-curl-download-directory
  67   (file-name-as-directory (paths-construct-path
  68                            '("download") emchat-directory))
  69   "*Default download directory."
  70   :type 'directory
  71   :group 'emchat-curl)
  72
  73 (defcustom emchat-curl-hook-function #'emchat-curl-post-hook
  74   "This function is called after a successful file download.
  75
  76 It must accept one argument, JOB, which contains the worker-job just
  77 finished."
  78   :type 'function
  79   :group 'emchat-curl)
  80
  81 ;;; Internal variables
  82
  83 (defvar emchat-curl-file nil)
  84 (defvar emchat-curl-dir nil)
  85
  86 (defun emchat-curl-post-hook (job)
  87   "Default function called after downloading files."
  88   (let* ((ctx (get job 'ctx))
  89          (resp (curl:easy-getinfo ctx :response-code))
  90          (url (curl:easy-getinfo ctx :effective-url))
  91          (speed (curl:easy-getinfo ctx :speed-download))
  92          (size (curl:easy-getinfo ctx :size-download))
  93          (file (expand-file-name emchat-curl-file emchat-curl-dir))
  94          (resp-str (cdr (assq resp curl:errors-alist))))
  95     (if resp-str
  96         (emchat-log-info "Job failed: %s\nReason: %s" job resp-str)
  97       (emchat-log-info
  98        "Job: %s
  99 Detail: #<job :url <%s>
 100               :local-file \"%s\"
 101               :size %d bytes%s
 102               :speed %s>
 103 "
 104        job url file size
 105        (cond
 106         ((>= size (* 1024 1024 1024))
 107          (format " (%0.2fGB)" (/ size (* 1024 1024 1024.0))))
 108         ((>= size (* 1024 1024))
 109          (format " (%0.2fMB)" (/ size (* 1024 1024.0))))
 110         ((>= size 1024)
 111          (format " (%0.2fKB)" (/ size 1024.0))))
 112        (cond
 113         ((>= speed (* 1024 1024 1024))
 114          (format "%0.2f GB/s" (/ speed (* 1024 1024 1024.0))))
 115         ((>= speed (* 1024 1024))
 116          (format "%0.2f MB/s" (/ speed (* 1024 1024.0))))
 117         ((>= speed 1024)
 118          (format "%0.2f KB/s" (/ speed 1024.0)))
 119         (t
 120          (format "%0.2f B/s" speed)))))))
 121
 122 (emchat-do-in-sxemacs
 123  (defregexp emchat-curl-filename-regexp (concat emchat-emphasis-url-regexp
 124                                              "/\\([^/].*$\\)")
 125    "Regexp matching the file part of a URL."))
 126 (emchat-do-in-xemacs
 127  (defconst emchat-curl-filename-regexp (concat emchat-emphasis-url-regexp
 128                                              "/\\([^/].*$\\)")
 129    "Regexp matching the file part of a URL."))
 130
 131 (defun emchat-curl-url (url file directory)
 132   "Download URL to FILE in DIRECTORY."
 133   (unless (fboundp #'ffi-defun)
 134     (error 'emchat-curl))
 135   (add-one-shot-hook 'curl:download&-post-hook emchat-curl-hook-function)
 136   (curl:download& url (expand-file-name file directory)))
 137
 138 (defun emchat-curl-url-at-point ()
 139   "Downloads url at point."
 140   (interactive)
 141   (when (extentp (extent-at (point)))
 142     (let* ((dir (if current-prefix-arg
 143                     (expand-file-name
 144                      (read-directory-name "Download directory: "))
 145                   emchat-curl-download-directory))
 146            (url (extent-string (extent-at (point))))
 147            (fregexp emchat-curl-filename-regexp)
 148            file)
 149       (unless (file-directory-p dir)
 150         (make-directory-path dir))
 151       (setq file
 152             (and (string-match fregexp url)
 153                  (not (string=
 154                        "/"
 155                        (substring
 156                         (substring url (match-beginning 2) (match-end 2)) -1)))
 157                  (substring url (match-beginning 2) (match-end 2))))
 158       (if file
 159           (progn
 160             (emchat-curl-url url file dir)
 161             (setq emchat-curl-file file
 162                   emchat-curl-dir dir))
 163         (message "I don't see a file in: %s" url)))))
 164
 165 (defun emchat-curl-url-at-mouse (event)
 166   "Downloads url at event."
 167   (interactive "e")
 168   (when (extentp (extent-at-event event))
 169     (let* ((dir (if current-prefix-arg
 170                     (expand-file-name
 171                      (read-directory-name "Download directory: "))
 172                   emchat-curl-download-directory))
 173            (url (extent-string (extent-at-event event)))
 174            (fregexp emchat-curl-filename-regexp)
 175            file)
 176       (unless (file-directory-p dir)
 177         (make-directory-path dir))
 178       (setq file
 179             (and (string-match fregexp url)
 180                  (not (string=
 181                        "/"
 182                        (substring
 183                         (substring url (match-beginning 2) (match-end 2)) -1)))
 184                  (substring url (match-beginning 2) (match-end 2))))
 185       (if file
 186           (progn
 187             (emchat-curl-url url file dir)
 188             (setq emchat-curl-file file
 189                   emchat-curl-dir dir))
 190         (message-or-box "I don't see a file in: %s" url)))))
 191
 192 (provide 'emchat-curl)
 193 ;;; emchat-curl.el ends here