diff -rN -u old-ucw-core/src/backend/mod-lisp.lisp new-ucw-core/src/backend/mod-lisp.lisp --- old-ucw-core/src/backend/mod-lisp.lisp 2009-04-20 22:12:37.859555000 +0200 +++ new-ucw-core/src/backend/mod-lisp.lisp 2009-04-20 22:12:37.887556750 +0200 @@ -1,6 +1,6 @@ ;; -*- lisp -*- -(in-package :it.bese.ucw) +(in-package :it.bese.ucw.core) ;;;; ** The mod_lisp backend @@ -42,7 +42,23 @@ :iso-8859-1))) (when (string= key "remote-ip-addr") ;; TODO parse ip address from string, see ip-address type - (setf (remote-address request) value)) + (setf (remote-address request) + (let ((ip-as-string value)) + (when ip-as-string + (let* ((real-remote-address (first (cl-ppcre:split "," ip-as-string :sharedp t))) + (pieces (cl-ppcre:split "\\." real-remote-address :sharedp t))) + (declare (type list pieces)) + (if (= (length pieces) 4) + (iter (with result = (make-array 4 :element-type '(unsigned-byte 8))) + (for idx :from 0 :below 4) + (for ip-address-part = (parse-integer (pop pieces))) + (assert (<= 0 ip-address-part 255)) + (setf (aref result idx) ip-address-part) + (finally (return result))) + (progn + (ucw.backend.info "Returning NIL instead of an invalid ip address: ~S" ip-as-string) + nil))))) + )) (when (string= key "url") (setf (raw-uri request) value) (aif (position #\? value) diff -rN -u old-ucw-core/src/ucw-tal/tal-package.lisp new-ucw-core/src/ucw-tal/tal-package.lisp --- old-ucw-core/src/ucw-tal/tal-package.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-ucw-core/src/ucw-tal/tal-package.lisp 2009-04-20 22:12:37.883556500 +0200 @@ -0,0 +1,10 @@ +(in-package #:common-lisp-user) + +(defpackage #:ucw-tal + (:use :ucw-core :cl :yaclml :arnesi) + (:shadowing-import-from :ucw-core :parent) + (:export + #:application-with-tal-support-mixin + #:template-component + #:render-template)) + diff -rN -u old-ucw-core/src/ucw-tal/template.lisp new-ucw-core/src/ucw-tal/template.lisp --- old-ucw-core/src/ucw-tal/template.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-ucw-core/src/ucw-tal/template.lisp 2009-04-20 22:12:37.883556500 +0200 @@ -0,0 +1,107 @@ +;; -*- lisp -*- + +(in-package :ucw-tal) + +(defclass application-with-tal-support-mixin (application) + ((tal-generator :accessor application.tal-generator + :initarg :tal-generator + :documentation "A tal-generator object used to +lookup and compile tal pages for template-components."))) + +;;;; ** Template + +(defclass template-component (component) + ((template-name :accessor template-component.template-name + :initarg :template-name + :initform nil)) + (:documentation "Component which is rendered via a TAL template.")) + +(defgeneric template-component-environment (component) + (:documentation "Create the TAL environment for rendering COMPONENT's template. + +Methods defined on this generic function must return a TAL +environment: a list of TAL binding sets (see the documentation +for YACLML:MAKE-STANDARD-TAL-ENVIRONMENT for details on TAL +environments.)") + (:method-combination nconc)) + +(defmethod template-component-environment nconc ((component template-component)) + "Create the basic TAL environment. + +Binds the symbol ucw:component to the component object itself, +also puts the object COMPONENT on the environment (after the +binding of ucw:component) so that slots are, by default, +visable." + (make-standard-tal-environment `((component . ,component)) component)) + +(defmethod render :around ((component template-component)) + "Render a template based component. + +The name of the template is the value returned by the generic function +TEMPLATE-COMPONENT.TEMPLATE-NAME, the template will be rendered +in the environment returned by the generic function +TEMPLATE-COMPONENT-ENVIRONMENT." + (aif (template-component.template-name component) + (render-template *context* + it + (list* `((next-method-of-render . ,#'call-next-method)) + (template-component-environment component))) + (call-next-method))) + +(defcomponent standard-template-component (simple-template-component + widget-component) + ()) + +(defcomponent standard-template-component-with-body (standard-template-component + component-body-mixin) + ()) + +(defcomponent simple-template-component (template-component) + ((environment :initarg :environment :initform nil))) + +(defcomponent simple-template-component-with-body (simple-template-component component-body-mixin) + ()) + +(defmethod template-component-environment nconc ((component simple-template-component)) + (copy-list (slot-value component 'environment))) + +;; TODO these should be moved somewhere, renamed, or deleted completly +(defmacro show (page-name &rest environment) + `(call 'simple-template-component + :template-name ,page-name + :environment (tal-env ,@environment))) + +(defmacro show-window (page-name &rest environment) + `(call 'basic-window-template-component + :template-name ,page-name + :environment (tal-env ,@environment))) + +;; Copyright (c) 2003-2005 Edward Marco Baringer +;; All rights reserved. +;; +;; Redistribution and use in source and binary forms, with or without +;; modification, are permitted provided that the following conditions are +;; met: +;; +;; - Redistributions of source code must retain the above copyright +;; notice, this list of conditions and the following disclaimer. +;; +;; - Redistributions in binary form must reproduce the above copyright +;; notice, this list of conditions and the following disclaimer in the +;; documentation and/or other materials provided with the distribution. +;; +;; - Neither the name of Edward Marco Baringer, nor BESE, nor the names +;; of its contributors may be used to endorse or promote products +;; derived from this software without specific prior written permission. +;; +;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff -rN -u old-ucw-core/src/ucw-tal/yaclml.lisp new-ucw-core/src/ucw-tal/yaclml.lisp --- old-ucw-core/src/ucw-tal/yaclml.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-ucw-core/src/ucw-tal/yaclml.lisp 2009-04-20 22:12:37.883556500 +0200 @@ -0,0 +1,99 @@ +;;;; -*- lisp -*- + +(in-package :ucw-tal) + +(defmethod render-template ((context request-context) template-name environment) + (let ((*print-pretty* nil)) + (it.bese.ucw.core::ucw.component.render.dribble ;;it.bese.ucw.core::ucw.rerl.info + "Rendering template ~S in environment ~S" template-name environment)) + (if-bind generator + (application.tal-generator (context.application context)) + (if-bind truename + (template-truename generator template-name) + (%render-template context generator truename environment) + (progn + (cerror "Retry rendering the template." "Can't find a template named ~S." template-name) + (render-template context template-name environment))) + (error "No known generator for the current application."))) + +(defun %render-template (context generator truename environment) + (let ((yaclml:*uri-to-package* (cons (cons "http://common-lisp.net/project/ucw/core" + (find-package :it.bese.ucw.tags)) + yaclml:*uri-to-package*))) + (restart-case + (funcall (load-tal generator truename) environment generator) + (retry () + :report (lambda (stream) + (format stream "Retry rendering ~A." truename)) + (return-from %render-template (%render-template context generator truename environment))))) + (it.bese.ucw.core::ucw.component.render.dribble "Template rendered.")) + +(defmethod preprocess-template (template-name environment &optional (application *default-application*)) + (aif (application.tal-generator application) + (if-bind truename (template-truename it template-name) + (let ((yaclml:*uri-to-package* (cons (cons "http://common-lisp.net/project/ucw/core" + (find-package :it.bese.ucw.tags)) + yaclml:*uri-to-package*))) + (yaclml::preprocess-tal it truename)) + (progn + (cerror "Retry rendering the template." "Can't find a template named ~S." template-name) + (render-template *context* template-name environment))) + (error "No known generator for the current application."))) + +;; TODO unused, delme? +(defun add-session-id (url) + "Add a session-id parametet to URL unless one is already present." + (when (position #\# url) + (error "Can't handle ~S. + +Adding session ids to links with section parts is not yet supported." + url)) + (flet ((already-have-session-id () + (let ((param-name-offset (search +session-parameter-name+ url))) + (if param-name-offset + (let ((=-offset (+ param-name-offset + (length +session-parameter-name+)))) + (and (< =-offset (length url)) + (char= #\= (aref url =-offset)))) + nil)))) + (if (already-have-session-id) + url + (with-output-to-string (new-url) + (write-sequence url new-url) + (if (position #\? url) + (write-char #\& new-url) + (write-char #\? new-url)) + (write-sequence +session-parameter-name+ new-url) + (write-char #\= new-url) + (write-sequence (session.id (context.session *context*)) new-url))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 2003-2005 Edward Marco Baringer +;;; All rights reserved. +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions are +;;; met: +;;; +;;; - Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; +;;; - Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. +;;; +;;; - Neither the name of Edward Marco Baringer, nor BESE, nor the names +;;; of its contributors may be used to endorse or promote products +;;; derived from this software without specific prior written permission. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff -rN -u old-ucw-core/ucw.asd new-ucw-core/ucw.asd --- old-ucw-core/ucw.asd 2009-04-20 22:12:37.875556000 +0200 +++ new-ucw-core/ucw.asd 2009-04-20 22:12:37.915558500 +0200 @@ -43,5 +43,23 @@ :properties ((version "0.9")) :depends-on (:ucw-core :cl-ppcre :cl-mime)) +(defsystem* :ucw-tal + :description "UncommonWeb : Tal Components" + :long-description "Contains the tal template extension." + :author "Marco Baringer " + :maintainer "Drew Crampsie " + :licence "BSD (sans advertising clause)" + :version "0.9" + :class ucw-system + :components + ((:module :src + :components + ((:module :ucw-tal + :components ((:file "tal-package") + (:file "template" :depends-on ("tal-package")) + (:file "yaclml" :depends-on ("template"))))))) + :properties ((version "0.9")) + :depends-on (:ucw)) +