contrib/httpd/embedded.factor

   1 ! Copyright (C) 2005 Alex Chapman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: embedded
   4 USING: sequences kernel parser math namespaces io html test ;
   5
   6 ! if example.fhtml contains:
   7 ! <html>
   8 !     <head><title>Simple Embedded Factor Example</title></head>
   9 !     <body>
  10 !       <% 5 [ %><p>I like repetition</p>
  11 !       <% drop ] each %>
  12 !     </body>
  13 ! </html>
  14 !
  15 ! then "example.fhtml" run-embedded-file prints to stdout:
  16 ! <html>
  17 !     <head><title>Simple Embedded Factor Example</title></head>
  18 !     <body>
  19 !         <p>I like repetition</p>
  20 !         <p>I like repetition</p>
  21 !         <p>I like repetition</p>
  22 !         <p>I like repetition</p>
  23 !         <p>I like repetition</p>
  24 !
  25 !     </body>
  26 ! </html>
  27
  28 : get-text ( string -- remainder chunk )
  29     "<%" over start dup -1 = [
  30             drop "" swap
  31     ] [
  32             2dup head >r tail r>
  33     ] if ;
  34
  35 : get-embedded ( string -- string code-string )
  36     ! regexps where art thou?
  37     "%>" over 2 start* 2dup swap 2 -rot subseq >r 2 + tail r> ;
  38
  39 : get-first-chunk ( string -- string )
  40     dup "<%" head? [
  41             get-embedded parse %
  42     ] [
  43             get-text , \ write-html ,
  44     ] if ;
  45
  46 : embedded>factor ( string -- )
  47     dup length 0 > [
  48             get-first-chunk embedded>factor
  49     ] [ drop ] if ;
  50
  51 : parse-embedded ( string -- quot )
  52     #! simple example: "numbers: <% 3 [ 1 + pprint ] each %>"
  53     #! => "\"numbers: \" write 3 [ 1 + pprint ] each"
  54     [ embedded>factor ] [ ] make ;
  55
  56 : eval-embedded ( string -- ) parse-embedded call ;
  57
  58 : run-embedded-file ( filename -- )
  59     [
  60         [
  61             file-vocabs
  62             dup file set ! so that reload works properly
  63             dup <file-reader> contents eval-embedded
  64         ] with-scope
  65     ] assert-depth drop ;
  66
  67 : embedded-convert ( infile outfile -- )
  68     <file-writer> [ run-embedded-file ] with-stream ;