going back to previous directory structure, or rather, a similar one, so that it's simple to load the stuff in dragonfly-framework. the other way, though better organized, makes it difficult to know where the dragonfly-framework is without forcing the user to manually enter it in

--HG--
rename : dragonfly/README.txt => CHANGES
rename : site/databases/blog.nldb => databases/blog.nldb
rename : site/databases/main.sqlite => databases/main.sqlite
rename : dragonfly/.htaccess => dragonfly-framework/.htaccess
rename : dragonfly/config/dragonfly_config.lsp => dragonfly-framework/config/dragonfly_config.lsp
rename : dragonfly/config/dragonfly_routes.lsp => dragonfly-framework/config/dragonfly_routes.lsp
rename : dragonfly/docs/dragonfly.lsp.html => dragonfly-framework/docs/dragonfly.lsp.html
rename : dragonfly/docs/dragonfly.lsp.src.html => dragonfly-framework/docs/dragonfly.lsp.src.html
rename : dragonfly/docs/index.html => dragonfly-framework/docs/index.html
rename : dragonfly/dragonfly.lsp => dragonfly-framework/dragonfly.lsp
rename : site/favicon.ico => favicon.ico
rename : site/includes/css/forms.css => includes/css/forms.css
rename : site/includes/css/screen.css => includes/css/screen.css
rename : site/includes/css/twitter.css => includes/css/twitter.css
rename : site/includes/images/houses.jpg => includes/images/houses.jpg
rename : site/includes/images/logo.pxm => includes/images/logo.pxm
rename : site/includes/images/marchildmann-com.gif => includes/images/marchildmann-com.gif
rename : site/includes/images/tip-pimped.gif => includes/images/tip-pimped.gif
rename : site/includes/images/tip-rounded.gif => includes/images/tip-rounded.gif
rename : site/includes/images/tip.gif => includes/images/tip.gif
rename : site/includes/js/dragonfly.js => includes/js/dragonfly.js
rename : site/index.cgi => index.cgi
rename : site/views/404 => views/404
rename : site/views/blog => views/blog
rename : site/views/dragonfly_ajax => views/dragonfly_ajax
rename : site/views/dragonfly_ajax-date => views/dragonfly_ajax-date
rename : site/views/dragonfly_ajax-twitter => views/dragonfly_ajax-twitter
rename : site/views/dragonfly_debug => views/dragonfly_debug
rename : site/views/dragonfly_rssfeed => views/dragonfly_rssfeed
rename : site/views/dragonfly_seo => views/dragonfly_seo
rename : site/views/dragonfly_tables => views/dragonfly_tables
rename : site/views/dragonfly_twitter => views/dragonfly_twitter
rename : site/views/dragonfly_welcome => views/dragonfly_welcome
rename : site/views/partials/doctype => views/partials/doctype
rename : site/views/partials/footer => views/partials/footer
rename : site/views/partials/header => views/partials/header
rename : site/views/partials/navigation => views/partials/navigation

Author: taoeffect

dragonfly/README.txt renamed to CHANGES

