(in-package :kira)

(defvar *render-player-p* nil
  "Render the embedded Flash player when rendering the video.")

(defclass video (post)
  ((video-id :initform nil)
   (video-type :initform nil)
   (duration :initarg :length-of-time :initarg :duration :initform nil)))

(defcollection videos ((entity videos-mixin))
  (cached-collection entity 'videos :descending t))

(defmethod duration ((video video) &optional truncate)
  (whereas ((duration (slot-value video 'duration)))
    (when (stringp duration)
      (setf duration (string->type duration 'integer)))
    (when (and (integerp duration) (plusp duration))
      (if truncate
	  (truncate duration 60)
	  duration))))

(defmethod (setf duration) (duration (video video))
  (setf (slot-value video 'duration) duration))

(defun cache-video-id (video)
  (whereas ((uri (external-uri video))
	    (host (uri-host uri))
	    (path (rest (uri-parsed-path uri))))
    (with-slots (video-id video-type) video
      (setf
       video-type
       (cond ((or (string-equal host "youtube.com")
		  (string-equal host "www.youtube.com"))
	      (flet ((match-id (type)
		       (or (uri-query-value uri type)
			   (and (equal (first path) type)
				(second path)))))
		(cond ((setf video-id (match-id "p")) :youtube-playlist)
		      ((setf video-id (match-id "v")) :youtube-video))))
	     ((string-equal host "video.google.com")
	      (when (setf video-id (uri-query-value uri "docid"))
		:google-video)))))))

(defun video-id (video)
  (or (slot-value video 'video-id)
      (progn
	(cache-video-id video)
	(slot-value video 'video-id))))

(defun video-type (video)
  (or (slot-value video 'video-type)
      (progn
	(cache-video-id video)
	(slot-value video 'video-type))))

(define-canonical-uri ((video video) :watch)
  (:title
   (:whereas ((uri (external-uri video))
	      (host (uri-host uri)))
     "Watch at " host))
  (let ((id (video-id video)))
    (case (and id (video-type video))
      (:youtube-video (format nil "http://youtube.com/watch?v=~a" id))
      (:youtube-playlist (format nil "http://youtube.com/view_playlist?p=~a" id))
      (:google-video (format nil "http://video.google.com/videoplay?docid=~a" id))
      (t (external-uri video)))))

(define-canonical-uri ((video video) :embed)
  (whereas ((id (video-id video)))
    (case (video-type video)
      (:youtube-video (format nil "http://youtube.com/v/~a" id))
      (:youtube-playlist (format nil "http://youtube.com/p/~a" id))
      (:google-video (format nil "http://video.google.com/googleplayer.swf?docId=~a" id)))))

(defmethod lines ((video video))
  (collecting
    (multiple-value-bind (min sec) (duration video t)
      (when min
	(collect
	 (cons
	  "Duration"
	  (format nil "~d:~2,'0d" min sec)))))
    (collect
     (cons
      "Link"
      (html-output (render-link video :watch))))))

(defmethod render-editor :before ((video video))
  (html
   (:field "URL" (render-link (external-uri video)))
   (:fieldset "Image" (file-field 'image video))))

(defhandler ((entity videos-mixin) :videos)
  (:title "Videos")
  ((:standard-form :action (:uri-to entity 'create-from-uri :type 'video))
   (:field "YouTube or Google Video URL"
	   (text-field "external-uri" nil :size 20)
	   " " (submit-button nil "Submit")))
  (:collection (videos entity)))

(defmethod render-in-style ((video video) (style (eql 'player)))
  (multiple-value-bind (width height)
      (case (video-type video)
	(:youtube-playlist (values 530 370))
	(otherwise (values 425 350)))
    (html
     (:p
      ((:object :width width :height height)
       ((:param :name "movie" :value (:uri-to video :embed)))
       ((:param :name "wmode" :value "transparent"))
       ((:embed :wmode "transparent"
		:type "application/x-shockwave-flash"
		:width width
		:height height
		:src (:uri-to video :embed))))))))

(defmethod render-in-style :around ((video video) (style (eql 'view)))
  (let ((*render-player-p* t))
    (call-next-method)))

(defmethod render-in-style ((video video) (style (eql 'html)))
  (if *render-player-p*
      (progn
	(render-in-style video 'lines)
	(render-markup (body video))
	(render-in-style video 'player))
      (call-next-method)))

(define-update-methods instance ((entity videos-mixin) (video video))
  (update-collection (videos entity) video))

(defmethod fetch-node-from-uri ((video video))
  (whereas ((id (video-id video)))
    (case (video-type video)
      (:youtube-video
       (setf-accessors-from-xml
	video
	(find-element-in-tree
	 :|video_details|
	 (http-get-xml
	  (format
	   nil
	   "http://youtube.com/api2_rest?dev_id=~a&method=youtube.videos.get_details&video_id=~a"
	   +youtube-developer-id+
	   id)))
	image (:|thumbnail_url| remote-file)
	duration (:|length_seconds| integer)
	title :|title|
	body :|description|))
      (:google-video
       (setf-accessors-from-xml
	video
	(find-element-in-tree :|media:group| (http-get-xml (format nil "http://video.google.com/videofeed?docid=~a" id)))
	image ((:|media:thumbnail| :|url|) remote-file)
	duration ((:|media:content| :|duration|) integer)
	title :|media:title|
	body :|media:description|)))))