Changeset 2522

Show
Ignore:
Timestamp:
02/17/08 20:25:56 (9 months ago)
Author:
hhubner
Message:

Docstrings.

Cleaning up: The old RSS parsing code is now gone, as it was not used and
did not work any more.

HANDLER-MATCHES renamed to HANDLER-MATCHES-P

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • branches/trunk-reorg/bknr/web/src/bknr-web.asd

    r2451 r2522  
    5050                          :depends-on ("packages")) 
    5151 
    52                  (:module "rss" :components ((:file "rss") 
    53                                              (:file "parse-xml") 
    54                                              (:file "parse-rss10" 
    55                                                     :depends-on ("parse-xml" "rss")) 
    56                                              (:file "parse-rss091" 
    57                                                     :depends-on ("parse-xml" "rss")) 
    58                                              (:file "parse-atom" 
    59                                                     :depends-on ("parse-xml" "rss")) 
    60                                              (:file "parse-rss20" 
    61                                                     :depends-on ("parse-xml" "rss"))) 
     52                 (:module "rss" :components ((:file "rss")) 
    6253                          :depends-on ("packages")) 
    6354 

  • branches/trunk-reorg/bknr/web/src/images/image-handlers.lisp

    r2497 r2522  
    1111    (unless (zerop date) 
    1212      (setf (header-out :last-modified) (rfc-1123-date date))) 
    13     (with-http-body () 
     13    (let ((stream (send-headers))) 
     14      (setf (flex:flexi-stream-element-type stream) 'flex:octet) 
    1415      (setf (save-alpha-p :image image) t) 
    1516      (if (member image-format '(:jpg :jpeg)) 
    16           (write-image-to-stream *html-stream* image-format :image image :quality quality) 
    17           (write-image-to-stream *html-stream* image-format :image image)) 
    18       (finish-output *html-stream*)))) 
     17          (write-image-to-stream stream image-format :image image :quality quality) 
     18          (write-image-to-stream stream image-format :image image)) 
     19      (finish-output stream)))) 
    1920 
    2021(defmethod store-image-xml-info ((image store-image)) 
    …… 
    5354  "bknr images") 
    5455 
    55 (defmethod object-list-handler-rss-link ((handler image-page-handler) object) 
    56   "/image-rss") 
    57  
    5856(defmethod object-list-handler-get-objects ((handler image-page-handler) object) 
    5957  (all-store-images)) 
    …… 
    6664  (let ((results (make-keyword-results (object-list-handler-get-objects handler images)))) 
    6765    (with-bknr-page (:title (object-list-handler-title handler images)) 
    68       (cmslink (object-list-handler-rss-link handler images) "rss") 
    6966      (image-page results)))) 
    7067   
    …… 
    115112  (format nil "bknr keyword images: ~a" keyword)) 
    116113 
    117 (defmethod object-list-handler-rss-link ((handler image-keyword-handler) keyword) 
    118   (format nil "/keyword-rss/~A" 
    119           (string-downcase (symbol-name keyword)))) 
    120  
    121114(defclass image-union-handler (image-page-handler keywords-handler) 
    122115  ()) 
    …… 
    127120(defmethod object-list-handler-title ((handler image-union-handler) keywords) 
    128121  (format nil "bknr union images: ~a" keywords)) 
    129  
    130 (defmethod object-list-handler-rss-link ((handler image-union-handler) keywords) 
    131   (format nil "/union-rss/~A" (parse-url))) 
    132122 
    133123(defclass image-intersection-handler (image-page-handler keywords-handler) 
    …… 
    140130  (format nil "bknr intersection images: ~a" keywords)) 
    141131 
    142 (defmethod object-list-handler-rss-link ((handler image-intersection-handler) keywords) 
    143   (format nil "/intersection-rss/~A" (parse-url))) 
    144  
    145 ;;; rss image feeds 
    146 #| 
    147 (defclass rss-image-handler (object-rss-handler image-page-handler) 
    148   ()) 
    149  
    150 (defmethod create-object-rss-feed ((handler rss-image-handler) object) 
    151   (let* ((url (website-url (page-handler-site handler))) 
    152          (image-items (mapcar #'(lambda (image) 
    153                                       (store-image-to-rss-item image :url url)) 
    154                                   (subseq (sort (object-list-handler-get-objects handler object) 
    155                                                 #'> :key #'blob-timestamp) 
    156                                           0 20)))) 
    157     (if image-items 
    158         (make-instance 'rss-feed 
    159                        :channel (make-instance 
    160                                  'rss-channel 
    161                                  :about (render-uri url nil) 
    162                                  :title (object-list-handler-title handler object) 
    163                                  :link (render-uri url nil) 
    164                                  :items (mapcar #'rss-item-link image-items)) 
    165                        :items image-items) 
    166         (make-instance 'rss-feed :channel (make-instance 'rss-channel 
    167                                                          :about "no such keyword" 
    168                                                          :title "no such keyword"))))) 
    169    
    170 (defclass rss-image-keyword-handler (rss-image-handler image-keyword-handler) 
    171   ()) 
    172  
    173 (defclass rss-image-union-handler (rss-image-handler image-union-handler) 
    174   ()) 
    175  
    176 (defclass rss-image-intersection-handler (rss-image-handler image-intersection-handler) 
    177   ()) 
    178 |# 
    179132 
    180133(defclass xml-image-browser-handler (image-handler xml-object-handler) 
    …… 
    204157  ("/image-union" image-union-handler) 
    205158  ("/image-intersection" image-intersection-handler) 
    206   #| 
    207   ("/rss-image" rss-image-handler) 
    208   ("/rss-image-keyword" rss-image-keyword-handler) 
    209   ("/rss-image-union" rss-image-union-handler) 
    210   ("/rss-image-intersection" rss-image-intersection-handler) 
    211   |# 
    212159  ("/image" imageproc-handler) 
    213160  ("/image-import" image-import-handler) 

  • branches/trunk-reorg/bknr/web/src/images/image.lisp

    r2508 r2522  
    104104    (keyword (store-image-with-name (string-downcase (symbol-name image-id)))))) 
    105105 
    106 (defmethod store-image-to-rss-item ((image store-image) &key (url (parse-uri ""))) 
    107   (let ((image-url (render-uri (merge-uris (parse-uri (format nil "/image/~a" 
    108                                                               (store-object-id image))) 
    109                                            url) nil)) 
    110         (browse-url (render-uri (merge-uris (parse-uri (format nil "/browse-image/~A" 
    111                                                               (store-object-id image))) 
    112                                            url) nil))   ) 
    113     (make-instance 'rss-item 
    114                    :about browse-url 
    115                    :title (store-image-name image) 
    116                    :link browse-url 
    117                    :desc (with-output-to-string (s) 
    118                            (html-stream s ((:a :href image-url) 
    119                                            ((:img :src 
    120                                                   (concatenate 'string 
    121                                                                image-url 
    122                                                                "/thumbnail,,320,200") 
    123                                                   :align "left"))))) 
    124                    :date (blob-timestamp image)))) 
    125  
    126106;;; import 
    127107(defun import-image (pathname &key name user keywords directory (keywords-from-dir t) (class-name 'store-image) initargs) 

  • branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp

    r2497 r2522  
    3535                 (not (true-color-p input-image))) 
    3636        (true-color-to-palette :dither t :image working-image :colors-wanted 256)) 
    37       (let ((stream (send-headers))) 
    38         (setf (flex:flexi-stream-element-type stream) 'flex:octet) 
    39         (write-image-to-stream stream (image-type-keyword image) :image working-image)) 
     37      (emit-image-to-browser working-image (image-type-keyword image)) 
    4038      (unless (eq working-image input-image) 
    4139        (destroy-image working-image))))) 

  • branches/trunk-reorg/bknr/web/src/packages.lisp

    r2508 r2522  
    2121(defpackage :bknr.rss 
    2222  (:use :cl :cl-user :cl-ppcre :bknr.utils :bknr.xml :puri :cxml-xmls :bknr.datastore :bknr.indices :cxml) 
    23   (:export #:xml-escape 
    24            #:*img-src-scanner* 
    25            #:*a-href-scanner* 
    26            #:*link-href-scanner* 
    27            #:replace-relative-links 
    28            #:make-absolute-url 
    29     
    30            #:rss-to-xml 
    31            #:merge-feeds 
    32  
    33            ;; channel 
     23  (:export ;; channel 
     24 
    3425           #:rss-channel 
    3526           #:find-rss-channel 
    …… 
    4435           #:rss-channel-items 
    4536           #:rss-channel-xml 
    46  
    47            ;; image 
    48            #:rss-image 
    49            #:rss-image-about 
    50            #:rss-image-title 
    51            #:rss-image-url 
    52            #:rss-image-link 
    5337 
    5438           ;; item 
    …… 
    6650           #:rss-item-guid 
    6751           #:rss-item-source 
    68            #:rss-item-encoded-content 
    69  
    70            ;; textinput 
    71            #:rss-textinput 
    72            #:rss-textinput-about 
    73            #:rss-textinput-title 
    74            #:rss-textinput-desc 
    75            #:rss-textinput-link 
    76            #:rss-textinput-name 
    77  
    78            #:parse-rss091-feed 
    79            #:parse-rss10-feed 
    80            #:parse-rss20-feed 
    81            #:parse-atom-feed 
    82  
    83            #:*base-url*)) 
     52           #:rss-item-encoded-content)) 
    8453 
    8554(defpackage :bknr.events 
    …… 
    293262           #:website-base-href 
    294263           #:website-make-path 
    295            #:website-rss-feed-url 
    296264           #:host 
    297265           #:publish-site 
    …… 
    299267           #:unpublish 
    300268 
    301            #:handler-matches 
     269           #:handler-matches-p 
    302270           #:handle-object 
    303271           #:handle-object-form 
    …… 
    358326           #:object-list-handler-get-objects 
    359327           #:object-list-handler-title 
    360            #:object-list-handler-rss-link 
    361328           #:object-list-handler-show-object-xml 
    362329           #:object-date-list-handler 

  • branches/trunk-reorg/bknr/web/src/rss/rss.lisp

    r2451 r2522  
    55;; This package aids in the automatic generation of RSS channels. 
    66 
    7 ;; Class rss-channel models one rss channel.  Items are added to a 
    8 ;; channel by deriving other persistent classes from the (mixin) class 
    9 ;; rss-item.  When an object of such a derived class is created, it is 
    10 ;; automatically added to its RSS channel.  Likewise, it is 
    11 ;; automatically deleted from the channel when it is deleted. 
    12  
    13 ;; The channel that an item is put into is defined by the generic 
    14 ;; function rss-item-channel which needs to be specialized for each 
    15 ;; item class.  The default method of this generic function specifies 
    16 ;; nil as channel, which results in the creation of a warning message 
    17 ;; when an object of this class is created. 
    18  
    19 ;; The rss-item-channel method may return the channel either as a 
    20 ;; string or as a channel object. 
    21  
    22 ;; Subclasses of rss-item should provide methods for some of the 
    23 ;; generic functions (rss-item-channel rss-item-title rss-item-link 
    24 ;; rss-item-description rss-item-author rss-item-category 
    25 ;; rss-item-comments rss-item-enclosure rss-item-guid 
    26 ;; rss-item-source).  These functions are called when the RSS file for 
    27 ;; the channel is generated and provide the 
    28  
    29 ;; One rss-item can only be in one channel. 
    30  
    31 ;; The channel object has more required elements than the standard 
    32 ;; specifies in order to make the generated feed documents more widely 
    33 ;; accepted. 
     7;; See the documentation to class RSS-CHANNEL for an overview. 
    348 
    359;;; Paul Graham, On Lisp, p191 
    …… 
    4923   (last-update :update :initform (get-universal-time)) 
    5024   (max-item-age :update :initform (* 4 7 3600)) 
    51    (items :update :initform nil))) 
     25   (items :update :initform nil)) 
     26  (:documentation "RSS-CHANNEL models one rss channel.  Items are 
     27added to a channel by deriving other persistent classes from the mixin 
     28class RSS-ITEM.  When an object of such a derived class is created, it 
     29is automatically added to its RSS channel.  Likewise, it is 
     30automatically deleted from the channel when it is deleted. 
     31 
     32The channel that an item is put into is defined by the generic 
     33function RSS-ITEM-CHANNEL which needs to be specialized for each item 
     34class.  The default method of this generic function specifies nil as 
     35channel, which results in the creation of a warning message when an 
     36object of this class is created. 
     37 
     38The RSS-ITEM-CHANNEL method may return the channel either as a string 
     39or as a channel object. 
     40 
     41Subclasses of RSS-ITEM should provide methods for some of the generic 
     42functions (RSS-ITEM-CHANNEL RSS-ITEM-TITLE RSS-ITEM-LINK 
     43RSS-ITEM-DESCRIPTION RSS-ITEM-AUTHOR RSS-ITEM-CATEGORY 
     44RSS-ITEM-COMMENTS RSS-ITEM-ENCLOSURE RSS-ITEM-GUID RSS-ITEM-SOURCE). 
     45These functions are called when the RSS file for the channel is 
     46generated and provide the content in the RSS items. 
     47 
     48One RSS-ITEM can only be in one channel, which is a restriction that 
     49may eventually be removed. 
     50 
     51The channel object has more required elements than specified by the 
     52standard in order to make the generated feed documents more widely 
     53accepted.")) 
    5254 
    5355(defmethod prepare-for-snapshot ((channel rss-channel)) 
     56  "When snapshotting, remove items from CHANNEL that are destroyed." 
    5457  (setf (rss-channel-items channel) (remove-if #'object-destroyed-p (rss-channel-items channel)))) 
    5558 
    …… 
    5760 
    5861(define-persistent-class rss-item () 
    59   ()) 
    60  
    61 (defgeneric rss-item-pub-date (item)) 
     62  () 
     63  (:documentation "Mixin class for RSS items.  See documentation for 
     64class RSS-CHANNEL for an overview.")) 
    6265 
    6366(defun make-rss-channel (name title description link &rest args) 
    …… 
    8689          (rss-item-xml item)))))) 
    8790 
    88 (defmethod rss-channel-items ((channel rss-channel)) 
    89   "Return all non-expired items in channel." 
    90   (let ((expiry-time (- (get-universal-time) (rss-channel-max-item-age channel)))) 
    91     (remove-if (lambda (item) (or (object-destroyed-p item) 
    92                                   (< (rss-item-pub-date item) expiry-time))) 
    93                (slot-value channel 'items)))) 
     91(defgeneric rss-channel-items (channel) 
     92  (:documentation "Return all non-expired items in channel.") 
     93  (:method ((channel rss-channel)) 
     94    (let ((expiry-time (- (get-universal-time) (rss-channel-max-item-age channel)))) 
     95      (remove-if (lambda (item) (or (object-destroyed-p item) 
     96                                    (< (rss-item-pub-date item) expiry-time))) 
     97                 (slot-value channel 'items))))) 
    9498 
    9599(deftransaction rss-channel-cleanup (channel) 
    …… 
    98102  (setf (slot-value channel 'items) (rss-channel-items channel))) 
    99103 
    100 ;; Internal helper functions to find a channel 
     104(defgeneric remove-item (channel item) 
     105  (:documentation "Remove ITEM from CHANNEL.  May only be called 
     106within transaction context.") 
     107  (:method ((channel rss-channel) item) 
     108    (setf (slot-value channel 'items) (remove item (rss-channel-items channel)))) 
     109  (:method ((channel string) item) 
     110    (aif (find-rss-channel channel) 
     111         (remove-item it item))) 
     112  (:method ((channel (eql nil)) item) 
     113    (warn "no RSS channel defined for item ~A" item))) 
    101114 
    102 (defmethod remove-item ((channel rss-channel) item) 
    103   "Remove item from channel.  May only be called within transaction context." 
    104   (setf (slot-value channel 'items) (remove item (rss-channel-items channel)))) 
    105  
    106 (defmethod remove-item ((channel string) item) 
    107   (aif (find-rss-channel channel) 
    108        (remove-item it item))) 
    109  
    110 (defmethod remove-item ((channel (eql nil)) item) 
    111   (warn "no RSS channel defined for item ~A" item)) 
    112  
    113 (defmethod add-item ((channel rss-channel) item) 
    114   "Add item to channel.  May only be called within transaction context." 
    115   (setf (slot-value channel 'items) (cons item (rss-channel-items channel)))) 
    116  
    117 (defmethod add-item ((channel string) item) 
    118   (aif (find-rss-channel channel) 
    119        (add-item it item) 
    120        (warn "can't find RSS channel ~A to add newly created item ~A to" channel item))) 
    121  
    122 (defmethod add-item ((channel (eql nil)) item) 
    123   (warn "no RSS channel defined for item ~A" item)) 
     115(defgeneric add-item (channel item) 
     116  (:documentation "Add ITEM to CHANNEL.  May only be called within 
     117transaction context.") 
     118  (:method ((channel rss-channel) item) 
     119    (setf (slot-value channel 'items) (cons item (rss-channel-items channel)))) 
     120  (:method ((channel string) item) 
     121    (aif (find-rss-channel channel) 
     122         (add-item it item) 
     123         (warn "can't find RSS channel ~A to add newly created item ~A to" channel item))) 
     124  (:method ((channel (eql nil)) item) 
     125    (warn "no RSS channel defined for item ~A" item))) 
    124126 
    125127(defmethod initialize-persistent-instance :after ((rss-item rss-item)) 
    …… 
    130132 
    131133(defun item-slot-element (item slot-name) 
     134  "Cheapo helper function to map from a pseudo slot name to an accessor." 
    132135  (let ((accessor (find-symbol (format nil "RSS-ITEM-~A" slot-name) (find-package :bknr.rss)))) 
    133136    (aif (funcall accessor item) 
    …… 
    136139 
    137140(defun rss-item-xml (item) 
     141  "Generate RSS XML for ITEM using CXML's unparse functionality." 
    138142  (with-element "item" 
    139143    (dolist (slot '(title link author category comments enclosure source)) 
    …… 
    155159;; methods below. 
    156160 
    157 (defmethod rss-item-published (item) 
    158   t) 
     161(defgeneric rss-item-pub-date (item) 
     162  (:documentation "The default implementation for the publication date 
     163delivers the current system date/time as publication date.") 
     164  (:method (item) 
     165    (warn "no rss-item-pub-date defined for class ~A, using current date/time" (class-of item)) 
     166    (get-universal-time))) 
    159167 
    160 (defmethod rss-item-pub-date (item) 
    161   "The default implementation for the publication date delivers the 
    162 current system date/time as publication date." 
    163   (warn "no rss-item-pub-date defined for class ~A, using current date/time" (class-of item)) 
    164   (get-universal-time)) 
     168(defgeneric rss-item-published (item) 
     169  (:documentation "Return non-nil if the ITEM is published. 
     170Non-published items are not put into generated XML by 
     171RSS-CHANNEL-XML.") 
     172  (:method (item) 
     173    t)) 
    165174 
    166 (defmethod rss-item-channel (item)) 
    167 (defmethod rss-item-title (item)) 
    168 (defmethod rss-item-link (item)) 
    169 (defmethod rss-item-description (item)) 
    170 (defmethod rss-item-author (item)) 
    171 (defmethod rss-item-category (item)) 
    172 (defmethod rss-item-comments (item)) 
    173 (defmethod rss-item-enclosure (item)) 
    174 (defmethod rss-item-guid (item)) 
    175 (defmethod rss-item-source (item)) 
    176 (defgeneric rss-item-encoded-content (item) 
    177   (:documentation "Return the content for ITEM in encoded (usually HTML) form as string.") 
    178   (:method (item) 
    179     (declare (ignore item)) 
    180     nil)) 
     175(defmacro define-rss-item-field (field-name 
     176                                 &key 
     177                                 (documentation (format nil "Return the ~(~A~) of the ITEM as a string" field-name)) 
     178                                 mandatory) 
     179  `(defgeneric ,(intern (format nil "RSS-ITEM-~A" field-name)) (item) 
     180    (:documentation ,(format nil "~A~@[ (optional)~]" 
     181                             documentation (not mandatory))) 
     182    ,@(unless mandatory 
     183            '((:method (item) nil))))) 
     184 
     185(define-rss-item-field channel 
     186    :documentation "Return the channel that the ITEM is published in." 
     187    :mandatory t) 
     188(define-rss-item-field title) 
     189(define-rss-item-field link) 
     190(define-rss-item-field description) 
     191(define-rss-item-field author) 
     192(define-rss-item-field category) 
     193(define-rss-item-field comments) 
     194(define-rss-item-field enclosure) 
     195(define-rss-item-field guid) 
     196(define-rss-item-field source) 
     197(define-rss-item-field encoded-content 
     198    :documentation "Return the content for ITEM in encoded (usually HTML) form as string.") 

  • branches/trunk-reorg/bknr/web/src/web/handlers.lisp

    r2516 r2522  
    504504(defgeneric object-date-list-handler-grouped-objects (handler object)) 
    505505 
    506 (defmethod object-date-list-handler-date ((handler object-date-list-handler) 
    507                                           object) 
    508   (with-query-params (date) 
    509     (get-daytime (if date 
    510                     (or (parse-integer date :junk-allowed t) 
    511                         (get-universal-time)) 
    512                     (get-universal-time))))) 
     506(defgeneric object-date-list-handler-date (handler object) 
     507  (:method ((handler object-date-list-handler) object) 
     508    (with-query-params (date) 
     509      (get-daytime (if date 
     510                       (or (parse-integer date :junk-allowed t) 
     511                          (get-universal-time)) 
     512                       (get-universal-time)))))) 
    513513 
    514514(defclass admin-only-handler () 

  • branches/trunk-reorg/bknr/web/src/web/menu.lisp

    r2430 r2522  
    4545                #+cmu (ext:unix-namestring (merge-pathnames config *default-pathname-defaults*)) 
    4646                #+sbcl (sb-int:unix-namestring (merge-pathnames config *default-pathname-defaults*)) 
     47                #-(or cmu sbcl) (namestring (probe-file (merge-pathnames config *default-pathname-defaults*))) 
    4748                *menu-def-classes*))) 
    4849    (html 

  • branches/trunk-reorg/bknr/web/src/web/site.lisp

    r2227 r2522  
    66(defparameter *thumbnail-max-height* 54) 
    77 
    8 ;; default billboard to show on home page 
    9 (defparameter *default-billboard* "main") 
     8(defparameter *default-billboard* "main" 
     9  "default billboard to show on home page") 
    1010 

  • branches/trunk-reorg/bknr/web/src/web/tags.lisp

    r2488 r2522  
    6262 
    6363(define-bknr-tag date-field (name &key date (show-time t)) 
     64  "Generate a date entry widget using HTML <select> elements." 
    6465  (unless date 
    6566    (setf date (get-universal-time))) 

  • branches/trunk-reorg/bknr/web/src/web/template-handler.lisp

    r2510 r2522  
    301301  `(invoke-with-error-handlers (lambda () ,@body) ,handler)) 
    302302 
    303 (defmethod handler-matches ((handler template-handler)) 
     303(defmethod handler-matches-p ((handler template-handler)) 
    304304  (handler-case  
    305305      (find-template-pathname handler (script-name)) 

  • branches/trunk-reorg/bknr/web/src/web/web-macros.lisp

    r2508 r2522  
    8181 
    8282(defmacro html-warn (&rest warning) 
     83  "Generate a warning on the console and write the warning into the 
     84currently generated XHTML output as a comment." 
    8385  `(progn 
    8486    (html (:princ-safe (format nil "<!-- ~a -->~%" (format nil ,@warning))))