( in-package #:cl-user )
( defpackage #:rails-to-caveman.web
( :use #:cl
#:caveman2
#:rails-to-caveman.config
#:rails-to-caveman.view
#:rails-to-caveman.db
#:rails-to-caveman.model
#:sxql
#:mito )
( :export #:*web* ) )
( in-package #:rails-to-caveman.web )
;; for @route annotation
( syntax:use-syntax :annot )
;;
;; Application
( defclass <web> ( <app> ) ( ) )
( defvar *web* ( make-instance '<web> ) )
( clear-routing-rules *web* )
;;
;; Routing rules
( defroute "/" ( )
( render #P"index.html"
;; Use to pass message to view -- it is expecting a
;; `MESSAGE' item. You do not need to add it, though. Or,
;; you can pass it an empty value/string if you do not want
;; to leave the code commented out.
;; '(:message "This is not a message") ; Added Chapter 3.
' ( :numbers ( 1 2 3 4 5 ) )
) )
( defroute "/users/index" ( )
( render "users/index.html"
` ( :users , ( with-connection ( db )
( mito:select-dao 'rails-to-caveman.model::user
( sxql:order-by :number ) ) )
:token , ( token )
:notice ( flash-gethash
:notice ningle:*request* ) ) ) )
( defroute "/users/search" ( &key |q| )
( render "users/index.html"
` ( :users , ( with-connection ( db )
( mito:select-dao 'rails-to-caveman.model::user
( sxql:where
` ( :or ( :like :name , |q| )
( :like :full-name , |q| ) ) )
( sxql:order-by :number ) ) ) ) ) )
( defroute "/users/:id" ( &key id )
( let ( ( id ( ignore-errors ( parse-integer id ) ) ) )
( if ( null id )
( myway.mapper:next-route )
( let ( ( user ( with-connection ( db )
( mito:find-dao 'rails-to-caveman.model::user
:id id ) ) ) )
;; (setf id (parse-integer id))
( if user
( render "users/show.html"
` ( :user , ( with-connection ( db )
( mito:find-dao 'rails-to-caveman.model::user
:id id ) )
:notice , ( flash-gethash
:notice ningle:*session* ) ) )
( on-exception *web* 404 ) ) ) ) ) )
( defroute "/user/new" ( )
( render #P"users/new.html"
` ( :users , ( with-connection ( db )
( make-instance 'rails-to-caveman.model::user ) )
:token , ( token ) ) ) )
( defroute "/users/:id/edit" ( &key id )
( let* ( ( id ( ignore-errors ( parse-integer id ) ) )
( user ( with-connection ( db ) ; NOTE `USER' AND NOT USERS.
( and id
( mito:find-dao 'rails-to-caveman.model::user
:id id ) ) ) ) )
( if user ( render "users/edit.html"
` ( :user , user :token , ( token ) ) )
( on-exception *web* 404 ) ) ) )
( defroute ( "/user/:id" :method :post )
( &key |authenticity-token|
id
( |number| "" )
|name|
|full-name|
( |sex| "" )
|birthday-year|
|birthday-month|
|birthday-day|
|email|
( |administrator| "" ) )
( if ( not ( string= |authenticity-token| ( token ) ) )
' ( 403 ( ) ( "Denied" ) )
( with-connection ( db )
( let ( ( id ( ignore-errors ( parse-integer id ) ) )
( user ( and id
( mito:find-dao
'rails-to-caveman.model::user :id id ) ) ) )
( if ( null user )
' ( 500 ( ) ( "Could not edit because user doesn't exist." ) ) )
( progn
#| CHAPTER 6 CODE NOT WORKING HERE.
=================================
I could not get this part of the code ( setf ) to work when
following the tutorial. Because of this, I have decided to
leave the code the tutorial ( in Chapter 6 )
provided. Hopefully, there are other code examples which
will provide an answer to get this part of the code
working.
For now, this route ( I.E. when you try to update a user ) the site will
throw an error and not update it.
| #
( setf ( rails-to-caveman.model::number-of user ) ( parse-integer |number| :junk-allowed t )
( rails-to-caveman.model::name-of user ) |name|
( rails-to-caveman.model::full-name-of user ) |full-name|
( rails-to-caveman.model::sex-of user ) ( parse-integer |sex| :junk-allowed t )
( rails-to-caveman.model::birthday-of user ) ( local-time:parse-timestring
( format nil "~A-~A-~A"
|birthday-year|
|birthday-month|
|birthday-day| ) )
( rails-to-caveman.model::email-of user ) |email|
( rails-to-caveman.model::administrator-of user ) ( eq rails-to-caveman.model::+true+
( zerop ( parse-integer
|administrator|
:junk-allowed t ) ) ) )
( mito:save-dao user )
( setf ( gethash :notice ningle:*session* ) "Updated" )
` ( 303 ( :location , ( format nil "/users/~D" id ) ) ) ) ) ) ) )
( defroute ( "/user" :method :post )
( &key |authenticity-token|
( |number| "" )
|name|
|full-name|
( |sex| "" )
|birthday-year|
|birthday-month|
|birthday-day|
|email|
( |administrator| "" ) )
( if ( not ( string= |authenticity-token| ( token ) ) )
' ( 403 ( ) ( "Denied" ) )
( with-connection ( db )
( let ( ( user ( mito:create-dao
'rails-to-caveman.model::user
:number ( parse-integer |number| :junk-allowed t )
:name |name|
:full-name |full-name|
:sex ( parse-integer |sex| :junk-allowed t )
:birthday ( local-time:parse-timestring
( format nil "~A-~A-~A"
|birthday-year|
|birthday-month|
|birthday-day| ) )
:email |email|
:administrator ( eq
rails-to-caveman.model::+true+
( zerop
( parse-integer |administrator|
:junk-allowed t ) ) ) ) ) )
( setf ( gethash :notice ningle:*session* ) "Stored!" )
` ( 303 ( :location , ( format
nil "/users/~D" ( mito:object-id user ) ) ) ) ) ) ) )
( defroute delete-user ( "/users/:id" :method :delete )
( &key |authenticity-token| id )
( if ( not ( string= |authenticity-token| ( token ) ) )
` ( 403 ( :content-type "text/plain" ) ( "Denied" ) )
( with-connection ( db )
( let* ( ( id ( ignore-errors ( parse-integer id ) ) )
( user ( and id
( mito:find-dao 'rails-to-caveman.model::user
:id id ) ) ) )
( if ( null user )
` ( 500 ( :content-type "text-plain" )
( , ( format nil
"~%Could not delete. User doesn't exist. Id ~S"
id ) ) )
( progn ( mito:delete-dao user )
( setf ( gethash :notice ningle:*session* "Deleted." )
` ( 303 ( :location "/users/index" ) ) ) ) ) ) ) ) )
( defroute ( "/users/:id" :method :post )
( &key |authenticity-token|
id
( |number| "" )
|name|
|full-name|
( |sex| "" )
|birthday-year|
|birthday-month|
|birthday-day|
|email|
( |administrator| "" )
|_method| )
( if ( not ( string= |authenticity-token| ( token ) ) )
` ( 403 ( ) ( "Denied" ) )
( cond ( ( string= |_method| "delete" )
( delete-user
( acons "ID" id ( lack.request:request-body-parameters
ningle:*request* ) ) ) )
( ( find |_method| ` ( "" "post" ) )
( with-connection ( db )
( let ( ( id ( ignore-errors ( parse-integer id ) ) )
( user ( and id ( mito:find-dao
'rails-to-caveman.model::user
:id id ) ) ) )
( if ( null user )
' ( 500 ( :content-type "text/plan"
( "Could not find the user." ) )
( progn ( setf ( rails-to-caveman.model::number-of user )
( parse-integer |number| :junk-allowed t )
( rails-to-caveman.model::name-of user )
|name|
( rails-to-caveman.model::full-name-of user )
( rails-to-caveman.model::sex-of user )
( parse-integer |sex| :junk-allowed t )
( rails-to-caveman.model::birthday-of user )
( local-time:parse-timestring
( format nil "~A-~A-~A"
|birthday-year|
|birthday-month|
|birthday-day| ) )
( rails-to-caveman.model::email-of user )
|email|
( rails-to-caveman.model::administrator user )
( eq rails-to-caveman.model::+true+
( zerop ( parse-integer
|administrator|
:junk-allowed t ) ) ) )
( mito:save-dao user )
( setf ( gethash
:notice ningle:*session* )
"Updated" )
` ( 303 ( :location , ( format nil
"/users/~D"
id ) ) ) ) ) ) ) ) )
( t ` ( 400 ( :content-type "text/plain" )
( , ( format nil "Unsupported method ~S"
|_method| ) ) ) ) ) ) )
( defroute "/about" ( )
;; about.html should be in the /templates directory.
( render #P"about.html" ' ( :page-title "About" ) ) )
( defroute "/hello/:name" ( &key name )
;; Substitutes ':name' with `NAME'.
( format nil "Hello, ~A" name ) )
( defroute "/say/*/to/*" ( &key splat )
;; If route is /say/hello/to/world (in the browser). It will match
;; to /say/hello/to/world. 'hello' and 'world' are the wildcard
;; values in this example.
( format nil "~A" splat ) )
( defroute ( "/hello/([\\w]+)" :regexp t ) ( &key captures )
;; Parse the second part of the URL via a regular expression
;; (regexp). The result of the parsed regexp text is stored in
;; `CAPTURES', hence the use of 'first' in the format string.
( format nil "Hello, ~A!" ( first captures ) ) )
( defroute "/hello/?:name?" ( &key name )
;; Generates two types of routes:
;; 1. /hello/earth
;; 2. /hello?NAME=earth
;; The query string must be in UPPERCASE. Otherwise, the `NAME' will
;; be bound to `nil'.
( format nil "Hello, ~A" name ) )
( defroute "/hello/?:name?" ( &key |name| )
;; If you want the query string in lowercase, enclose `name' (in
;; this case) with vertical bars '|'. This will force you to have
;; only one route (unlike the route above). `NAME' will now bind to
;; `NIL'.
;; 1. /hello?name=earth
;; 2. /hello?NAME=earth <--- no longer works ('earth' binds to nil).
;; 3. /hello/earth <--- no longer works
( format nil "Hello, ~A" |name| ) )
( defroute "/lesson/step*/:name" ( &key splat name )
;; Directory style: Working with Parameters.
;; Example URL: /lesson/step1/Sato
( case ( parse-integer ( car splat ) :junk-allowed t )
( 1 ( format nil "Hello, ~A" name ) ) ) )
( defroute "/lesson/step*" ( &key splat ( |name| "Anonymous" ) )
;; 'Anonymous' is the default value for `|name|'.
;; Query style: Working with Parameters.
;; Example URL: /lesson/step1?name=Sato
( case ( parse-integer ( car splat ) :junk-allowed t )
( 1 ( format nil "Hello, ~A" |name| ) ) ) )
( defroute "/lesson/step*" ( &key splat name )
;; If /lesson/step1 is used, it will be redirected to /lesson/step2,
;; then /lesson/step3 and finally /lesson/step4. No matter where you
;; start (along as it is below 4), the redirects will always take
;; you to /lesson/step4.
;; The example includes `NAME' BUT it is never used. I am keeping it
;; here for consistency between the reference material and this code
;; base.
( case ( parse-integer ( car splat ) :junk-allowed t )
( 1 ' ( 302 ( :location "/lesson/step2" ) ) )
( 2 ' ( 302 ( :location "/lesson/step3" ) ) )
( 3 ' ( 302 ( :location "/lesson/step4" ) ) )
( 4 "Moved to step4" )
;; To be honest, I do not know what this is actually doing. It is
;; mentioned in 'STEP5 Flash' in Chapter 3 (I.E. Tutorial 3:
;; Routing). This applies to case's 5 and 6.
( 5 ( setf ( gethash :notice *session* ) "Move to step6" )
` ( 302 ( :location "/lesson/step6" ) ) )
( 6 ( let ( ( notice ( gethash :notice *session* ) ) )
( remhash :notice *session* ) notice ) )
;; This is part of an example about using djula (which is a
;; template engine used by Caveman2. djula is a port of Python's
;; Django template engine.
;; step7.html should be in the /templates directory.
( 7 ( render "step7.html"
` ( :price , ( floor ( * 2000 1.08 ) ) ) ) )
( 8 ( render "step7.html" ' ( :price 1000 ) ) )
( 9 ( render "step9.html"
' ( :comment "<script>alert('danger')</script>Hello" ) ) )
;; If you dare to embed HTML, add safe after the variable
;; reference on the View side (step10.html).
( 10 ( render "step10.html"
' ( :comment "<strong>safe html</strong>" ) ) )
( 11 ` ( 200 ( :content-type "text/html; charset=utf-8" )
( , ( let ( ( population 704414 ) ( surface 141.31 ) )
( render "step11.html"
` ( :contents
, ( format nil
;; ~D = Decimal
;; ~,,2F = Fixed-Format
;; Floating-Point
;; ~,,2F = Print exactly two
;; digits after the decimal
;; point and many as necessary
;; before the decimal point.
"Population: ~D Floor Surface: ~D Population/Surface: ~,,2F"
population
( floor surface )
( / population surface ) ) ) ) ) ) ) )
( 12 ( render "step11.html"
` ( :contents , ( local-time:format-timestring
nil
( local-time:now )
:format ' ( ( :year 4 ) "/" ( :month 2 ) "/" ( :day 2 ) "(" :short-weekday ") "
( :hour 2 ) ":" ( :min 2 ) ":" ( :sec 2 ) ) ) ) ) )
( 13 ` ( 200 ( :content-type "text/html; charset=utf-8" )
;; This view uses 'format' in step13.html (view in
;; /templates directory).
( , ( render "step13.html" ' ( :population 127767944 ) ) ) ) )
( 14 ( render "step14.html"
;; The view uses a custom filter which was added to
;; view.lisp.
` ( :contents , ( format nil "foo~%bar~%bazz" ) ) ) )
;; The view demonstrates how to form links.
( 15 ( render "step15.html" ) )
;; The view demonstrates how to display images.
;; Images are stored in the /static/images directory.
( 16 ( render "step16.html" ) )
;; Provides control branches which you can navigate via djula in
;; step17.html (/templates directory).
( 17 ` ( 200 ( :content-type "text/html; charset=utf-8" )
;; Adjust `STOCK' to adjust what is viewed in step17.html.
( , ( let ( ( stock 10 ) )
( render "step17.html"
` ( :stock-zerop , ( < 0 stock ) :stock , stock ) ) ) ) ) )
;; This creates a list (cons list) which is then cycled through in
;; /templates/step18.html using the djula template engine..
( 18 ( render "step18.html"
' ( :items
( ( :pan . 2680 )
( :glass . 2550 )
( :pepper-mill . 4515 )
( :peeler . 945 ) ) ) ) ) ) )
( defun token ( )
"CSRF token."
( cdr ( assoc "lack.session"
( lack.request:request-cookies ningle:*request* )
:test #' string= ) ;string equality (always forget this)
) )
( defun flash-gethash ( key table )
( let ( ( value ( gethash key table ) ) )
( remhash key table )
value ) )
;;
;; Error pages
( defmethod on-exception ( ( app <web> ) ( code ( eql 404 ) ) )
( declare ( ignore app ) )
( merge-pathnames #P"_errors/404.html"
*template-directory* ) )