evdl.el

   1 ;;; evdl.el -- Emacs Video Downloader
   2 ;;;            A web video downloader script for Emacs
   3
   4 ;; Copyright (C) 2009 Martin Bealby
   5 ;;
   6 ;; Author: Martin Bealby <mbealby@gmail.com>
   7 ;;
   8 ;; This program is free software; you can redistribute it and/or
   9 ;; modify it under the terms of the GNU General Public License as
  10 ;; published by the Free Software Foundation; either version 3 of
  11 ;; the License, or (at your option) any later version.
  12 ;;
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 ;; GNU General Public License for more details.
  17 ;;
  18 ;; You should have received a copy of the GNU General Public
  19 ;; License along with this program; if not, write to the Free
  20 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  21 ;; MA 02111-1307, USA.
  22
  23 ;;; Notes:
  24 ;;   This relies upon emacs-wget to do status feedback on downloads.  It is
  25 ;;   available from: http://pop-club.hp.infoseek.co.jp/emacs/emacs-wget/
  26
  27 ;;; Usage:
  28 ;;   1. M-x evdl and supply the video page url (if you want the url only,
  29 ;;   prefix the call)
  30 ;;   2. ???
  31 ;;   3. Profit!
  32
  33 ;;; Todo:
  34 ;;   1. Different sites can probably be simplified to a list.  Each entry
  35 ;;      being a list with the function to call and its arguments.
  36 ;;   2. More sites
  37
  38
  39 ;;----------------------------------------------------------------------------
  40 ;; requires
  41 ;;----------------------------------------------------------------------------
  42 (require 'wget)
  43
  44
  45 ;;----------------------------------------------------------------------------
  46 ;; group
  47 ;;----------------------------------------------------------------------------
  48 (defgroup evdl nil
  49   "Emacs Video Downloader."
  50   :prefix "evdl-"
  51   :group 'evdl)
  52
  53
  54 ;;----------------------------------------------------------------------------
  55 ;; variables
  56 ;;----------------------------------------------------------------------------
  57 ;; none
  58
  59
  60 ;;----------------------------------------------------------------------------
  61 ;; functions
  62 ;;----------------------------------------------------------------------------
  63 (defun evdl (url &optional arg)
  64   "Downloads a flash video from the given url.  If called with a
  65 prefix, display direct video link and append to the kill ring."
  66   (interactive "sURL: \nP")
  67   (if arg
  68           (setq f '(lambda (p)
  69                                 (progn (kill-new p)
  70                                            (message p))))
  71           (setq f 'wget))
  72   (cond
  73         ;; youtube (defaults to mp4)
  74         ((string-match "youtube.[A-Za-z]+/watch" url)
  75          (funcall f
  76                           (evdl-extract-link-youtube
  77                            (substring url
  78                                                   (progn (string-match "youtube.[A-Za-z]+/watch.v="
  79                                                                                            url)
  80                                                                  (match-end 0))
  81                                                   (progn (string-match
  82                                                                   "youtube.[A-Za-z]+/watch.v=[-A-Z_a-z0-9]+"
  83                                                                   url)
  84                                                                  (match-end 0))))))
  85         ;; vimeo
  86         ((string-match "vimeo.com/" url)
  87          (funcall f
  88                           (evdl-extract-link-vimeo (substring url
  89                                                                                                   (match-end 0) nil))))
  90         ;; google video
  91         ((string-match "video.google" url)
  92          (funcall f
  93                           (evdl-extract-link-generic
  94                            url
  95                            "http://[A-Za-z0-9-_\.]+/videodownload"
  96                            "\">this link</a> and choose \"Save As\"")))
  97         ;; guba
  98         ((string-match "guba.com" url)
  99          (funcall f
 100                           (concat
 101                            url
 102                            (evdl-extract-link-generic url
 103                                                                                   "http://free.guba.com/uploaditem"
 104                                                                                   "\.flv\""
 105                                                                                   "\.flv"))))
 106         ;; blip.tv
 107         ((string-match "blip.tv" url)
 108          (funcall f
 109                           (evdl-extract-link-generic url
 110                                                                                  "PrimaryMediaUrl(\""
 111                                                                                  "\.flv.referrer"
 112                                                                                  "\.flv")))
 113         (t (message "Sorry, this url is not supported."))))
 114
 115 ;;;;----------------------------------------------------------------------------
 116 ;;;; Support Functions
 117 ;;;;----------------------------------------------------------------------------
 118 (defun evdl-extract-link-generic (url start-regex end-regex
 119                                                                   &optional appended-string)
 120   "Extracts the download link from the supplied url using the
 121   regular expressions passed to it.  Optionally also appends an
 122   additional string."
 123   (with-temp-buffer
 124         (call-process wget-command nil t t
 125                                   "--quiet"
 126                                   "-O-"
 127                                   url)
 128         (goto-char (point-min))
 129         (concat (substring (substring (buffer-string)
 130                                                                   (string-match start-regex
 131                                                                                                 (buffer-string))
 132                                                                   (string-match end-regex
 133                                                                                                 (buffer-string)))
 134                                            (length start-regex))
 135                         appended-string)))
 136
 137 ;;;; Specific cases
 138 (defun evdl-extract-link-vimeo (clipid)
 139   "Download a video from vimeo from the clipid."
 140   (with-temp-buffer
 141         (call-process wget-command nil t t
 142                                   "--quiet"
 143                                   "-O-"
 144                                   (concat "http://www.vimeo.com/moogaloop/load/clip:"
 145                                                   clipid))
 146         (goto-char (point-min))
 147         ;; remove garbage at beginning
 148         (delete-region (point-min)
 149                                    (re-search-forward "<request_signature>"))
 150         ;; build up url by prepending host and path
 151         (move-beginning-of-line nil)
 152         (insert (concat "http://www.vimeo.com/moogaloop/play/clip:"
 153                                         clipid
 154                                         "/"))
 155         ;; tidy appended request_signature
 156         (move-end-of-line nil)
 157         (backward-delete-char (length "</request_signature>"))
 158         ;; append request_signature_expires
 159         (insert "/")
 160         (delete-region (point)
 161                                    (re-search-forward "<request_signature_expires"))
 162         (delete-region (point)
 163                                    (re-search-forward "1"))
 164         (insert "1")
 165         (move-end-of-line nil)
 166         (backward-delete-char (length "</request_signature_expires>"))
 167         ;; second line = value of request_signature_expires
 168         (delete-region (point)
 169                                    (goto-char (point-max)))
 170         (goto-char (point-max))
 171         (insert "/\?q=sd")
 172         (buffer-string)))
 173
 174
 175 (defun evdl-extract-link-youtube (videoid)
 176   "Download a video from youtube when given a video id and
 177   optionally an mp4 flag."
 178   (with-temp-buffer
 179         (call-process wget-command nil t t
 180                                   "--quiet"
 181                                   "-O-"
 182                                   (concat "http://www.youtube.com/watch?v="
 183                                                   videoid
 184                                                   "&fmt=18"))
 185         (call-process wget-command nil t t
 186                                   "--quiet"
 187                                   "-O-"
 188                                   (concat "http://www.youtube.com/watch?v="
 189                                                   videoid))
 190         (goto-char (point-min))
 191         ;; remove garbage at beginning
 192         (delete-region (point-min)
 193                                    (re-search-forward "\"t\": \""))
 194         ;; remove trailing garbage
 195         (delete-region (re-search-forward "\"")
 196                                    (point-max))
 197         (backward-delete-char 1)
 198         ;; build up url by prepending host and path
 199         (move-beginning-of-line nil)
 200         (insert (concat "http://www.youtube.com/get_video?video_id="
 201                                         videoid
 202                                         "&t="))
 203          ;; mp4 format
 204         (progn
 205           (move-end-of-line nil)
 206           (insert "&fmt=18"))
 207         (buffer-string)))
 208
 209
 210 ;;-----------------------------------------------------------------------------
 211 ;; provide package
 212 ;;-----------------------------------------------------------------------------
 213 (provide 'evdl)