bknr-cvs

bknr-cvs@common-lisp.net

1964 discussions

[bknr-cvs] hans changed trunk/projects/quickhoney/src/image.lisp
by BKNR Commits 18 Sep '08

18 Sep '08

Revision: 3920 Author: hans URL: http://bknr.net/trac/changeset/3920 Change image link to not include /index U trunk/projects/quickhoney/src/image.lisp Modified: trunk/projects/quickhoney/src/image.lisp =================================================================== --- trunk/projects/quickhoney/src/image.lisp 2008-09-18 10:25:17 UTC (rev 3919) +++ trunk/projects/quickhoney/src/image.lisp 2008-09-18 11:56:35 UTC (rev 3920) @@ -46,7 +46,7 @@ collect (cadr cat-sub))) (defmethod make-image-link ((image quickhoney-image) &key internal) - (format nil "~@[~A~]/index#~(~A~@[/~A~]~)/~A" + (format nil "~@[~A~]/#~(~A~@[/~A~]~)/~A" (unless internal (format nil "http://~A" (website-host))) (quickhoney-image-category image) (quickhoney-image-subcategory image) (store-image-name image)))

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/handlers.lisp
by BKNR Commits 18 Sep '08

18 Sep '08

Revision: 3919 Author: hans URL: http://bknr.net/trac/changeset/3919 remove ffffound redirection again, as it does not work because of the caching. U trunk/projects/quickhoney/src/handlers.lisp Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-18 10:18:19 UTC (rev 3918) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-18 10:25:17 UTC (rev 3919) @@ -23,14 +23,6 @@ (header-out :cache-control) "max-age=15")) (call-next-method)) -;;; redirect users coming from ffffound to the image page. -(defmethod handle-object :before ((handler imageproc-handler) (image quickhoney-image)) - (when (cl-ppcre:scan "^http://ffffound.com/image/" (hunchentoot:header-in* :referer)) - (redirect (format nil "/~(~A/~A~)/~A" - (quickhoney-image-category image) - (quickhoney-image-subcategory image) - (store-image-name image))))) - (defclass random-image-handler (object-handler) ())

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/handlers.lisp
by BKNR Commits 18 Sep '08

18 Sep '08

Revision: 3918 Author: hans URL: http://bknr.net/trac/changeset/3918 Simplify U trunk/projects/quickhoney/src/handlers.lisp Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-18 10:11:50 UTC (rev 3917) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-18 10:18:19 UTC (rev 3918) @@ -23,12 +23,8 @@ (header-out :cache-control) "max-age=15")) (call-next-method)) -(defclass quickhoney-image-handler (image-handler) - () - (:documentation "Application dependent image handler with specific - referer based actions.")) - -(defmethod handle-object :before ((handler quickhoney-image-handler) (image quickhoney-image)) +;;; redirect users coming from ffffound to the image page. +(defmethod handle-object :before ((handler imageproc-handler) (image quickhoney-image)) (when (cl-ppcre:scan "^http://ffffound.com/image/" (hunchentoot:header-in* :referer)) (redirect (format nil "/~(~A/~A~)/~A" (quickhoney-image-category image)

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/
by BKNR Commits 18 Sep '08

18 Sep '08

