Commits

Greg Slepak  committed 96c873d

bunch of changes towards 0.50

  • Participants
  • Parent commits 5367d68

Comments (0)

Files changed (38)

 Version 0.19
 
   * modified Dragonfly:view; now it displays an error view if a file is not found
-  * moved the constant "default404" into dragonfly_config.lsp
+  * moved the constant "DEFAULT404" into dragonfly_config.lsp
   * added the function autoload-css; this function checks automatically for an iPhone and loads a different stylesheet
 
 
   * removed the directory "actions" (it's now obsolet)
   * renamed the directory "templates" into "views"
   * renamed the function "Dragonfly:template" into "Dragonfly:view"
-  * added the constants "defaultview" and "defaultaction"
-  * added the constants "views-path" and "partials-path"
+  * added the constants "DEFAULTVIEW" and "DEFAULTACTION"
+  * added the constants "VIEWS_PATH" and "PARTIALS_PATH"
   * added an improved version of Dragonfly:listener contributed by cormullion
   * modified the .htaccess (also contributed by cormullion)
-  * improved the link_to function - it automatically checks if it can use .htaccess or not; it also uses the defaultaction now
+  * improved the link_to function - it automatically checks if it can use .htaccess or not; it also uses the DEFAULTACTION now
 
 Version 0.13
 
  = Step 2 - Configure Dragonfly =
  ================================
 
-Edit the 'dragonfly_config.lsp' file in dragonfly-framework/config/dragonfly_config.lsp
+Edit the 'config.lsp' file in dragonfly-framework.
 
 Read through the comments (they begin with a semi-colon) for instructions on
 what the settings are for.
 Congratulations on choosing Dragonfly!
 
-Start this application on your localhost OS X
-newlisp -http -d PORT -w /Users/USERNAME/Sites/DIRECTORY &
+'cd' into the example-site folder and run this command:
+
+	newlisp -d 8080 -w . -http
 
 Open Your browser and type localhost:8080 - have FUN!

File UPGRADE_GUIDE

+This file contains information on what to watch out for when upgrading
+from one version of dragonfly to another.
+---------------------------------------------------------------
+
+From 0.2 or earlier to 0.5:
+
+* Enforcing variable naming conventions:
+	1) Constants are CAPITALIZED and use the '_' to separate words
+	2) Variables are lowercase and use the '-' to separate words
+
+Examples:
+	find 'documentroot' replace with 'DOCUMENT_ROOT'
+	find 'dragonfly_version' replace with 'DRAGONFLY_VERSION'
+	
+Purpose:
+	This is done so that it's clear which parts of Dragonfly
+	are user-customizable and which are not, and to make naming
+	conflicts more difficult.
+	
+* To avoid having too many constants all over the place, possibly
+  causing confusion and conflicts with other similarly named variables,
+  and to avoid cluttering the code, all environment variables have simply
+  been placed into the PHP-like env map. Some constants still
+  exist, namely those starting with 'dragonfly'
+
+	Dragonfly:host => (env "HTTP_HOST")
+	Dragonfly:useragent => (env "HTTP_USER_AGENT")
+	Dragonfly:server => (env "SERVER_SOFTWARE")
+	Dragonfly:programfiles => (env "PROGRAMFILES")
+	Dragonfly:proxy => (env "HTTP_PROXY")	
+
+	You can also use the new PHP-like symbol $SERVER instead of env.
+	
+	Example: ($SERVER "HTTP_HOST")

File example-site/.htaccess

 AddDefaultCharset UTF-8
 Options -Indexes +FollowSymLinks
 
+# Prevent source from being accessed
+<Files ~ "\.lsp$">
+Order allow,deny
+Deny from all
+</Files>
+
 <IfModule mod_rewrite.c>
 RewriteEngine on
 RewriteBase /
 
-RewriteCond %{REQUEST_FILENAME} !-f
 RewriteCond %{REQUEST_FILENAME} !-d
 RewriteCond %{REQUEST_FILENAME} !-l
+RewriteCond %{REQUEST_FILENAME} !-f [OR]
+
+# if don't want Dragonfly to process html files comment
+# out the line below (you may need to remove the [OR] above too).
+RewriteCond %{REQUEST_FILENAME} \.html$
 
 # Main URL rewriting.
-RewriteRule ^(.*)$ index.cgi?$1 [L,QSA]
-</IfModule>
+RewriteRule (.*) index.cgi?$1 [L,QSA]
+
+</IfModule>

File example-site/databases/blog.nldb

-(set 'nldb:tables '(entries))
+(set 'nldb:tables '(Dragonfly:entries))
 
