Changeset 3912

Show
Ignore:
Timestamp:
09/17/08 13:47:43 (2 months ago)
Author:
hans
Message:

Add automatic Twitter status updates when uploading.
Remove upgrade stuff, we're live!

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/projects/quickhoney/src/handlers.lisp

    r3905 r3912  
    294294              (let* ((width (cl-gd:image-width)) 
    295295                     (height (cl-gd:image-height)) 
    296                      (ratio (/ 1 (max (/ width 300) (/ height 200))))) 
     296                     (ratio (/ 1 (max (/ width 300) (/ height 200)))) 
     297                     (image-name (pathname-name (upload-original-filename uploaded-file)))) 
    297298                (maybe-convert-to-palette) 
    298                 (let* ((image (make-store-image :name (pathname-name (upload-original-filename uploaded-file)) 
     299                (let* ((image (make-store-image :name image-name 
    299300                                                :class-name 'quickhoney-image 
    300301                                                :keywords (cons :upload (image-keywords-from-request-parameters)) 
    …… 
    305306                  (with-http-response () 
    306307                    (with-http-body () 
     308                      (twitter:update-status (bknr-session-user) 
     309                                             (format nil "Uploaded new image ~A: http://quickhoney.com~A/~A" 
     310                                                     image-name (handler-path handler) image-name)) 
    307311                      (html (:html 
    308312                             (:head 
    …… 
    356360                  (cl-gd:destroy-image uploaded-image) 
    357361                  (setf uploaded-image scaled-image))) 
    358               (let ((item (make-store-image :name (normalize-news-title title) 
    359                                             :image uploaded-image 
    360                                             :type (if (cl-gd:true-color-p uploaded-image) :jpg :png) 
    361                                             :class-name 'quickhoney-news-item 
    362                                             :keywords (list :upload) 
    363                                             :initargs (list :cat-sub (list :news) 
    364                                                             :title title 
    365                                                             :text text 
    366                                                             :owner (bknr-session-user))))) 
     362              (let* ((title (normalize-news-title title)) 
     363                     (item (make-store-image :name title 
     364                                             :image uploaded-image 
     365                                             :type (if (cl-gd:true-color-p uploaded-image) :jpg :png) 
     366                                             :class-name 'quickhoney-news-item 
     367                                             :keywords (list :upload) 
     368                                             :initargs (list :cat-sub (list :news) 
     369                                                             :title title 
     370                                                             :text text 
     371                                                             :owner (bknr-session-user))))) 
    367372                (declare (ignore item)) ; for now 
     373                (twitter:update-status (bknr-session-user) 
     374                                       (format nil "Posted news item: http://quickhoney.com/news/~A" title)) 
    368375                (with-http-response () 
    369376                  (with-http-body () 

  • trunk/projects/quickhoney/src/packages.lisp

    r3822 r3912  
    7878 
    7979(defpackage :twitter 
    80   (:use :cl) 
     80  (:use :cl :bknr.datastore) 
    8181  (:export #:update-status)) 

  • trunk/projects/quickhoney/src/quickhoney.asd

    r3823 r3912  
    3434               (:file "imageproc" :depends-on ("config")) 
    3535               (:file "json" :depends-on ("packages")) 
     36               (:file "twitter" :depends-on ("packages")) 
    3637               (:file "handlers" :depends-on ("json" "layout" "config" "image" "news")) 
    3738               (:file "tags" :depends-on ("image")) 

  • trunk/projects/quickhoney/src/twitter.lisp

    r3683 r3912  
    11(in-package :twitter) 
    22 
    3 (defparameter *authorization* '("QuickHoneyTest" "autotwitter") 
    4   "Authorization (USER PASSWORD) to use to identify to twitter") 
     3(define-persistent-class account () 
     4  ((user :read 
     5         :type bknr.user:user 
     6         :documentation "USER that this Twitter account belongs to") 
     7   (authorization :update 
     8                  :documentation "List of username and password for this account"))) 
    59 
    6 (defun update-status (status-string) 
    7   (babel:octets-to-string 
    8    (drakma:http-request "http://twitter.com/statuses/update.xml" 
    9                        :method :post 
    10                        :content (format nil "status=~A" status-string) 
    11                        :content-type "application/x-www-form-urlencoded" 
    12                        :basic-authorization *authorization*))) 
     10(define-condition cannot-update-status (error) 
     11  ((result :initarg :result :reader result))) 
     12 
     13(define-condition no-account-for-user (error) 
     14  ((user :initarg :user :reader user))) 
     15 
     16(defgeneric update-status (who status-string &key) 
     17 
     18  (:method ((account account) status-string &key) 
     19    (let ((result (babel:octets-to-string 
     20                   (drakma:http-request "http://twitter.com/statuses/update.xml" 
     21                                        :method :post 
     22                                                :content (format nil "status=~A" status-string) 
     23                                                :content-type "application/x-www-form-urlencoded" 
     24                                                :basic-authorization (account-authorization account))))) 
     25      (when (cl-ppcre:scan "<error>" result) 
     26        (error 'cannot-update-status :result result)))) 
     27 
     28  (:method ((user bknr.user:user) status-string &key errorp) 
     29    (let ((account (find user (class-instances 'account) :key #'account-user))) 
     30      (if account 
     31          (update-status account status-string) 
     32          (when errorp 
     33            (error 'no-account-for-user :user user)))))) 

  • trunk/projects/quickhoney/website/static/javascript.js

    r3911 r3912  
    1 // -*- Java -*- 
     1// This may look like -*- Java -*-, but it really is JavaScript 
     2 
     3// Copyright 2005-2008 Hans Huebner, hans.huebner@gmail.com 
     4// All rights reserved. 
    25 
    36/* configuration */