Revision: 3917 Author: hans URL: http://bknr.net/trac/changeset/3917 Redirect visitors coming to an image from ffffound to the image HTML page. U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/webserver.lisp Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-18 06:12:23 UTC (rev 3916) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-18 10:11:50 UTC (rev 3917) @@ -5,7 +5,7 @@ (defparameter *editable-keywords* '(:explicit :buy-file :buy-print :buy-t-shirt) "List of keywords that are image keywords which can be edited through the CMS") -(defclass quickhoney-image-handler (page-handler) +(defclass quickhoney-image-dependent-handler (page-handler) () (:documentation "Mixin for handlers whose response only depend on quickhoney images. The HANDLE :AROUND method of this handler @@ -16,13 +16,25 @@ single-object handlers. Deletion is not properly handled presently.")) -(defmethod handle :around ((handler quickhoney-image-handler)) +(defmethod handle :around ((handler quickhoney-image-dependent-handler)) (let ((time (last-image-upload-timestamp))) (handle-if-modified-since time) (setf (header-out :last-modified) (rfc-1123-date time) (header-out :cache-control) "max-age=15")) (call-next-method)) +(defclass quickhoney-image-handler (image-handler) + () + (:documentation "Application dependent image handler with specific + referer based actions.")) + +(defmethod handle-object :before ((handler quickhoney-image-handler) (image quickhoney-image)) + (when (cl-ppcre:scan "^http://ffffound.com/image/" (hunchentoot:header-in* :referer)) + (redirect (format nil "/~(~A/~A~)/~A" + (quickhoney-image-category image) + (quickhoney-image-subcategory image) + (store-image-name image))))) + (defclass random-image-handler (object-handler) ()) @@ -41,7 +53,7 @@ (blob-to-stream (quickhoney-animation-image-animation animation) (send-headers))))) -(defclass json-image-info-handler (object-handler quickhoney-image-handler) +(defclass json-image-info-handler (object-handler quickhoney-image-dependent-handler) () (:default-initargs :query-function #'store-image-with-name)) @@ -74,7 +86,7 @@ (with-object-element ("image") (image-to-json image)))) -(defclass json-image-query-handler (object-handler quickhoney-image-handler) +(defclass json-image-query-handler (object-handler quickhoney-image-dependent-handler) ()) (defun images-in-category-sorted-by-time (cat-sub) @@ -216,7 +228,7 @@ (blob-to-stream image s))))) t t)))) -(defclass json-buttons-handler (prefix-handler quickhoney-image-handler) +(defclass json-buttons-handler (prefix-handler quickhoney-image-dependent-handler) ()) (defun preproduced-buttons (category subcategory) Modified: trunk/projects/quickhoney/src/webserver.lisp =================================================================== --- trunk/projects/quickhoney/src/webserver.lisp 2008-09-18 06:12:23 UTC (rev 3916) +++ trunk/projects/quickhoney/src/webserver.lisp 2008-09-18 10:11:50 UTC (rev 3917) @@ -38,6 +38,7 @@ ("/json-news-archive" json-news-archive-handler) ("/json-news" json-news-handler) ("/shutdown" shutdown-handler) + ("/image" quickhoney-image-handler) user images ("/static" directory-handler

1 0

[bknr-cvs] hans changed trunk/bknr/web/src/images/imageproc-handler.lisp
by BKNR Commits 18 Sep '08

18 Sep '08

Revision: 3916 Author: hans URL: http://bknr.net/trac/changeset/3916 When an image is being served unprocessed, send the blob data instead of instantiating the image into memory and then serving it. This way, the original picture quality will be preserved. U trunk/bknr/web/src/images/imageproc-handler.lisp Modified: trunk/bknr/web/src/images/imageproc-handler.lisp =================================================================== --- trunk/bknr/web/src/images/imageproc-handler.lisp 2008-09-17 20:32:10 UTC (rev 3915) +++ trunk/bknr/web/src/images/imageproc-handler.lisp 2008-09-18 06:12:23 UTC (rev 3916) @@ -171,8 +171,13 @@ (error-404)) (defmethod handle-object ((page-handler imageproc-handler) image) - (with-http-response (:content-type (image-content-type (image-type-keyword image))) - (handle-if-modified-since (blob-timestamp image)) - (setf (header-out "Last-Modified") (rfc-1123-date (blob-timestamp image))) - (imageproc image (cdr (decoded-handler-path page-handler))))) + (handle-if-modified-since (blob-timestamp image)) + (setf (header-out :last-modified) (rfc-1123-date (blob-timestamp image))) + (let ((operations (cdr (decoded-handler-path page-handler)))) + (if operations + (imageproc image operations) + (with-http-response (:content-type (image-content-type (image-type-keyword image))) + (setf (header-out :content-length) (blob-size image)) + (with-open-file (blob-data (blob-pathname image) :element-type '(unsigned-byte 8)) + (copy-stream blob-data (send-headers) '(unsigned-byte 8)))))))

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/templates/index.xml
by BKNR Commits 17 Sep '08

17 Sep '08

