Raven Examples - Web CGI Toolkit
Web CGI Toolkit
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
Example HTML object use:
#!/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
Example of Html_Form use:
#!/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