-(set 'entries '(
-  	(ID Headline Date Text Author) 
+(set 'Dragonfly:entries '(
+  	(Dragonfly:ID Dragonfly:Headline Dragonfly:Date Dragonfly:Text Dragonfly:Author) 
 
   	("1" "Hello World - Do You remember me?" "Donnerstag/Thursday &mdash; 30.07.2009 &mdash; 20:20" "After some experiments and a lot of time I finally decided to blog again. About newLISP and fun with programming, my own framework Dragonfly and some photographs I like.<br/><br/>" "Marc Hildmann") 
   	("2" "Eingew&ouml;hnen - Future home" "Freitag/Friday &mdash; 31.07.2009 &mdash; 20:57" "Erste Gehversuche mit NearlyFreeSpeech.net. Schlichte, aber sehr durchdachte Oberfl&auml;che. Das wird wohl das neue Zuhause.</p><br/><p>First steps with NearlyFreeSpeech.net. I like their simple, but effective user interface. Seems to be the new home, so I just ordered marchildmann.com" "Marc Hildmann") 

File example-site/dragonfly-framework/config.lsp

+; do not modify the line below
+(dolist (pair (env)) (constant (global (sym (first pair))) (last pair)))
+
+;===============================================================================
+; Global Constants
+;===============================================================================
+
+; docroot (also site root, usually doesn't need modification)
+(constant (global 'DOCUMENT_ROOT) (env "DOCUMENT_ROOT"))
+; dragonfly root
+(constant (global 'DRAGONFLY_ROOT) (string DOCUMENT_ROOT "/dragonfly-framework"))
+; sync any customization of DOCUMENT_ROOT with the 'env'
+; don't modify this line
+(env "DOCUMENT_ROOT" DOCUMENT_ROOT)
+
+(context 'Dragonfly)
+
+;===============================================================================
+; Logging
+;===============================================================================
+
+; One of 'LOG_DEBUG, 'LOG_INFO, 'LOG_WARN, and 'LOG_ERROR
+(constant 'LOG_LEVEL 'LOG_DEBUG)
+; the location of the logfile
+(constant 'LOG_FILE_PATH (string DRAGONFLY_ROOT "/dragonfly.log"))
+
+;===============================================================================
+; Filtering of static files (for .php-like behavior)
+;===============================================================================
+
+; if you set to nil then make sure to comment out the line in .htaccess
+(constant 'ENABLE_STATIC_TEMPLATES true)
+; extension that triggers the handler (must match the one in .htaccess)
+(constant 'TEMPLATE_EXTENSION ".html")
+
+;===============================================================================
+; Views
+;===============================================================================
+
+; set to nil to disable views handling
+(constant 'ENABLE_VIEW_HANDLER true)
+; location of views
+(constant 'VIEWS_PATH (string DOCUMENT_ROOT "/views"))
+; location of partials
+(constant 'PARTIALS_PATH (string DOCUMENT_ROOT "/views/partials"))
+; setting a default view
+(constant 'DEFAULTVIEW "dragonfly_welcome")
+; setting a default action
+(constant 'DEFAULTACTION "index") ; display all
+; setting a default rss view
+(constant 'DEFAULTRSS "dragonfly_rssfeed")
+; setting a 404 view
+(constant 'DEFAULT404 "404")
+
+;===============================================================================
+; RESTful Resources
+;===============================================================================
+
+; set to nil to disable REST handling
+(constant 'ENABLE_RESTFUL_HANDLER true)
+; location of RESTful resources (relative to DOCUMENT_ROOT)
+(constant 'RESTFUL_DIR "resources")
+
+; define any RESTful resources (just the root, i.e. the first slash)
+; note that to allow runtime modification this is not a constant
+(define restful-resources '(
+	"create"
+	"show"
+	"edit"
+	"update"
+	"remove"
+))
+
+(context MAIN)

File example-site/dragonfly-framework/config/dragonfly_config.lsp

-(context 'Dragonfly)
-
-; location of newlisp shared directory (for module support)
-(constant 'newlisp-dir "/usr/share/newlisp")
-
-; location of RESTful resources (relative to DOCUMENT_ROOT)
-(constant 'restful-dir "views")
-
-
-; setting a defaultview
-(constant 'defaultview "dragonfly_welcome")
-; setting a defaultaction
-(constant 'defaultaction "index") ; display all
-; setting a default rss view
-(constant 'defaultrss "dragonfly_rssfeed")
-
-; setting a 404 view
-(constant 'default404 "404")
-
-
-(context Dragonfly)

File example-site/dragonfly-framework/config/dragonfly_routes.lsp

-(context 'Dragonfly)
-
-; setting up some RESTful like definitions
-(constant 'create "create") ; return form for creating
-(constant 'show "show") ; show specific
-(constant 'edit "edit") ; return form for editing
-(constant 'update "update") ; update specific
-(constant 'remove "remove") ; delete specific
-
-
-(context Dragonfly)

File example-site/dragonfly-framework/docs/dragonfly.lsp.src.html

 <font color='#AA0000'>(</font><font color='#0000AA'>context</font> 'Dragonfly<font color='#AA0000'>)</font>
 
 <font color='#555555'>;; set constants for Dragonfly</font>
-<font color='#AA0000'>(</font><font color='#0000AA'>constant</font> 'documentroot <font color='#AA0000'>(</font><font color='#0000AA'>env</font> <font color='#008800'>"DOCUMENT_ROOT"</font><font color='#AA0000'>)</font><font color='#AA0000'>)</font>
+<font color='#AA0000'>(</font><font color='#0000AA'>constant</font> 'DOCUMENT_ROOT <font color='#AA0000'>(</font><font color='#0000AA'>env</font> <font color='#008800'>"DOCUMENT_ROOT"</font><font color='#AA0000'>)</font><font color='#AA0000'>)</font>
 <font color='#AA0000'>(</font><font color='#0000AA'>constant</font> 'host <font color='#AA0000'>(</font><font color='#0000AA'>env</font> <font color='#008800'>"HTTP_HOST"</font><font color='#AA0000'>)</font><font color='#AA0000'>)</font>
 <font color='#AA0000'>(</font><font color='#0000AA'>constant</font> 'useragent <font color='#AA0000'>(</font><font color='#0000AA'>env</font> <font color='#008800'>"HTTP_USER_AGENT"</font><font color='#AA0000'>)</font><font color='#AA0000'>)</font>
 <font color='#AA0000'>(</font><font color='#0000AA'>constant</font> 'server <font color='#AA0000'>(</font><font color='#0000AA'>env</font> <font color='#008800'>"SERVER_SOFTWARE"</font><font color='#AA0000'>)</font><font color='#AA0000'>)</font>
 	&lt;div id='dragonfly_debug' style='border:1px dotted #00aeef<font color='#555555'>; width:700px; padding:8px; margin-top:20px;' ></font>
 	&lt;h2&gt;Dragonfly DEBUG information&lt;/h2&gt;
 	&lt;h3&gt;HOST&lt;/h3&gt;<font color='#008800'>"host"</font>
-	&lt;h3&gt;DOCUMENT ROOT&lt;/h3&gt;<font color='#008800'>"documentroot"</font>
+	&lt;h3&gt;DOCUMENT ROOT&lt;/h3&gt;<font color='#008800'>"DOCUMENT_ROOT"</font>
 	&lt;h3&gt;Windows Programfiles&lt;/h3&gt;<font color='#008800'>"programfiles"</font>
-	&lt;h3&gt;QUERY&lt;/h3&gt;<font color='#008800'>"(env "</font>QUERY_STRING<font color='#008800'>")"</font>
+	&lt;h3&gt;QUERY&lt;/h3&gt;<font color='#008800'>"</font>QUERY_STRING<font color='#008800'>"</font>
 	&lt;h3&gt;TEMPLATENAME&lt;/h3&gt;<font color='#008800'>"templatename"</font>
 	&lt;h3&gt;ACTION&lt;/h3&gt;<font color='#008800'>"action"</font>
 	&lt;h3&gt;USER-AGENT&lt;/h3&gt;<font color='#008800'>"useragent"</font>

File example-site/dragonfly-framework/dragonfly.log

+Oct 22 02:39:17 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_tables
+Oct 22 02:39:17 [DEBUG]: Column: ID
+Oct 22 02:39:17 [ERROR]: ERR: string expected in function title-case : column_name
+called from user defined function Dragonfly:print
+called from user defined function Dragonfly:form-generate-from-columns
+called from user defined function Web:eval-template
+called from user defined function Route.View:run
+called from user defined function Dragonfly:listener
+called from user defined function run
+Oct 22 02:40:12 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_tables
+Oct 22 02:40:12 [DEBUG]: Column: ID symbol? true
+Oct 22 02:40:12 [ERROR]: ERR: string expected in function title-case : column_name
+called from user defined function Dragonfly:print
+called from user defined function Dragonfly:form-generate-from-columns
+called from user defined function Web:eval-template
+called from user defined function Route.View:run
+called from user defined function Dragonfly:listener
+called from user defined function run
+Oct 22 02:40:35 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_tables
+Oct 22 02:40:35 [DEBUG]: Column: ID symbol? true
+Oct 22 02:40:35 [ERROR]: ERR: string expected : (eval column_name)
+called from user defined function Dragonfly:print
+called from user defined function Dragonfly:form-generate-from-columns
+called from user defined function Web:eval-template
+called from user defined function Route.View:run
+called from user defined function Dragonfly:listener
+called from user defined function run
+Oct 22 02:40:48 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_tables
+Oct 22 02:40:48 [DEBUG]: Column: ID symbol? true
+Oct 22 02:40:48 [DEBUG]: Column: Headline symbol? true
+Oct 22 02:40:48 [DEBUG]: Column: Date symbol? true
+Oct 22 02:40:48 [DEBUG]: Column: Text symbol? true
+Oct 22 02:40:48 [DEBUG]: Column: Author symbol? true
+Oct 22 02:41:18 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax
+Oct 22 02:41:18 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:41:18 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:41:19 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:41:20 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:41:20 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:41:21 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:41:22 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:41:23 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:41:23 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:41:24 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:41:25 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:41:26 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:41:26 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:41:27 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:41:27 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:41:28 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:41:29 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:41:30 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:41:30 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:41:31 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_twitter
+Oct 22 02:41:38 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:42:10 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:42:22 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:45:59 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:46:00 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:46:07 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:50:51 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:50:53 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:52:08 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:55:11 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:55:20 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:55:22 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:55:26 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:55:28 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_seo
+Oct 22 02:55:47 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/blog
+Oct 22 02:55:50 [DEBUG]: Route.ALL
+Oct 22 02:55:57 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax
+Oct 22 02:55:58 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:55:58 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:55:59 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:55:59 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:56:00 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:56:01 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:56:02 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:56:02 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:56:03 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:56:04 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:56:05 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:56:05 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:56:06 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-twitter
+Oct 22 02:56:07 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_ajax-date
+Oct 22 02:56:07 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_welcome
+Oct 22 02:59:35 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_debug
+Oct 22 03:00:44 [DEBUG]: Route.ALL
+Oct 22 03:04:31 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_debug
+Oct 22 03:04:37 [DEBUG]: Route.View: /Volumes/EspionageMounts/gslepak/3117152101/Programming/Lisp/dragonfly-web-framework/example-site/views/dragonfly_debug

File example-site/dragonfly-framework/dragonfly.lsp

-;;  Copyright (C) <2009> <Marc Hildmann>
+;;  Copyright (C) <2009> <Marc Hildmann, 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
 ;;  along with this program.  If not, see <http://www.gnu.org/licenses/>.
 ;;
 ;; @module Dragonfly
-;; @author Marc Hildmann <marc.hildmann at gmail.com>
-;; @version 0.20
+;; @author Marc Hildmann <marc.hildmann at gmail.com>, Greg Slepak <greg at taoeffect.com>
+;; @version 0.50
 ;; 
 ;; @location http://code.google.com/p/dragonfly-newlisp/
 ;; @description A newLISP web framework for rapid web development
 ;; Its's features are a short learning curve, lightweight and fun in programming - 
 ;; just like newLISP itself.</p>
 
-;===============================================================================
-; !Loading modules and defining new context
-;===============================================================================
+; $SERVER is a synonym for env
+; this line at top because it must be executed in MAIN
+; for $GET, $POST, and $FILES see lib/request.lsp
+(constant (global '$SERVER) env)
+
+; DF is a shorthand to the Dragonfly context
+; so that things like log-err can be written DF:log-err
+(constant (global 'DF) Dragonfly)
 
 (context 'Dragonfly)
 
-; setting some constants for Dragonfly
-(constant 'dragonfly_version "Version 0.20")
-(constant 'host (env "HTTP_HOST"))
-(constant 'documentroot (env "DOCUMENT_ROOT"))
-(constant 'dragonfly-root (append (env "DOCUMENT_ROOT")"/dragonfly-framework"))
-(constant 'useragent (env "HTTP_USER_AGENT"))
-(constant 'server (env "SERVER_SOFTWARE"))
-(constant 'programfiles (env "PROGRAMFILES"))
-(constant 'proxy (env "HTTP_PROXY"))
+;===============================================================================
+; !Public Constants and Variables
+;===============================================================================
 
-; init HTTP Status Codes for Dragonfly listener
+; These are some of the few constants that we'll have outside of env
+(constant 'DRAGONFLY_MAJOR 0)
+(constant 'DRAGONFLY_MINOR 50)
+(constant 'DRAGONFLY_VERSION (format "Version %d.%d" DRAGONFLY_MAJOR DRAGONFLY_MINOR))
 
-(constant 'http-200 "Status: 200 OK\r\n")
-(constant 'http-301 "Status: 301 Moved Permanently\r\n")
-(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: 404 Not Found\r\n")
-(constant 'http-410 "Status: 410 Gone\r\n")
-(constant 'http-500 "Status: 500 Internal Server Error\r\n")
+; This is buffer that contains that content that will get written
+; to STDOUT if no errors are thrown. If you define your own Route
+; then you must write the results to it using 'write-buffer' instead
+; of calling 'println' or 'print' directly!
+(define STDOUT "")
 
-(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")
-(constant 'http-atom-header "Content-Type: application/atom+xml; charset=utf-8\r\nConnection: keep-alive\r\n")
+; you can customize this variable with your own routes, note
+; that you might need to clear the default routes out of it (added below)
+(define dragonfly-routes '())
 
+; make sure these two are defined
+(if-not DOCUMENT_ROOT (throw-error "Environment variable DOCUMENT_ROOT missing!"))
+(if-not QUERY_STRING (throw-error "Environment variable QUERY_STRING missing!"))
 
-; loading configuration files
-(set 'files (directory (append dragonfly-root"/config") "^[^.]")) ; show all files which do not start with a dot
-(dolist (filename files)
-	(load (append dragonfly-root"/config/"filename))
+;===============================================================================
+; !Load Libraries and Plugins
+;===============================================================================
+
+; load utils.lsp before loading anything else
+(load (string DRAGONFLY_ROOT "/lib/utils.lsp"))
+
+; next load lib, and plugins, in that order
+(load-files-in-dir (string DRAGONFLY_ROOT "/lib") "\.lsp$")
+(load-files-in-dir (string DRAGONFLY_ROOT "/plugins-active") "\.lsp$")
+;===============================================================================
+; !Setup Default Routes
+;===============================================================================
+
+; we want 3 basic routes:
+
+; 1) Basic files
+; 	- URL has an extension, assume it's a file and try to load it
+; 2) Resources
+; 	- URL begins with one of the reserved resource keywords
+; 		(i.e. create/show/update/remove)
+; 3) Views
+; 	- Anything else. Will attempt to show one of the views in /views
+; 	
+; To specify a route you'll need just two things:
+; 	- A filter function that returns true/nil
+; 	- A function that gets called if the filter returned true
+; 		it must also return true/nil which will indicate it was
+; 		to send a response or not. Note however that the function
+;		does not need to return actually, it can call (exit) if
+;		everything went fine.
+
+; switch to main prior to using define-subclass
+(context 'MAIN)
+
+; the static route is used to serve possibly templated files
+; for example, so that you can include newLISP code in .html files
+; will also handle .xml and .rss extensions
+(define-subclass (Route.Static Route)
+	((matches?)
+		; ex: .html or .html?a=4
+		(set 'file (if (empty? (set 'chunks (parse QUERY_STRING "?"))) QUERY_STRING (first chunks)))
+		(if (ends-with QUERY_STRING Dragonfly:TEMPLATE_EXTENSION)
+			(set 'content-type Response:html-type)
+			(or (ends-with QUERY_STRING ".xml") (ends-with QUERY_STRING ".rss"))
+			(set 'content-type Response:xml-type)
+		)
+	)
+	((run)
+		; pass through template TODO: make sure this is secure! no ../ bullshit!
+		(DF:log-debug "Route.Static: " file)
+		(Response:content-type content-type)
+		(Web:eval-template (read-file file))
+	)
 )
 
-; loading additional (3rd party) modules in active directory
-(set 'files (directory (append dragonfly-root"/modules-active") "^[^.]")) ; show all files which do not start with a dot
-(dolist (filename files)
-	(load (append dragonfly-root"/modules-active/"filename))
+(define-subclass (Route.Resource Route)
+	((matches?)
+		nil
+	)
+	((run)
+		; pass along to Resource
+	)
 )
 
-; loading additional Dragonfly helper modules in active directory
-(set 'files (directory (append dragonfly-root"/helpers-active") "^[^.]")) ; show all files which do not start with a dot
-(dolist (filename files)
-	(load (append dragonfly-root"/helpers-active/"filename))
+(define-subclass (Route.View Route)
+	((matches?)
+		(if (empty? QUERY_STRING)
+			(set 'viewpath (string Dragonfly:VIEWS_PATH "/" Dragonfly:DEFAULTVIEW))
+			(set 'viewpath (string Dragonfly:VIEWS_PATH "/" (first (parse QUERY_STRING "/"))))
+		)
+		(file? viewpath)
+	)
+	((run)
+		; pass through template
+		(DF:log-debug "Route.View: " viewpath)
+		(set 'Dragonfly:viewname (last (parse viewpath "/")))
+		(Web:eval-template (read-file viewpath))
+	)
 )
 
+(define-subclass (Route.ALL Route)
+	((matches?) true)
+	((run)
+		; 404 or redirect to home page?
+		; TODO: if DEFAULT404 not found then still send something
+		(DF:log-debug "Route.ALL")
+		(Web:eval-template (read-file (string Dragonfly:VIEWS_PATH "/" Dragonfly:DEFAULT404)))
+	)
+)
+
+(context 'Dragonfly)
+
+(push (Route.ALL) dragonfly-routes)
+(if ENABLE_VIEW_HANDLER (push (Route.View) dragonfly-routes))
+(if ENABLE_RESTFUL_HANDLER (push (Route.Resource) dragonfly-routes))
+(if ENABLE_STATIC_TEMPLATES (push (Route.Static) dragonfly-routes))
+
+; TODO: these either need to be deleted or moved elsewhere
 ; set the paths to views and partials
-(constant 'views-path (append documentroot"/views/"))
-(constant 'partials-path (append documentroot"/views/partials/"))
-(constant 'databases-path (append documentroot"/databases/"))
 
-; init symbols for Dragonfly listener
-(set 'viewname "")
-(set 'action "")
-(set 'params "")
-(set 'selector "")
 
 ;===============================================================================
 ; !Core Functions
 ;===============================================================================
 
-;; @syntax (Dragonfly:listener)
-;; <p>The Dragonfly listener parses the QUERY STRING
-;; for the specified view, action and params.</p>
-;;
-(define (listener)
-
-	(set 'query-list (clean empty? (parse (env "QUERY_STRING") "/|=" 0)))
-	
-	(cond		
-			
-			((ends-with query-list "xml")
-				(print http-xml-header)
-				;(print http-atom-header)
-				(print http-200)
-				(println)
-				(Dragonfly:view defaultrss))
-
-			((ends-with query-list "rss")
-				(print http-xml-header)
-				;(print http-atom-header)
-				(print http-200)
-				(println)
-				(Dragonfly:view defaultrss))
-			
-   			((empty? query-list)
-				(print http-html-header)
-				(print http-200)
-				(println)
-        		; no info at all, so just pass to default view
-       			(Dragonfly:view defaultview))
-
-   			((= (length query-list) 1)		
-
-				(print http-html-header)
-				(print http-200)
-				(println)
-        		; one argument means a selector.
-        		; pass the default view after setting selector
-       			(set 'selector (first query-list))				
-       			(Dragonfly:view defaultview))
-
-   			((> (length query-list) 1 )
-
-				(print http-html-header)
-				(print http-200)
-				(println)
-				
-      			; = 2 a view, followed by an action
-				; = 3 a view, followed by an action, followed by params
-				(map set '(viewname action params) query-list)
-       			; (println  { template: } viewname { action: } action { params: } params)
-       			; (params will be nil if length is 2)
-				
-       			(Dragonfly:view viewname))
-
-	)
+; setup our error handler
+(define (error-handler)
+	(Response:status 500)
+	(Response:content-type Response:text-type)
+	(Response:send-headers)
+	(MAIN:println (last (last-error))) ; TODO: make a nice template for this
+	;(log-err "Got error (" (last (last-error)) ") with STDOUT contents:\n{" STDOUT "}")
+	(log-err (last (last-error)))
+	(exit)
 )
 
-
-(define (listener2)
-
-	; at first get the query
-	(set 'query-list (clean empty? (parse (env "QUERY_STRING") "/|=" 0)))
-	; then map the query to view, action and params
-	(map set '(viewname action params) query-list)
-	
-	; check for all existing views ...
-	(set 'files (directory views-path "^[^.]")) ; show all files which do not start with a dot
-	; if the current view doesn't exist, then throw a 404
-
-	(print http-html-header)
-	(print http-200)
-	(println)
-	
-	(println files)
-	(exit)
-	
-	(if (nil? (find viewname files))
-		(begin
-			(print "Status: 404\r\n")
-			(println)
-			(print http-html-header)
-			(Dragonfly:view "404")
-		)
-		; else check some conditions ...
-		(cond
-
-				((ends-with query-list "xml")
-					(print http-xml-header)
-					;(print http-atom-header)
-					(print http-200)
-					(println)
-
-					(Dragonfly:view defaultrss))
-
-				((ends-with query-list "rss")
-					(print http-xml-header)
-					;(print http-atom-header)
-					(print http-200)
-					(println)
-
-					(Dragonfly:view defaultrss))
-
-		   		((empty? query-list)
-
-					(print http-html-header)
-					(print http-200)
-					(println)
-		        	; no info at all, so just pass to default view
-		       		(Dragonfly:view defaultview))
-
-		   		((= (length query-list) 1)		
-
-					(print http-html-header)
-					(print http-200)
-					(println)
-		        	; one argument means a selector.
-		        	; pass the default view after setting selector
-		       		(set 'selector (first query-list))				
-		       		(Dragonfly:view defaultview))
-
-		   		((> (length query-list) 1 )
-
-					(print http-html-header)
-					(print http-200)
-					(println)
-					(Dragonfly:view viewname))
-
-
-		) ; end of conditions
-		
-	)
-	
-)
-
-;; @syntax (Dragonfly:benchmark-start)
-;; <p>Sets the start point for benchmarking.</p>
-;; 
-(define (benchmark-start)
-	(set 'microtime-start (time-of-day))
-)
-
-;; @syntax (Dragonfly:benchmark-end)
-;; <p>Sets the end point for benchmarking and calculates the result in milliseconds plus
-;; some information about memory usage.</p>
-;; 
-(define (benchmark-result)
-
-  	(set 'mem_cells_bytes (* (sys-info 0) 16))
-  	(set 'mem_cells_kilobytes (/ mem_cells_bytes 1024))
-
-  	(set 'mem_cells-constant_bytes (* (sys-info 1) 16))
-  	(set 'mem_cells-constant_kilobytes (/ mem_cells-constant_bytes 1024))
-  	(set 'mem_cells-constant_megabytes (/ mem_cells-constant_kilobytes 1024))
-
-  	(set 'mem_symbols_bytes (* (sys-info 2) 32))
-  	(set 'mem_symbols_kilobytes (/ mem_symbols_bytes 1024))
-
-    (set 'mem_total_usage (+ mem_cells_kilobytes mem_symbols_kilobytes))
-  
-	(set 'microtime-end (time-of-day))
-	(set 'execution-time-milliseconds (- microtime-end microtime-start))
-	(set 'execution-time-seconds (div execution-time-milliseconds 1000))
-	(println "<div id='dragonfly_benchmark'>Rendered in "execution-time-milliseconds" milliseconds. Used "mem_total_usage" KB of memory.<br/><div id='dragonfly_logo'><a href='http://code.google.com/p/dragonfly-newlisp/'>&mdash;()o Dragonfly <span class='dragonfly_uppercase'>web framework "dragonfly_version"</span></a></div></div>")
-	
-)
-
-;; @syntax (Dragonfly:debugging)
-;; <p>Writes some debug information to the screen. Requires Web.lsp module for POST and GET information.</p>
-;; 
-(define (debugging)
-
-  (set 'mem_cells_bytes (* (sys-info 0) 16))
-  (set 'mem_cells_kilobytes (/ mem_cells_bytes 1024))
-
-  (set 'mem_cells-constant_bytes (* (sys-info 1) 16))
-  (set 'mem_cells-constant_kilobytes (/ mem_cells-constant_bytes 1024))
-  (set 'mem_cells-constant_megabytes (/ mem_cells-constant_kilobytes 1024))
-
-  (set 'mem_symbols_bytes (* (sys-info 2) 32))
-  (set 'mem_symbols_kilobytes (/ mem_symbols_bytes 1024))
-
-  (set 'mem_total_usage (+ mem_cells_kilobytes mem_symbols_kilobytes))
-
-  (println "
-	<div id='dragonfly_debug' style='width:474px; margin-top:20px;' >
-	<h1>Dragonfly DEBUG information</h1><br/>
-	<h2>HOST</h2>"host"
-	<h2>DOCUMENT ROOT</h2>"documentroot"
-	<h3>DRAGONFLY ROOT</h3>"dragonfly-root"
-	<h3>Windows Programfiles</h3>"programfiles"
-	<h3>QUERY</h3>"(env "QUERY_STRING")"
-	<h3>DEFAULT VIEW</h3>"defaultview"
-	<h3>DEFAULT ACTION</h3>"defaultaction"
-	<h3>CURRENT VIEW</h3>"viewname"
-	<h3>CURRENT ACTION</h3>"action"
-	<h3>CURRENT SELECTOR</h3>"selector"
-	<h3>CURRENT PARAMS</h3>"params"
-	<h3>USER-AGENT</h3>"useragent"
-	<h3>Proxy</h3>"proxy"
-	<h3>SERVER</h3>"server"
-	<h3>POST</h3>"Web:POST"
-	<h3>GET</h3>"Web:GET"
-	<h3>System information</h3>
-	<ul>
-		<li>Total memory usage: "mem_total_usage" KB</li>	
-		<li>Number of Lisp Cells (16 bytes per cell): "(sys-info 0)"</li>
-		<li>Memory used by Lisp Cells: "mem_cells_kilobytes" KB</li>
-		<li>Maximum number of Lisp cells constant: "(sys-info 1)"</li>
-		<li>Maximum memory used by Lisp cells constant: "mem_cells-constant_megabytes" MB</li>
-		<li>Number of symbols (32 bytes per symbol): "(sys-info 2)"</li>
-		<li>Memory used by symbols: "mem_symbols_kilobytes" KB</li>
-		<li>Evaluation/recursion level: "(sys-info 3)"</li>
-		<li>Environment stack level: "(sys-info 4)"</li>
-		<li>Maximum call stack constant: "(sys-info 5)"</li>
-		<li>Pid of running newLISP process: "(sys-info 6)"</li>
-		<li>Version number as an integer constant: "(sys-info 7)"</li>
-		<li>Operating system constant: "(sys-info 8)"</li>
-		<li>Used symbols in Dragonfly: <pre>"(symbols 'Dragonfly)"</pre></li>
-		<li>Last system error: "(sys-error)"</li>
-	</ul>
-	
-	</div>")
-)
-
-
-;; @syntax (Dragonfly:view <view>)
-;; @param <viewname> name of view
-;; <p>Evaluates the view and returns it.</p>
-;; 
-(define (view viewname)
-	(set 'path-to-views views-path)
-    (push viewname path-to-views -1)
-	(if (nil? (read-file path-to-views))
-		(begin
-			(set 'path-to-error-views views-path)
-			(push default404 path-to-error-views -1)
-			(Web:eval-template (read-file path-to-error-views))	
-		)
-			(Web:eval-template (read-file path-to-views))				
-	)
-)
+(error-event error-handler)
 
 ;; @syntax (Dragonfly:partial <partial>)
 ;; @param <partial> name of partial
 ;; <p>Evaluates the partial and returns it.</p>
 ;; 
 (define (partial partialname)
-  	(Web:eval-template (read-file (append partials-path partialname)))
+  	(Web:eval-template (read-file (string PARTIALS_PATH "/" partialname)))
 )
 
-;; @syntax (Dragonfly:title <websitename>)
-;; @param <websitename> a string containing creen or print
-;; <p>Writes a title including the current navigation entry.</p>
-;; 
-(define (title websitename)
-  (print (append (title-case (replace "_" viewname " ")) " " websitename  ))
+(define (listener)
+	(dolist (route dragonfly-routes)
+		(when (:matches? route)
+			(:run route)
+			(Response:send-headers)
+			(MAIN:println STDOUT)
+			(exit)
+		)
+	)
 )
-
-;; @syntax (Dragonfly:css <css-media> <css-location>)
-;; @param <css-media> a string containing screen or print
-;; @param <css-location> the location of your stylesheet
-;; <p>Writes a standard stylesheet HTML tag.</p>
-;; 
-(define (css css-media css-location)
-  (print "<link rel='stylesheet' type='text/css' media='"css-media"' href='"css-location"' />")
-)
-
-;; @syntax (Dragonfly:meta <meta-name> <meta-content>)
-;; @param <meta-name> a string containing the meta-name
-;; @param <meta-content> a string containing the meta content
-;; <p>Writes a standard meta HTML tag.</p>
-;; 
-(define (meta meta-name meta-content)
-  (print "<meta name='"meta-name"' content='"meta-content"' />")
-)
-
-;; @syntax (Dragonfly:rss <rss-title> <rss-location>)
-;; @param <rss-title> a string containing the rss title
-;; @param <rss-location> a string containing the rss location
-;; <p>Writes a standard RSS HTML tag.</p>
-;; 
-(define (rss rss-title rss-location)
-  (print "<link rel='alternate' type='application/rss+xml' title='"rss-title"' href='"rss-location"' />")
-)
-
-;; @syntax (Dragonfly:script <script-location>)
-;; @param <script-location> a string containing the script location
-;; <p>Writes a standard script HTML tag.</p>
-;; 
-(define (script script-location)
-  (print "<script type='text/javascript' src='"script-location"'></script>")
-)
-
-;; @syntax (Dragonfly:autoload-css css-media css-screen css-iphone)
-;; @param <css-media> a string containing the css media type
-;; @param <css-screen> a string containing the path to screen stylesheet
-;; @param <css-iphone> a string containing the path to iPhone stylesheet
-;; <p>Detects the iPhone and loads the apropiate CSS.</p>
-;; 
-(define (autoload-css css-media css-screen css-iphone)
-  (if (find "iPhone" useragent)
-	(print "<!-- found iPhone --><meta name='viewport' content='width=320, user-scalable=yes' /><link rel='stylesheet' type='text/css' media='"css-media"' href='"css-iphone"' />")
-	(print "<!-- no iPhone detected ... loading screen stylesheets --><link rel='stylesheet' type='text/css' media='"css-media"' href='"css-screen"' />")
-  )
-)
-
-
-;; @syntax (Dragonfly:compare-lists <list1> <list2>)
-;; @param <list1> list number 1
-;; @param <list2> list number 2
-;; <p>Compares two lists and return the score of same and same position. This is a function by cormullion.</p>
-;;
-(define (compare-lists list1 list2)
-	(print "Comparing " list1 " and " list2 " ...")
-	(print " "(first (count '(true) (map = list1 list2))) " elements are the same and in the same position.")
-)
-
-;; @syntax (Dragonfly:google-analytics <analytics-id>)
-;; @param <analytics-id> enter the specified id provided by Google Analytics, e.g. UA-123456-7
-;; <p>Writes the Google Analytics tracking code.</p>
-;;
-(define (google-analytics analytics-id)
-	(print "
-	<script type=\"text/javascript\">
-		var gaJsHost = ((\"https:\" == document.location.protocol) ? \"https://ssl.\" : \"http://www.\");
-		document.write(unescape(\"%3Cscript src='\" + gaJsHost + \"google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E\"));
-		</script>
-		<script type=\"text/javascript\">
-		try {
-			var pageTracker = _gat._getTracker(\""analytics-id"\");
-			pageTracker._trackPageview();
-		} catch(err) {}
-	</script>				
-	")
-)
-
-
-
-;===============================================================================
-; !Date Functions
-;===============================================================================
-
-;; @syntax (Dragonfly:todays-date-german including actual time)
-;; <p>Writes todays date including time in german localization</p>
-;; 
-(define (todays-date-german)
-	(set-locale "de_DE")
-	(print (date (date-value) 0 "%A, den %d. %B %Y um %H:%M:%S Uhr"))
-)
-
-;; @syntax (Dragonfly:time-now)
-;; <p>Writes the actual time</p>
-;; 
-(define (time-now)
-	(print (date (date-value) 0 "%H:%M:%S"))
-)
-
-
-;===============================================================================
-; !Image Functions
-;===============================================================================
-
-;; @syntax (Dragonfly:image <image_name> <image_url>, <options>)
-;; @param <image_name> a string containing the image alternative title
-;; @param <image_url> a string containing the url
-;; @param <options> optional settings like class, rel, width, height ...
-;; <p>Writes a standard HTML image.</p>
-;; 
-(define (image image-name image-url, image-options)
-  (print "<img src='"image-url"' alt='"image-name"' title='"image-name"' border='0' "image-options" />")
-)
-
-
-;===============================================================================
-; !Link Functions
-;===============================================================================
-
-;; @syntax (Dragonfly:link_to <link_name> <view>)
-;; @param <link_name> a string containing the link's name
-;; @param <view> a string containing the view
-;; <p>Writes a internal link</p>
-;; 
-(define (link_to link-name view action)
 	
-  	; if Dragonfly runs on newLISP webserver, we cannot
-  	; use .htaccess, so we've to write the "?" into the url
-    ; else we miss it
-	(if (true? (find "newLISP" server))
-		(set 'link-url (append "?" view "/" action))
-		(set 'link-url (append "/" view "/" action))
-	)
-	
-  	(print "<a href='"link-url"'>"link-name"</a>")
-)
-
-;; @syntax (Dragonfly:link_to <link_name> <url>)
-;; @param <link_name> a string containing the link's name
-;; @param <url> a string containing the target URL
-;; <p>Writes a standard HTML link</p>
-;; 
-(define (link_to_external link-name url)
-		
-  	(print "<a href='"url"'>"link-name"</a>")
-
-)
-
-;; @syntax (Dragonfly:link_mailto <link_name> <options>)
-;; @param <name> a string containing the link's name
-;; @param <options> a string containing the url
-;; <p>Writes a standard HTML mailto link</p>
-;; 
-(define (link_mailto link-name link-url)
-  (print "<a href='mailto:"link-url"'>"link-name"</a>")
-)
-
-
-;===============================================================================
-; !AJAX Functions
-;===============================================================================
-
-;; @syntax (Dragonfly:ajax-updater <html-elementid> <request-url> <params-url> <timeout>)
-;; @param <html-elementid> a string containing the elementID
-;; @param <request-url> a string containing the url which is called frequently
-;; @param <params-url> a string containing params which are POSTED against request-url
-;; @param <timeout> an integer containing the number of microseconds after recalling the request-url
-;; <p>Writes a simple AJAX-updater, e.g. for displaying the time on a website.</p>
-;;
-(define (ajax-updater html-elementid request-url params-url timeout)
-	(print "<div id='"html-elementid"'>&nbsp;</div>")
-	(print "<script language='javascript'>")
-	(print "function responseFunction(responseText, responseStatus) {")
-	(print "var response = responseText;")
-	(print "document.getElementById('"html-elementid"').innerHTML = response;")	
-	(print "setTimeout(\"ajax"html-elementid".post('"params-url"');\","timeout");")
-	(print "}")
-	
-	; check for newLISP as webserver, then we've to use a ? before request-url, because there's no working .htaccess
-	(if (true? (find "newLISP" server))
-		(print "var ajax"html-elementid" = new AjaxRequest(\"?"request-url"\", responseFunction);")
-		(print "var ajax"html-elementid" = new AjaxRequest(\""request-url"\", responseFunction);")
-	)
-	
-	(print "ajax"html-elementid".post(\""params-url"\");")
-	(print "</script>")
-)
-		
-
-(context MAIN)
+(context MAIN)

File example-site/dragonfly-framework/lib/log.lsp

+;;  Copyright (C) <2009> <Marc Hildmann, 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/>.
+;;
+;; @author Greg Slepak
+
+(context 'Dragonfly)
+
+(map set '(LOG_DEBUG LOG_INFO LOG_WARN LOG_ERROR)
+         '(        0        1        2         3))
+
+
+(define (log-func level msg)
+	(append-file LOG_FILE_PATH (string (date (date-value) 0 "%b %d %H:%M:%S ") level msg "\n"))
+)
+
+(define (log-debug)
+	(log-func "[DEBUG]: " (apply string $args))
+)
+
+(define (log-info)
+	(log-func "[INFO]: " (apply string $args))
+)
+
+(define (log-warn)
+	(log-func "[WARNING]: " (apply string $args))
+)
+
+(define (log-err)
+	(log-func "[ERROR]: " (apply string $args))
+)
+
+(if (> (eval LOG_LEVEL) LOG_DEBUG) (define (log-debug)))
+(if (> (eval LOG_LEVEL) LOG_INFO) (define (log-info)))
+(if (> (eval LOG_LEVEL) LOG_WARN) (define (log-warn)))
+
+(context MAIN)

File example-site/dragonfly-framework/lib/request.lsp

-;;; 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.
+; @author Greg Slepak <greg at taoeffect.com>
+; This file should only be loaded once!
 
-;;; 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).
+;===============================================================================
+; !Global Variables
+;===============================================================================
 
-(context MAIN)
+; For PHP's 'isset' use 'empty?' like this: (empty? ($POST "foo"))
+(new Tree '$POST)
+(new Tree '$GET)
+(new Tree '$COOKIES)
 
-; globals must be delcared in MAIN context
-(unless (number? *max-post-length*)
-	(set '*max-post-length* 1002537))
+; use like this: (lookup 'data ($FILES "filename"))
+; Valid keys: 'data, 'name, 'length
+(new Tree '$FILES)
 
-(global '*max-post-length*)
+; used to store binary STDIN data
+(global '$BINARY)
+
+; define MAX_POST_LENGTH if you want a custom value
+(unless (number? MAX_POST_LENGTH)
+	(constant (global 'MAX_POST_LENGTH) 1048576)
+)
 
 (context 'Request)
 
-;; mark Public API
+;===============================================================================
+; !Private Functions
+;===============================================================================
 
-(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))
+;; (url-translate "What+time+is+it%3f")  => "What time is it?"
+(constant 'REGEX_HEX_ENCODED_CHAR (regex-comp {%([0-9A-F][0-9A-F])} 1))
 
-(define (get key)
-	(if key
-		(lookup key _get)
-		_get
-	)
+(define (url-decode str)
+   (replace "+" str " ")
+   (replace REGEX_HEX_ENCODED_CHAR str (char (int (string "0x" $1))) 0x10000)
 )
 
-(define (post key)
-	(if key
-		(lookup key _post)
-		_post
-	)
-)
+(constant 'REGEX_QUERY (regex-comp {&([^&=]+?)=?([^&=]*?)(?=&|$)} 1))
 
-(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 (parse-query query)
+	(when (starts-with query "?") (pop query))
+	(push "&" query)
+	(find-all REGEX_QUERY query (list $1 (url-decode $2)) 0x10000)
 )
 
 (define (regex-captcha regex-str str (options 0) (captcha 1))
 	)
 )
 
-(define (parse-multipart-chunk chunk boundary-len, idx disp var val data (params '()))
-	(set 'idx (find "Content-Disposition" chunk))
-	
-	(when idx
+(define (handle-binary-data)
+	(read-buffer (device) $BINARY MAX_POST_LENGTH)
+)
+
+(define (parse-multipart-chunk chunk , idx disp var val data)
+	(when (set 'idx (find "Content-Disposition" chunk))
 		(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)
-					)
+		(when (and disp (set 'var (regex-captcha {name="(.+?)"} disp)))
+			(set 'data ((+ 4 (find "\r\n\r\n" chunk)) (length chunk) chunk))
+			(when (set 'idx (find "\r\n--" data))
+				(set 'data (0 idx data))
+				(if (set 'val (regex-captcha (string var {="(.+?)"}) disp))
+					($FILES var (list (list 'name val) (list 'data data) (list 'length (length data))))
+					($POST var data)
 				)
 			)
 		)
 	)
-	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)
-		)
+(define (handle-multipart-data , buff boundary)
+	(set 'boundary (regex-captcha {boundary=(.+)} CONTENT_TYPE))	
+	(while (read-buffer (device) buff MAX_POST_LENGTH boundary)
+		(parse-multipart-chunk buff)
 	)
 )
 
-;; deal with HTTP_COOKIE data
-(dolist (element (parse (string (env "HTTP_COOKIE")) ";"))
-	(push (parse element "=") _cookies -1)
+;===============================================================================
+; !$GET
+;===============================================================================
+
+(when QUERY_STRING
+	(dolist (pair (parse-query QUERY_STRING))
+		($GET (first pair) (last pair))
+	)
 )
 
-(context MAIN)
+;===============================================================================
+; !$POST/$FILES/$BINARY
+;===============================================================================
+
+(unless (zero? (peek (device)))
+	(if (and (setf temp HTTP_CONTENT_TRANSFER_ENCODING) (= temp "binary"))
+		(handle-binary-data)
+		(and (setf temp CONTENT_TYPE) (starts-with temp "multipart/form-data"))
+		(handle-multipart-data)
+		(and (read-buffer (device) temp MAX_POST_LENGTH) temp)
+		(dolist (pair (parse-query temp))
+			($POST (first pair) (last pair))
+		)
+		; TODO: log an error here
+	)
+)
+
+;===============================================================================
+; !$COOKIES
+;===============================================================================
+
+; we do *NOT* want to use url-decode on the value
+; that's something the user can do if they want to
+(when HTTP_COOKIE
+	(dolist (cookie (parse HTTP_COOKIE "; *" 0))
+		(map set '(key value) (parse cookie "="))
+		($COOKIES key value)
+	)
+)
+
+(context 'MAIN)

File example-site/dragonfly-framework/lib/response.lsp

+;; @author Greg Slepak
+
 (context 'Response)
 
-;; mark Public API
+;===============================================================================
+; !Public API
+;===============================================================================
 
-(define (Response:Response str)
-	(_response 200 str)
+(define (status code description)
+	(if code
+		(begin
+			(unless (assoc code status-codes)
+				(push (list code description) status-codes))
+			(setf status-code code)
+		)
+		status-code
+	)
 )
 
+;; @syntax (Request:header <str-key>)
+;; @param <str-key> the header's name
+;; 
+;; @syntax (Request:header <str-key> <str-value>)
+;; @param <str-key> the header's name
+;; @param <str-value> the header's value
+;; <p>In the first syntax, returns the header matching <str-key> or,
+;; if <str-key> is nil, all of the headers in a list</p>
+;; <p>In the second syntax, sets or updates the header matching <str-key> or,
+;; if <str-value> is nil, deletes the header for <str-key>.</p>
+(define (header key)
+	(if (nil? key) headers
+		(empty? $args) (lookup key headers)
+		(let (value (first $args))
+			(if value
+				(if (assoc key headers)
+					(setf (lookup key headers) value)
+					(push (list key value) headers -1)
+				)
+				(pop headers (find key headers comp-func))
+			)
+		)
+	)
+)
+
+;; @syntax (Request:cookie <str-key>)
+;; @param <str-key> the cookie's name
+;; 
+;; @syntax (Request:cookie <str-key> <str-value> [<int-expires> [<str-path> [<str-domain> [<bool-http-only>]]]])
+;; @param <str-key> the cookie's name
+;; @param <str-value> the cookie's value
+;; @param <int-expires> (optional) the expiration date of the cookie as a unix timestamp; default is a session cookie
+;; @param <str-path> (optional) the cookie's path; default is the current path
+;; @param <str-domain> (optional) the cookie's domain; default is the current host
+;; @param <bool-http-only> (optional) whether the cookie may be read by client-side scripts
+;; <p>In the first syntax, 'cookie' returns the value of the cookie named <str-key> or 'nil'. If
+;; <str-key> is not provided, an association list of all cookie values is returned.</p>
+;; <p>In the second syntax, 'cookie' sets a new cookie. If <str-value> is nil then any existing
+;; cookie is deleted, otherwise it is updated with the value and the rest of the parameters.</p>
+(define (cookie key)
+	(local (value expires path domain http-only)
+		(map set '(value expires path domain http-only) $args)
+		(if (nil? key) cookies
+			(empty? $args) (lookup key cookies)
+			(nil? value) (pop cookies (find key cookies comp-func))
+			(let (cookie (list key value expires path domain http-only))
+				(if (assoc key cookies)
+					(setf (assoc key cookies) cookie)
+					(push cookie cookies -1)
+				)
+			)
+		)
+	)
+)
+
+(define (send-headers)
+	(print "Status: " status-code " " (lookup status-code status-codes) "\r\n")
+	(dolist (header headers) (print (first header) ": " (last header) "\r\n"))
+	(dolist (cookie cookies) (print "Set-Cookie: " (apply format-cookie cookie) "\r\n"))
+	(print "\r\n")
+)
+
+;===============================================================================
+; !Public Convenience Functions and Variables
+;===============================================================================
+
 (define (redirect path)
 	(header "Location" path)
-	(_response 302)
+	(status 302)
+	(send-headers)
+	(exit)
 )
 
-(define (not-found str)
-	(_response 404 str)
+(define (send-headers-with-status code description)
+	(status code description)
+	(send-headers)
 )
 
-(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 (content-type value)
+	(if value
+		(header "Content-Type" value)
+		(header "Content-Type")
 	)
 )
 
-(define (header? key)
-	(lookup key _headers)
-)
+(constant 'text-type "text/plain; charset=utf-8")
+(constant 'html-type "text/html; charset=utf-8")
+(constant 'xml-type "text/xml; charset=utf-8")
+(constant 'atom-type "application/atom+xml; charset=utf-8")
 
-(define (headers)
-	_headers
-)
+;===============================================================================
+; !Private Functions
+;===============================================================================
 
-
-;; 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)))
+; we do *NOT* want to use url-encode on the value
+; that's something the user can do if they want to.
+; these parameters must match the order in the 'cookie' function.
+(define (format-cookie key value expires path domain http-only)
+	(let (cookie (string key "=" value))
+		(if expires (write-buffer cookie (string "; expires=" (date expires 0 "%a, %d %b %Y %H:%M:%S %Z"))))
+		(if path (write-buffer cookie (string "; path=" path)))
+		(if domain (write-buffer cookie (string "; domain=" 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)
+; this is used by the cookie and header functions
+(define (comp-func x y)
+	(= x (y 0))
 )
 
-;; http://en.kioskea.net/contents/internet/http.php3
-;; http://hoohoo.ncsa.uiuc.edu/cgi/out.html
+;===============================================================================
+; !Private Variables
+;===============================================================================
 
-;; 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)
+; common status codes, you can easily add your own using Response:status
+(set 'status-codes
+  '((200 "OK")
+	(301 "Moved Permanently")
+	(302 "Found")
+	(400 "Bad Request")
+	(401 "Unauthorized")
+	(403 "Forbidden")
+	(404 "Not Found")
+	(410 "Gone")
+	(500 "Internal Error"))
 )
 
-;; mark Private variables
+(set 'headers '())
+(set 'cookies '())
+(set 'status-code 200)
 
-(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 '())
+(content-type html-type)
+(header "Connection" "keep-alive")
 
 (context MAIN)

File example-site/dragonfly-framework/lib/route.lsp

+;;  Copyright (C) <2009> <Marc Hildmann, 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
+
+(new Class 'Route)
+(context 'Route)
+
+(define (matches?)
+	nil
+)
+
+(define (run)
+	nil
+)
+
+(context 'MAIN)

File example-site/dragonfly-framework/lib/session.lsp

+#!/usr/bin/newlisp
+;; @author Jeff Ober <jeffober@gmail.com>, Greg Slepak <greg at taoeffect.com>
+
+(context 'Session)
+
+(define SESSION_DIR "/tmp")
+(define SESSION_MAX_AGE (* 60 60 24 7)) ; seconds
+(define SESSION_KEY "NLWSESID")
+(define SESSION_PREFIX "NLWSES")
+(define SESSION_STARTED)
+(define SESSION_ID) ; stores the current session id
+
+;===============================================================================
+; !Session control
+; notes:
+;  * sessions require cookies to function
+;  * close-session or MAIN:exit must be called to save session changes to disk
+;===============================================================================
+
+;; @syntax (Session:define-session-handlers <fn-open> <fn-close> <fn-delete> <fn-clear> <fn-clean>)
+;; @param <fn-open> function to begin a new session
+;; @param <fn-close> function to close a session, saving changes
+;; @param <fn-delete> function to delete a session
+;; @param <fn-clean> function to prune old sessions
+;; <p>Defines handler functions to be called when various session control
+;; functions are used, making custom session storage a fairly simple matter.</p>
+;; The required handler functions are:
+;; <ul>
+;; <li>'fn-open': called by 'open-session'; resumes or starts a new session storage instance, initializing the context tree</li>
+;; <li>'fn-close': called by 'close-session'; writes changes to a session to storage</li>
+;; <li>'fn-delete': called by 'delete-session'; deletes the entire session from storage</li>
+;; <li>'fn-clean': called by 'clean-sessions'; prunes old stored sessions</li>
+;; </ul>
+;; Some useful functions and variables for handler functions:
+;; <ul>
+;; <li>'session-id': function that returns the current session id and sets the session cookie when necessary</li>
+;; <li>'session-context': function that returns the session context dictionary</li>
+;; <li>'SESSION_MAX_AGE': a variable storing the number of seconds after which an orphan session should be deleted</li>
+;; </ul>
+(define (define-session-handlers fn-open fn-close fn-delete fn-clean)
+  (setf _open-session fn-open
+        _close-session fn-close
+        _delete-session fn-delete
+        _clean-sessions fn-clean))
+
+;; @syntax (Session:session-id [<str-sid>])
+;; @param <str-sid> (optional) the session ID to use
+;; @return a unique session id for the client
+;; <p>Creates or retrieves the client's session id. If this is a new session id,
+;; a cookie is set in the client's browser to identify it on future loads.</p>
+;; <p>If <str-sid> is provided, it will be used as the new session ID.</p>
+(define (session-id sid)
+  (setf SESSION_ID
+    (or (when sid
+          ($COOKIES SESSION_KEY sid)
+          sid)
+        SESSION_ID
+        ($COOKIES SESSION_KEY)
+        (begin
+          (setf sid (string SESSION_PREFIX "-" (uuid)))
+          ($COOKIES SESSION_KEY sid)
+          sid))))
+
+;; @syntax (Session:session-context)
+;; @return a symbol pointing to the current session's context dictionary
+;; <p>Run-time session data is stored in a context tree. 'session-context'
+;; returns the current session tree or creates a new one when necessary.
+;; This function is primarily intended for session handlers' use; it is
+;; typically more useful to call 'session' on its own to retrieve an association
+;; list of key/value pairs in an application.</p>
+(define (session-context , ctx)
+  (setf ctx (sym (session-id) 'MAIN))
+  (unless (context? ctx)
+    (context ctx))
+  ctx)
+
+;; @syntax (Session:open-session)
+;; <p>Initializes the client's session.</p>
+(define (open-session)
+  (_open-session)
+  (setf SESSION_STARTED true)
+  (session-id))
+
+;; @syntax (close-session)
+;; <p>Writes any changes to the session to file. This is automatically called
+;; when the distribution function 'exit' is called.</p>
+(define (close-session)
+  (when SESSION_STARTED
+    (_close-session)))
+
+;; @syntax (delete-session)
+;; <p>Deletes the session. Sessions are then turned off and 'open-session'
+;; must be called again to use sessions further.</p>
+(define (delete-session)
+  (unless SESSION_STARTED (throw-error "session is not started"))
+  (_delete-session)
+  (delete (session-context))
+  ($COOKIES SESSION_KEY "" 0)
+  (setf SESSION_STARTED nil))
+
+;; @syntax (clear-session)
+;; <p>Clears all session variables.</p>
+(define (clear-session)
+  (when SESSION_STARTED
+    (dotree (s (session-context))
+      (delete (sym s (session-context))))))
+
+;; @syntax (clean-sessions)
+;; <p>Cleans old session files. This function is not currently called automatically;
+;; note that there is the possibility of a race condition with this function and other
+;; session handling functions.</p>
+(define (clean-sessions)
+  (_clean-sessions))
+
+;; @syntax (session [<str-key> [<str-value>]])
+;; @param <str-key> the session key
+;; @param <str-value> the new value
+;; When called with both <str-key> and <str-value>, sets the session variable. When
+;; called with only <str-key>, returns the value of <str-key>. Otherwise, returns
+;; an association list of session variables. Returns nil if the session is not
+;; opened.
+(define (session key value)
+  (cond
+    ((not SESSION_STARTED) nil)
+    ((and key value) (context (session-context) key value))
+    ((true? key) (context (session-context) key))
+    (true (let ((alist '()))
+            (dotree (s (session-context))
+              (push (list (name s) (context (session-context) (name s))) alist -1))
+            alist))))
+
+;===============================================================================
+; !Default session handlers
+; 
+; The default session handlers use newLISP's 'save' and 'load' functions to
+; easily serialize and import context data to and from file records. The files
+; are stored unencrypted, so a custom handler should be used on a shared
+; system.
+;===============================================================================
+
+; Returns the name of the file in which the session data is stored.
+(define (default-session-file)
+  (string SESSION_DIR "/" (session-id) ".lsp"))
+
+; Loads/creates the session file; creates a new context tree when
+; necessary.
+(define (default-open-session)
+  (if (file? (default-session-file))
+    (load (default-session-file))
+    (save (default-session-file) (session-context))))
+
+; Saves the session context to the session file.
+(define (default-close-session)
+  (save (default-session-file) (session-context)))
+
+; Deletes the session file.
+(define (default-delete-session)
+  (when (file? (default-session-file))
+    (delete-file (default-session-file))))
+
+; Deletes old session files.
+(define (default-clean-sessions , f)
+  (dolist (tmp-file (directory SESSION_DIR))
+    (when (starts-with tmp-file SESSION_PREFIX)
+      (setf f (string SESSION_DIR "/" tmp-file))
+      (when (> (- (date-value) (file-info f 5 nil)) SESSION_MAX_AGE)
+        (delete-file f)))))
+
+; Install default session handlers
+(define-session-handlers
+  default-open-session
+  default-close-session
+  default-delete-session
+  default-clean-sessions)
+
+(context 'MAIN)
+
+; This function wraps the distribution exit routine to ensure that sessions are
+; written when the application exits. It is only called when the 'exit' function
+; is explicitly called. The 'exit' function is renamed 'sys-exit'. The 'Web'
+; function 'close-session' is only called on a normal exit (exit code 0.)
+(define (exit-with-session-close (n 0))
+  (when (zero? n)
+    (Session:close-session))
+  (MAIN:sys-exit))
+
+(constant 'sys-exit exit)
+(constant 'exit exit-with-session-close)

File example-site/dragonfly-framework/lib/utils.lsp

 
 (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)