Revision: 3915 Author: hans URL: http://bknr.net/trac/changeset/3915 Make spider keywords entry field larger. U trunk/projects/quickhoney/website/templates/index.xml Modified: trunk/projects/quickhoney/website/templates/index.xml =================================================================== --- trunk/projects/quickhoney/website/templates/index.xml 2008-09-17 20:20:54 UTC (rev 3914) +++ trunk/projects/quickhoney/website/templates/index.xml 2008-09-17 20:32:10 UTC (rev 3915) @@ -191,7 +191,7 @@ </span> <br /> Keywords:<br /> - <input type="text" id="upload_keywords" name="spider-keywords" value="" /><br /> + <input type="text" id="upload_keywords" name="spider-keywords" value="" size="60" /><br /> <input type="checkbox" id="explicit" name="explicit" value="1" /> Explicit<br/> <!-- shop disabled for now <input type="checkbox" name="buy-file" value="1"/> Sell as file<br/> @@ -262,7 +262,7 @@ </span> <br /> Keywords:<br /> - <input type="text" id="edit_keywords" name="spider-keywords" value="" /><br /> + <input type="text" id="edit_keywords" name="spider-keywords" value="" size="60" /><br /> <input type="checkbox" id="edit_explicit" name="explicit" value="1" /> Explicit<br/> <!-- shop disabled for now <input type="checkbox" id="edit_buy-file" name="buy-file" value="1"/> Sell as file<br/>

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/
by BKNR Commits 17 Sep '08

17 Sep '08

Revision: 3914 Author: hans URL: http://bknr.net/trac/changeset/3914 Always show same button home page and category. Add 'quickhoney' application to twitter message. Use more images to create buttons on home page. U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/twitter.lisp U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 13:31:04 UTC (rev 3913) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 20:20:54 UTC (rev 3914) @@ -236,7 +236,12 @@ (images-in-all-subcategories-sorted-by-time subcategory) (images-in-category-sorted-by-time (list category subcategory))))) (when images - (cons :images images)))) + (cons :images (loop with since = (- (get-universal-time) (* 60 60 24 14)) + for i from 0 + for image in images + when (or (< i 10) + (> (blob-timestamp image) since)) + collect image))))) (defmethod handle ((handler json-buttons-handler)) (with-json-response () @@ -256,8 +261,7 @@ ;; format and come with the caption rendered into ;; them. (let ((category (make-keyword-from-string category)) - (subcategory (make-keyword-from-string subcategory)) - (count 10)) + (subcategory (make-keyword-from-string subcategory))) (destructuring-bind (&optional type &rest images) (or (preproduced-buttons category subcategory) (newest-images category subcategory) @@ -265,9 +269,7 @@ (encode-array-element type) (dolist (image (or images (list (store-image-with-name "button-dummy")))) - (encode-array-element (store-object-id image)) - (when (zerop (decf count)) - (return))))))))))))) + (encode-array-element (store-object-id image))))))))))))) (defclass upload-image-handler (admin-only-handler prefix-handler) ()) Modified: trunk/projects/quickhoney/src/twitter.lisp =================================================================== --- trunk/projects/quickhoney/src/twitter.lisp 2008-09-17 13:31:04 UTC (rev 3913) +++ trunk/projects/quickhoney/src/twitter.lisp 2008-09-17 20:20:54 UTC (rev 3914) @@ -19,7 +19,8 @@ (let ((result (babel:octets-to-string (drakma:http-request "http://twitter.com/statuses/update.xml" :method :post - :content (format nil "status=~A" status-string) + :content (format nil "status=~A&source=quickhoney" + (hunchentoot:url-encode status-string)) :content-type "application/x-www-form-urlencoded" :basic-authorization (account-authorization account))))) (when (cl-ppcre:scan "<error>" result) Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 13:31:04 UTC (rev 3913) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 20:20:54 UTC (rev 3914) @@ -645,13 +645,28 @@ /* directory - first level category */ var button_images = []; +var last_category_buttons = {}; function random_button_image(category, subcategory, width, height, cut_category) { + + /* We want the last used button for a category used on the home + * page to also appear on that categories page next. For that, we + * save the previously displayed home image button here. Not pretty. + */ + var key = category + '/' + subcategory; var image_ids = button_images[key]; if (image_ids && image_ids.length) { var type = image_ids[0]; - var image_id = image_ids[1 + Math.floor(Math.random() * (image_ids.length - 1))]; + var ids = image_ids.slice(1); + var image_id = ids[Math.floor(Math.random() * ids.length)]; + if (last_category_buttons[category] && findValue(ids, last_category_buttons[category]) != -1) { + image_id = last_category_buttons[category]; + last_category_buttons[category] = null; + } + if (category == 'home') { + last_category_buttons[subcategory] = image_id; + } if (type == 'buttons') { return '/image/' + image_id; } else { @@ -1582,7 +1597,10 @@ TBODY(null, TR(null, TD({ 'class': 't-shirt-sample', valign: 'top' }, - IMG({ id: 't-shirt-sample', src: '/image/' + encodeURI(current_image.name) + '/cell,ffffff,100,100,10'})), + IMG({ id: 't-shirt-sample', + src: ('/image/' + + encodeURI(current_image.name) + + '/cell,ffffff,100,100,10')})), TD(null, "Color:", BR(), "Tee - white", BR(),

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/handlers.lisp
by BKNR Commits 17 Sep '08

