Environment, html.lib.rv:
#!/usr/bin/raven
class Html
FALSE as DEBUG
new hash as GET
new hash as POST
new hash as COOKIE
# default HTML template
'template.html' as $template
# default HTML response headers
[ 'Content-type' 'text/html' ] hash as $headers
# wildcards => replacement html
new hash as $wildcards
# post processing callback words
new list as $callbacks
# default HTML document sections
'mythago.net' as $vhost
'mythago.net' as $title
'' as $head
'' as $body
# map some basic HTML special chars to their codes
group
'&' '&'
'>' '>'
'<' '<'
'"' '"'
hash as $entities
# map ASCII codes to their %XX strings; quicker than
# building them on the fly every time
group 128 each
dup '%%%02X' format swap chr
hash as $ascii_decode
# same mapping for only non alphanumeric chars
group $ascii_decode each pair
over '[a-zA-Z0-9%]+' regex match
if drop drop
hash as $ascii_encode
# encode any special chars in a string
define encode_entities
$entities each pair replace
# decode any special char codes in a string
define decode_entities
$entities keys copy reverse each
$entities over get replace
# encode a string suitable for passing in a URL
define encode_url
'%%' '%' replace
$ascii_encode each pair replace
# decode a string passed through a URL
define decode_url
BL '+' replace
$ascii_decode each pair replace
'%' '%%' replace
# basic loop for breaking query string and post data
# into variable/value pairs
define decode_data use $delimit , $data , $dest
$data empty not
if # pairs are usually delimted by & or ;
$data $delimit split
each '=' split as $qvar
$qvar 0 get empty not
if $qvar length 1 >
if # we have a complete var=val
$qvar into $var , $val
else # we have only var
$qvar into $var '1' as $val
# automatically decode input data
$val decode_url decode_entities
$dest $var set
# decode GET data into a global hash, GET
define decode_query_string
GET ENVS 'QUERY_STRING' get '' prefer '&' decode_data
# decode POST data into a global hash, POST
define decode_standard_input
POST STDIN read '&' decode_data
# decode COOKIE data in a global hash, COOKIE
define decode_http_cookie
COOKIE ENVS 'HTTP_COOKIE' get '' prefer ';' decode_data
# create a named wildcard that will be replaced
define create_wildcard use $name , $replace
$replace $wildcards $name set
$name md5
# combine instance vars into a HTML document
define Display
# send headers
$headers each pair
"%s: %s\n" print
# extra line break to end headers
LF print
# read HTML doc template
$template read
# replace sections with instance var data
$vhost '<!--VHOST-->' replace
$title '<!--TITLE-->' replace
$head '<!--HEAD-->' replace
$body '<!--BODY-->' replace
# replace custom wildcards
$wildcards each pair md5 replace
# run post-processing callbacks
$callbacks each call
define debug_print
dup print LF print
call print LF print
DEBUG
if '<!--DEBUG-->' split as $sections
$sections shift print
'<pre>' print
'ENVS' debug_print
'GET' debug_print
'POST' debug_print
'COOKIE' debug_print
'</pre>' print
$sections shift print
else print
# initialize stuff
define Construct
decode_query_string
decode_standard_input
decode_http_cookie
# export GET, POST and COOKIE to the global scope
GET GLOBAL 'GET' set
POST GLOBAL 'POST' set
COOKIE GLOBAL 'COOKIE' set
# create an object 'HTML' in the global scope
Html as HTML
HTML . Construct
Html Class example:
#!/usr/bin/raven # load library 'html.lib.rv' require 'an example' HTML : $title 'hello world' HTML : $body HTML . Display
HTML Forms, html_form.lib.rv:
#!/usr/bin/raven
class Html_Form
# html id and html name prefix for inputs
"form_%s" as $id
# form control objects
new list as $items
new list as $errors
# default action
'' as $action
# default button text
'Submit' as $submit
# catch form's submission and auto import + validate POST data
define Catch
POST "%($id)ssubmit" get 0 prefer
if TRUE
new hash as $values
# import $items fields from POST
$items each as $item
# define expected name of $item's POST field
$item . $name "%($id)s_%s" as $key
# import POST field
POST $key get '' prefer trim $item : $value
# keep a copy of all items/fields in $values
$item . $value $values $item . $name set
# call each $item validation accumlulating the error
# code on the stack, preset above to TRUE
$items each as $item
# Check will pass an item's $value and the $values
# hash to each callback word to allow validation to
# be applied to more than one field at once.
$values $item . Check and
else FALSE
# build form's html
define Process
group
$submit copy HTML . encode_entities as $submit_safe
'<form id="%($id)s" action="%($action)s" method="POST">' format
'<table class="forum_form" border="0" cellspacing="0" cellpadding="0">'
# call each $item object to build html table rows. each item will add
# its own error messages and assuming Check has been called to get to
# this point, all previous or default data will be auto loaded.
$items each $id over : $prefix . Process
'<tr><td> <input name="%($id)ssubmit" type="hidden" value="1">' format
'</td><td><input type="submit" value="%($submit_safe)s"> ' format
# add a little red asterisk if this is a required field
FALSE $items each . $require or
if '<span style="color: #c0c0c0; font-size: smaller;">* Item is required.</span>'
'</td></tr>'
'</table></form>'
LF join
# base class for all form controls
class Html_Form_Input use $name
# left column
'' as $title
# default or current input value
'' as $value
# html name prefix
'' as $prefix
FALSE as $require
'Required!' as $require_msg
# error messages acumulate here via Check
new list as $errors
# validation callback words called by Check
new list as $checks
# html safe
define safe_vars
$value copy HTML . encode_entities
$name copy HTML . encode_entities
# build html for the input control itself
# this default method merely displays name/value and should only
# appear if this method has not been over ridden in extended classes
define Build
safe_vars as $name_safe , $value_safe
"%($name_safe)s : %($value_safe)s"
# call all validation words accumulating any $errors
define Check use $values
# reset $errors in case we're called more than once in a script
new list is $errors
# if an input is required, this check supercedes other validation
# checks and will disable those other checks until data is available
$require $value empty and
if $require_msg $errors push
else # only run validation callbacks if the field contains data. this
# means the only way to guarantee data is by using $require as well
$value empty not
if # call each callback passing it this item's $value and the
# $values hash passed by the parent form's Check method
$checks each as $word
# if a callback returns TRUE, this means the validation passed
# and there is no error message. if FALSE then the validation
# failed and there will be an error message on the stack.
$values $value $word call not
if $errors push
$errors empty
# build html for a form table row
define Process
Build as $input
$title copy HTML . encode_entities as $title_safe
$require
if '<span>*</span>'
else ''
as $extra
group $errors each
copy HTML . encode_entities
'<br><span>%s</span>' format
'' join as $errors
'<tr><td>%($title_safe)s</td><td>%($input)s %($extra)s %($errors)s</td></tr>' format
# text input
class Html_Form_Text extend Html_Form_Input
define Build
safe_vars as $name_safe , $value_safe
'<input type="text" name="%($prefix)s_%($name_safe)s" value="%($value_safe)s">' format
# password input
class Html_Form_Password extend Html_Form_Input
define Build
safe_vars as $name_safe , $value_safe
'<input type="password" name="%($prefix)s_%($name_safe)s" value="">' format
# textarea
class Html_Form_Textarea extend Html_Form_Input
define Build
safe_vars as $name_safe , $value_safe
'<textarea name="%($prefix)s_%($name_safe)s" rows="16" cols="72">%($value_safe)s</textarea>' format
Html_Form class example:
#!/usr/bin/raven
# load libraries
'html.lib.rv' require
'html_form.lib.rv' require
# page title
'Contact Us' HTML : $title
# build form
'contact_us' Html_Form as $form
'send_msg.rv' $form : $action
# name text input
'customer_name' Html_Form_Text as $cust_name
'Name' $cust_name : $title
'<your_name>' $cust_name : $value
TRUE $cust_name : $require
# email text input
'customer_email' Html_Form_Text as $cust_email
'Email' $cust_email : $title
'<your_email>' $cust_email : $value
FALSE $cust_email : $require
# add a valiadation callback word to the email field
# as email $require is false, this will be called only if data is entered
define validate_email use $email , $values
$email m/^[a-z0-9_.]+@[a-z0-9_.]+\.[a-z0-9_.]+$/i not
if 'Email does not look valid.' FALSE
else TRUE
'validate_email' $cust_email . $checks push
# message textarea
'customer_msg' Html_Form_Textarea as $cust_msg
'Message' $cust_msg : $title
TRUE $cust_msg : $require
# add control objects to the form
$cust_name $form . $items push
$cust_email $form . $items push
$cust_msg $form . $items push
# catch form submission and validate fields
$form . Catch
if # insert data into database or send an email...
# POST fields will have been validated and imported into each form field object.
$cust_name . $value HTML . encode_entities as $name
$cust_email . $value HTML . encode_entities as $email
$cust_msg . $value HTML . encode_entities as $message
group
'Thanks for your enquiry, <b>%($name)s</b>!'
'We will respond to you at <b>%($email)s</b> as soon as possible.'
''
'Message:<pre>%($message)s</pre>'
'<br>' join format HTML : $body
else # display form html
$form . Process HTML : $body
HTML . Display
eof