@@ -4,6 +4,9 @@
 
 (context 'Dragonfly)
 
+; location of newlisp shared directory (for module support)
+(constant 'newlisp-dir "/usr/share/newlisp")
+
 ; setting a defaultview
 (constant 'defaultview "dragonfly_welcome")
 ; setting a defaultaction

site/databases/blog.nldb renamed to databases/blog.nldb

@@ -46,9 +46,9 @@
 (constant 'http-400 "Status: 400 Bad Request\r\n")
 (constant 'http-401 "Status: 401 Unauthorized\r\n")
 (constant 'http-403 "Status: 403 Forbidden\r\n")
-(constant 'http-404 "Status: Not Found\r\n")
-(constant 'http-410 "Status: Gone\r\n")
-(constant 'http-500 "Status: Internal Server Error\r\n")
+(constant 'http-404 "Status: 404 Not Found\r\n")
+(constant 'http-410 "Status: 410 Gone\r\n")
+(constant 'http-500 "Status: 500 Internal Server Error\r\n")
 
 (constant 'http-html-header "Content-Type: text/html; charset=utf-8\r\nConnection: keep-alive\r\n")
 (constant 'http-xml-header "Content-Type: text/xml; charset=utf-8\r\nConnection: keep-alive\r\n")
@@ -336,9 +336,7 @@
 ;; <p>Evaluates the partial and returns it.</p>
 ;; 
 (define (partial partialname)
-	(set 'path-to-partials partials-path)	
-  	(push partialname path-to-partials -1)
-  	(Web:eval-template (read-file path-to-partials))
+  	(Web:eval-template (read-file (append partials-path partialname)))
 )
 
 ;; @syntax (Dragonfly:title <websitename>)

site/databases/main.sqlite renamed to databases/main.sqlite

@@ -0,0 +1,187 @@
+;;; Note: POST data can only be read once, after which it becomes unavailable
+;;; to future parts of the program.  Should the default cgi.lsp module precede
+;;; this module, POST data will be unavailable through the Request class.  If
+;;; cgi.lsp is loaded after this module, POST data is unavailable to it.
+
+;;; This module does not include output functions, including setting cookies.
+;;; That will be part of the Response class.  The Response class may also
+;;; include a session framework; any session data will be available through this
+;;; class (once designed).
+
+(context MAIN)
+
+; globals must be delcared in MAIN context
+(unless (number? *max-post-length*)
+	(set '*max-post-length* 1002537))
+
+(global '*max-post-length*)
+
+(context 'Request)
+
+;; mark Public API
+
+(define (method)		_method)
+(define (segments)		_segments)
+(define (raw-query)		_rawQuery)
+(define (post-length)   _postLength)
+(define (binary?)       _binaryData)
+(define (get?)			(= _method 'GET))
+(define (post?)			(= _method 'POST))
+(define (cookie? key)	(lookup key _cookies))
+
+(define (get key)
+	(if key
+		(lookup key _get)
+		_get
+	)
+)
+
+(define (post key)
+	(if key
+		(lookup key _post)
+		_post
+	)
+)
+
+(define (cookies key)
+	(if key
+		(lookup key _cookies)
+		_cookies
+	)
+)
+
+(define (segment num)
+	(if-not (>= _current-segment (- (length _segments) 1))
+		(nth (if num num (inc _current-segment)) _segments)
+		(begin (set '_current-segment -1) nil) ; reset current_segment and return nil
+	)
+)
+
+;; mark Private API
+
+;; (url-translate "What+time+is+it%3f")  => "What time is it?"
+(define (url-translate str)
+   (replace "+" str " ")
+   (replace "%([0-9A-F][0-9A-F])" str (format "%c" (int (append "0x" $1))) 1)
+)
+
+(define (parse-query query-string , (params '()) pair)
+	(dolist (element (parse query-string "&"))
+		(set 'pair (parse element "="))
+		(if (= 1 (length pair))
+			(push nil pair -1)
+			(setf (pair 1) (url-translate (last pair)))
+		)
+		(push pair params -1)
+	)
+	params
+)
+
+(define (regex-captcha regex-str str (options 0) (captcha 1))
+	(if (regex regex-str str options)
+		($ captcha)
+	)
+)
+
+(define (parse-multipart-chunk chunk boundary-len, idx disp var val data (params '()))
+	(set 'idx (find "Content-Disposition" chunk))
+	
+	(when idx
+		(set 'chunk (idx (length chunk) chunk))
+		(set 'disp (0 (find "\r\n" chunk) chunk))
+		
+		(when disp
+			(set 'var (regex-captcha {name="(.*)"} disp 512))
+		
+			(when var
+				(set 'data ((+ 4 (find "\r\n\r\n" chunk)) (length chunk) chunk))
+				(set 'idx (find "\r\n--" data))
+			
+				(when idx
+					(set 'data (0 idx data))
+			
+					(if (set 'val (regex-captcha (string var {="(.*)"}) disp 512))
+						(begin
+							(push (list var val) params -1)
+							(push (list (append var "_data") data) params -1)
+							(push (list (append var "_length") (length data)) params -1)
+						)
+						(push (list var data) params -1)
+					)
+				)
+			)
+		)
+	)
+	params
+)
+
+(define (parse-multipart-query , buff bytes-read boundary-len (params '()))
+	(set 'boundary (regex-captcha {boundary=(.*)} contentType))
+	(set 'boundary-len (length boundary))
+	(set '_postLength 0)
+	
+	(while (set 'bytes-read (read-buffer (device) post-data *max-post-length* boundary))
+		(inc _postLength bytes-read)
+		(write-buffer _rawQuery post-data)
+		(dolist (param (parse-multipart-chunk post-data boundary-len))
+			(push param params -1)
+		)
+	)
+	params
+)
+
+;; mark Go!
+
+; (set '_cgi-keys '("REDIRECT_STATUS" "HTTP_HOST" "HTTP_USER_AGENT" "HTTP_ACCEPT"
+; 	"HTTP_ACCEPT_LANGUAGE" "HTTP_ACCEPT_ENCODING" "HTTP_ACCEPT_CHARSET"
+; 	"HTTP_KEEP_ALIVE" "HTTP_CONNECTION" "HTTP_COOKIE" "HTTP_CACHE_CONTROL" "PATH"
+; 	"SERVER_SIGNATURE" "SERVER_SOFTWARE" "SERVER_NAME" "SERVER_ADDR" "SERVER_PORT"
+; 	"REMOTE_ADDR" "DOCUMENT_ROOT" "SERVER_ADMIN" "SCRIPT_FILENAME" "REMOTE_PORT"
+; 	"REDIRECT_URL" "GATEWAY_INTERFACE" "SERVER_PROTOCOL" "REQUEST_METHOD"
+; 	"QUERY_STRING" "REQUEST_URI" "SCRIPT_NAME" "PATH_INFO" "PATH_TRANSLATED")
+; )
+;; this shit isn't necessary, just use (env) ====== NO! it could return nil! which is not a string!
+;; set cleaned CGI environment parameters
+
+; TODO: unset this, but make it simply create the variables instead (e.g. (set 'REQUEST_URI (env "REQUEST_URI")))
+; (set '_cgi-env (map (fn (key) (list key (trim (string (env key))))) _cgi-keys))
+
+(set '_cookies '() '_post '() '_rawQuery "")
+(set '_method 'GET) ; set default method
+(set '_segments (parse (trim (env "REQUEST_URI") "/") "/"))
+(set '_current-segment -1)
+(set 'path (env "REQUEST_URI"))
+(set 'domain (env "HTTP_HOST"))
+(set 'contentType (string (env "CONTENT_TYPE")))
+(set '_binaryData (and contentType (not (or (starts-with contentType "text" 1) (find "form" contentType 1)))))
+
+;; deal with GET params from QUERY_STRING
+(set '_rawQuery (env "QUERY_STRING"))
+(set '_get (parse-query _rawQuery))
+
+
+;; deal with POST params from stdin data
+
+(if (starts-with contentType "multipart/form" nil)
+	(begin
+		(set '_method 'POST)
+		(set '_post (parse-multipart-query))
+	)
+	(begin
+		(set '_postLength (read-buffer (device) post-data *max-post-length*))
+		(when post-data
+			(set '_method 'POST)
+			(if-not _binaryData
+				(set '_post (parse-query post-data))
+			)
+			(set '_rawQuery post-data)
+		)
+	)
+)
+
+;; deal with HTTP_COOKIE data
+(dolist (element (parse (string (env "HTTP_COOKIE")) ";"))
+	(push (parse element "=") _cookies -1)
+)
+
+(context MAIN)

dragonfly/.htaccess renamed to dragonfly-framework/.htaccess

@@ -0,0 +1,122 @@
+(context 'Response)
+
+;; mark Public API
+
+(define (Response:Response str)
+	(_response 200 str)
+)
+
+(define (redirect path)
+	(header "Location" path)
+	(_response 302)
+)
+
+(define (not-found str)
+	(_response 404 str)
+)
+
+(define (error str)
+	(_response 500 str)
+)
+
+;; mark Headers
+
+;; add the header with key and associated value to the list of headers
+;; replaces the old value if key is already in there
+(define (header key val)
+	(set 'key (join (map title-case (parse key "-")) "-"))
+	(if (member key _headers)
+    	(setf (assoc key _headers) (list key val))
+    	(push (list key val) _headers)
+	)
+)
+
+(define (header? key)
+	(lookup key _headers)
+)
+
+(define (headers)
+	_headers
+)
+
+
+;; mark Cookies
+
+(define (set-cookie key value domain path expires)
+	(if (cookie-set? key '? domain path)
+		(delete-cookie key domain path)
+	)
+	(push (list key value domain path expires) _cookies -1)
+)
+
+
+;; needs to check for set cookies in _cookies and remove
+(define (delete-cookie key domain path)
+	(if (cookie-set? key '? domain path)
+		(pop _cookies (find (list key '? domain path '?) _cookies match))
+		(set-cookie key nil domain path (date-value))
+	)
+)
+
+; NOTE: bug fixed: definition was (cookie-set? key domain path)
+(define (cookie-set? key value domain path)
+	(true? (find (list key value domain path '?) _cookies match))
+)
+
+;; mark Private API
+
+; returns a string version ready for sending to browser of the cookie
+(define (_format-cookie key value domain path expires)
+	;; expires must be timestamp (use date-value)
+	(set 'value (if value (string value) ""))
+	(let (cookie "")
+		(write-buffer cookie (format "%s=%s" key value))
+		(if expires (write-buffer cookie (format "; expires=%s" (date (int expires) 0 "%a, %d %b %Y %H:%M:%S %Z"))))
+		(if path (write-buffer cookie (format "; path=%s" path)))
+		(if domain (write-buffer cookie (format "; domain=%s" domain)))
+		cookie
+	)
+)
+
+; hack to get it work on both newlisp and apache because of bug in newlisp
+(define (print-header code , header)
+	; (if (find "newLISP" (env "SERVER_SOFTWARE"))
+	; 	(println "HTTP/1.0 " code " " (lookup code _response-codes) "\r\n")
+	; 	(println "Status: " code " " (lookup code _response-codes) "\r\n")
+	; )
+	
+	(print "Status: " code " " (lookup code _response-codes) "\r\n")
+	
+	; (set 'header (string code " " (lookup code _response-codes)))
+	; (set '$status-header (append "HTTP/1.0 " header "\r\n")) ; for newlisp
+	; (println "Status: " header)
+)
+
+;; http://en.kioskea.net/contents/internet/http.php3
+;; http://hoohoo.ncsa.uiuc.edu/cgi/out.html
+
+;; NOTE: completely changed
+(define (_response code content)
+	; (print-header code)
+	(print "Status: " code " " (lookup code _response-codes) "\r\n")
+	(dolist (hdrs _headers) (print (hdrs 0) ": " (hdrs 1) "\r\n"))
+	(dolist (cookie _cookies) (print "Set-Cookie: " (apply _format-cookie cookie) "\r\n"))
+	(print "Content-type: " _content-type "\r\n\r\n")
+	(print (string content))
+	(exit)
+)
+
+;; mark Private variables
+
+(set '_response-codes
+  '((200 "OK")
+	(302 "Found")
+    (404 "Not Found")
+    (500 "Internal Error"))
+)
+
+(set '_content-type "text/html; charset=utf-8")
+(set '_headers '())
+(set '_cookies '())
+
+(context MAIN)

dragonfly/config/dragonfly_config.lsp renamed to dragonfly-framework/config/dragonfly_config.lsp

@@ -0,0 +1,49 @@
+;; NOTE: it's OK to load this file multiple times
+
+;;  Copyright (C) <2009> <Greg Slepak>
+;;
+;;  This program is free software: you can redistribute it and/or modify
+;;  it under the terms of the GNU General Public License as published by
+;;  the Free Software Foundation, either version 3 of the License, or
+;;  (at your option) any later version.
+;;
+;;  This program is distributed in the hope that it will be useful,
+;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;  GNU General Public License for more details.
+;;  You should have received a copy of the GNU General Public License
+;;  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; @module Dragonfly
+;; @author Greg Slepak <greg at taoeffect.com>
+
+(context 'Dragonfly)
+
+(define (load-once)
+	; check if the last argument is a context (to behave like 'load' does)
+	(let (ctx (let (_ctx (last $args)) (if (context? _ctx) _ctx MAIN)))
+		(doargs (file)
+			(unless (or (context? file) (find file _loaded))
+				(push file _loaded)
+				(Dragonfly:saved-load file ctx)
+			)
+		)
+	)
+)
+
+; We define our own module function so that we can easily support
+; shared hosting services where the modules directory might not be
+; in /usr/share/newlisp/modules.
+(define (module module-to-load)
+	(if-not newlisp-dir (throw-error "need value 'newlisp-dir' from dragonfly_config.lsp!"))
+	(load-once (append newlisp-dir "/modules/" module-to-load))
+)
+
+(context 'MAIN)
+
+; swap the MAIN functions for ours
+(unless Dragonfly:saved-load
+	(constant 'Dragonfly:saved-load MAIN:load)
+	(constant 'MAIN:load Dragonfly:load-once)
+	(constant 'MAIN:module Dragonfly:module)
+)