17 Sep '08

Revision: 3913 Author: hans URL: http://bknr.net/trac/changeset/3913 Make URLs tiny instead of relying on Twitter to do so, as that won't always work. U trunk/projects/quickhoney/src/handlers.lisp Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 11:47:43 UTC (rev 3912) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 13:31:04 UTC (rev 3913) @@ -305,9 +305,13 @@ :spider-keywords spider-keywords)))) (with-http-response () (with-http-body () - (twitter:update-status (bknr-session-user) - (format nil "Uploaded new image ~A: http://quickhoney.com~A/~A" - image-name (handler-path handler) image-name)) + (let ((tinyurl (drakma:http-request + (format nil "http://tinyurl.com/api-create.php?url=~A" + (hunchentoot:url-encode (format nil "http://quickhoney.com~A/~A" + (handler-path handler) image-name)))))) + (twitter:update-status (bknr-session-user) + (format nil "Uploaded new image ~A: ~A" + image-name tinyurl))) (html (:html (:head (:title "Upload successful")

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/
by BKNR Commits 17 Sep '08

17 Sep '08

Revision: 3912 Author: hans URL: http://bknr.net/trac/changeset/3912 Add automatic Twitter status updates when uploading. Remove upgrade stuff, we're live! U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/packages.lisp U trunk/projects/quickhoney/src/quickhoney.asd U trunk/projects/quickhoney/src/twitter.lisp D trunk/projects/quickhoney/upgrade-stuff/ U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 11:47:43 UTC (rev 3912) @@ -293,9 +293,10 @@ (with-image-from-upload* (uploaded-file) (let* ((width (cl-gd:image-width)) (height (cl-gd:image-height)) - (ratio (/ 1 (max (/ width 300) (/ height 200))))) + (ratio (/ 1 (max (/ width 300) (/ height 200)))) + (image-name (pathname-name (upload-original-filename uploaded-file)))) (maybe-convert-to-palette) - (let* ((image (make-store-image :name (pathname-name (upload-original-filename uploaded-file)) + (let* ((image (make-store-image :name image-name :class-name 'quickhoney-image :keywords (cons :upload (image-keywords-from-request-parameters)) :initargs (list :owner (bknr-session-user) @@ -304,6 +305,9 @@ :spider-keywords spider-keywords)))) (with-http-response () (with-http-body () + (twitter:update-status (bknr-session-user) + (format nil "Uploaded new image ~A: http://quickhoney.com~A/~A" + image-name (handler-path handler) image-name)) (html (:html (:head (:title "Upload successful") @@ -355,16 +359,19 @@ :dest-width +news-image-width+ :dest-height scaled-height) (cl-gd:destroy-image uploaded-image) (setf uploaded-image scaled-image))) - (let ((item (make-store-image :name (normalize-news-title title) - :image uploaded-image - :type (if (cl-gd:true-color-p uploaded-image) :jpg :png) - :class-name 'quickhoney-news-item - :keywords (list :upload) - :initargs (list :cat-sub (list :news) - :title title - :text text - :owner (bknr-session-user))))) + (let* ((title (normalize-news-title title)) + (item (make-store-image :name title + :image uploaded-image + :type (if (cl-gd:true-color-p uploaded-image) :jpg :png) + :class-name 'quickhoney-news-item + :keywords (list :upload) + :initargs (list :cat-sub (list :news) + :title title + :text text + :owner (bknr-session-user))))) (declare (ignore item)) ; for now + (twitter:update-status (bknr-session-user) + (format nil "Posted news item: http://quickhoney.com/news/~A" title)) (with-http-response () (with-http-body () (html (:html Modified: trunk/projects/quickhoney/src/packages.lisp =================================================================== --- trunk/projects/quickhoney/src/packages.lisp 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/src/packages.lisp 2008-09-17 11:47:43 UTC (rev 3912) @@ -77,5 +77,5 @@ (:use :cl)) (defpackage :twitter - (:use :cl) + (:use :cl :bknr.datastore) (:export #:update-status)) \ No newline at end of file Modified: trunk/projects/quickhoney/src/quickhoney.asd =================================================================== --- trunk/projects/quickhoney/src/quickhoney.asd 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/src/quickhoney.asd 2008-09-17 11:47:43 UTC (rev 3912) @@ -33,6 +33,7 @@ (:file "layout" :depends-on ("config")) (:file "imageproc" :depends-on ("config")) (:file "json" :depends-on ("packages")) + (:file "twitter" :depends-on ("packages")) (:file "handlers" :depends-on ("json" "layout" "config" "image" "news")) (:file "tags" :depends-on ("image")) (:file "webserver" :depends-on ("handlers")) Modified: trunk/projects/quickhoney/src/twitter.lisp =================================================================== --- trunk/projects/quickhoney/src/twitter.lisp 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/src/twitter.lisp 2008-09-17 11:47:43 UTC (rev 3912) @@ -1,12 +1,33 @@ (in-package :twitter) -(defparameter *authorization* '("QuickHoneyTest" "autotwitter") - "Authorization (USER PASSWORD) to use to identify to twitter") +(define-persistent-class account () + ((user :read + :type bknr.user:user + :documentation "USER that this Twitter account belongs to") + (authorization :update + :documentation "List of username and password for this account"))) -(defun update-status (status-string) - (babel:octets-to-string - (drakma:http-request "http://twitter.com/statuses/update.xml" - :method :post - :content (format nil "status=~A" status-string) - :content-type "application/x-www-form-urlencoded" - :basic-authorization *authorization*))) \ No newline at end of file +(define-condition cannot-update-status (error) + ((result :initarg :result :reader result))) + +(define-condition no-account-for-user (error) + ((user :initarg :user :reader user))) + +(defgeneric update-status (who status-string &key) + + (:method ((account account) status-string &key) + (let ((result (babel:octets-to-string + (drakma:http-request "http://twitter.com/statuses/update.xml" + :method :post + :content (format nil "status=~A" status-string) + :content-type "application/x-www-form-urlencoded" + :basic-authorization (account-authorization account))))) + (when (cl-ppcre:scan "<error>" result) + (error 'cannot-update-status :result result)))) + + (:method ((user bknr.user:user) status-string &key errorp) + (let ((account (find user (class-instances 'account) :key #'account-user))) + (if account + (update-status account status-string) + (when errorp + (error 'no-account-for-user :user user)))))) \ No newline at end of file Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 11:47:43 UTC (rev 3912) @@ -1,5 +1,8 @@ -// -*- Java -*- +// This may look like -*- Java -*-, but it really is JavaScript +// Copyright 2005-2008 Hans Huebner, hans.huebner(a)gmail.com +// All rights reserved. + /* configuration */ var max_news_items = 50; /* maximum number of news items to display */

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/static/javascript.js
by BKNR Commits 17 Sep '08

17 Sep '08

Revision: 3911 Author: hans URL: http://bknr.net/trac/changeset/3911 tweak last change U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 09:24:51 UTC (rev 3910) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 09:26:32 UTC (rev 3911) @@ -561,7 +561,7 @@ if (!pages[pagename]) { document.location.href = '/'; - return; + return false; } var page = pages[pagename];

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

bknr-cvs