\ 4tH PHP Generator - Copyright 2004, 2014 J.L. Bezemer
\ You can redistribute this file and/or modify it under
\ the terms of the GNU General Public License

include lib/anscore.4th                \ for 2OVER
include lib/back.4th                   \ for BACK
include lib/split.4th                  \ for -SPLIT
include lib/leading.4th                \ for -LEADING
include lib/ascii7.4th                 \ for S>ASCII7
include lib/search.4th                 \ for SEARCH
include lib/row.4th                    \ for ROW
include lib/getopts.4th                \ for GET-ARGUMENT
                                       \ SQL string buffer
8192 constant #SQL
#SQL string SQL
                                       \ SQL fields buffer
2048 constant #Fields
#Fields string Fields

128 constant /title                    \ optional title for PHP page
/title string title s" Generated by 4tH PHPGen" title place
                                       \ initialize the title
16 constant /dsn                       \ optional DSN for PHP page
/dsn string dsn s" CMS" dsn place      \ initialize the DSN

variable 'Fields                       \ pointer to fields buffer
variable common                        \ vector to common character parser
variable quote                         \ vector to quote character parser
variable name                          \ vector to name character parser

defer is-quote                         \ vector to quote check
defer parse-char                       \ vector to character parser

: char! over c! char+ ;  ( a c -- a+1) \ store a character in SQL buffer
: char@ swap dup c@ >r char+ swap r> dup dup ; ( a1 a2 -- a1+1 a2 c c c)
                                       \ read a character from SQL buffer
: 'quote [char] ' = ;    ( c c -- c f) \ check for quote
: >quote drop [char] ' ; ( c -- ')     \ replace char by quote
                                       \ check for double quote
: "quote [char] " =                    ( c c -- c f)
  dup if swap >quote swap then
;
                                       \ check if character fit for name
: is-name                              ( c c -- c f)
  dup [char] ] =
  if drop drop r> drop common @ is parse-char
  else is-alnum
  then
;
                                       \ set parser to name convention
: set-name                             ( c c -- c f)
  name @ is parse-char true
;
                                       \ set parser to double quote convention
: set-dquote                           ( c c -- c f)
  ['] "quote is is-quote
  quote @ is parse-char
  >quote false
;
                                       \ set parser to quote convention
: set-quote                            ( c c -- c f)
  ['] 'quote is is-quote
  quote @ is parse-char false
;
                                       \ table with mode switcher addresses
create specials
   char [  , ' set-name ,
   char "  , ' set-dquote ,
   char '  , ' set-quote ,
   NULL ,
                                       \ check if character is a 'special'
: is-special                           ( c c -- c f)
  specials 2 num-key row
  if nip cell+ @c execute else drop drop false then
;
                                       \ set vectors to checks
:noname is-special not if char! else drop then ; common !
:noname is-name    not if drop [char] _ then char! ; name !
:noname is-quote   if common @ is parse-char then char! ; quote !
                                       \ print a string and cr
: dup-type 2dup type ;   ( a n -- a n) \ non destructive type
: write type cr ;                      ( a n --)
                                       \ print the PHP header
: PrintHeader                          ( --)
  s| <?php| write
  s| require ("StdLib.lib.php");| write
  cr
  s| function Output_Entries ($SQLstr, $uid, $pwd) {| write
  s|   $cur = SQLConnect (| type dsn count type
  s| , $SQLstr, $uid, $pwd);| write
  cr
  s|   echo "<br><table class='rws' CELLSPACING='0' CELLPADDING='4' RULES='all'><tr>".| write
;
                                       \ print the PHP loop
: PrintLoop                            ( --)
  s|   "</tr>\n";| write
  cr
  s|   $nbrow=0;| write
  s|   while (SQLFetch ($cur)) {| write
  s|     $nbrow++;| write
;
                                       \ print the PHP tail
: PrintTail                            ( --)
  s|     "</tr>\n";| write
  s|   }| write 
  cr
  s|   echo "<tr><td class='rephead' colspan=16>$nbrow records gevonden </td></tr></table>";| write 
  s|   SQLDisconnect ($cur);| write
  s| } | write
  cr
  s| $SQLstr ="| write SQL count write \ write the Transact SQL text
  s| ";| write
  cr
  s| $strOldEntries = "| type title count type s| ";| write
  s| $Buttons = array (PreviousURL(), SendExcel (| type dsn count type
  s| , $SQLstr, $strOldEntries));| write
  s| session_start();| write
  cr
  s| HTML_Head($strOldEntries);| write
  s| Database_Entries($strOldEntries);| write
  s| Output_Entries($SQLstr, $_SESSION['username'], $_SESSION['password']);| write
  s| HTML_Foot($Buttons);| write
  cr  
  s| ?>| write
;

: NextField chars + char+ ;            \ move to next field
                                       \ return string after char
: SplitField                           ( a n c -- a' n')
  >r 2dup r> back -split 2swap 2drop
;
                                       \ scan string for field
: GetField                             ( a n --)
  [char] . SplitField bl SplitField
  tuck 'Fields @ place char+ 'Fields +!
;
                                       \ print all fields with l/t tags
: PrintTags                            ( a1 n1 a2 n2 a3 --)
  begin
    count dup 0>                       \ field non-zero length?
  while                                \ if so,
    2>r dup-type                       \ type the leading tag
    2swap 2r> dup-type                 \ type the field
    2over type cr                      \ type the trailing tag
    NextField                          \ move to next field
    >r 2swap r>                        \ swap tags
  repeat
  2drop 2drop 2drop                    \ drop field and tags
;
                                       \ print all fields with counts
: PrintCounts                          ( a1 n1 n2 a2 --)
  begin
    count dup 0>                       \ field non-zero length?
  while                                \ if so,
    4 spaces [char] $ emit             \ type a leading $
    dup-type                           \ type the field
    NextField >r >r                    \ move to next field
    dup-type r> r>                     \ type the tag
    swap dup . 1+ swap                 \ print the count
    s| );| write                       \ write a closing );
  repeat
  2drop drop 2drop                     \ drop the field, count and tag
;
                                       \ scan for fields in SQL
: SQLGetFields                         ( --)
  begin                                \ parsed string non-zero length?
    [char] , parse-word -leading -trailing dup 0= >r
    2dup chars + char- c@ is-alnum     \ check whether last char is alnum
    if GetField else 2drop then        \ if so store field else drop string
    r>                                 \ until zero length string found
  until
;
                                       \ translate SQL to Transact SQL
: TranslateSQL                         ( a a --)
  common @ is parse-char               \ begin in common mode
  begin char@ while parse-char repeat  \ parse char if not null
  drop char! drop drop                 \ terminate SQL text and clean up
;
                                       \ scan the SQL file for fields
: ScanSQL                              ( --)
  Fields 'Fields ! bl 0 dup            \ set the temp pointer
  SQL #SQL 2dup 2dup source! accept    \ read in the entire file
  tuck = abort" File too large"        \ check for size, abort on error
  s>ascii7 drop dup dup                \ remove control characters
  TranslateSQL count s"  FROM" search  \ translate the file, look for FROM
  0= abort" Not a valid SQL statement" \ cannot be a SQL statement
  drop tuck c! swap >in !              \ terminate the file there
  SQLGetFields c!                      \ scan for all the fields
;
                                       \ print the PHP file
: PrintPHP                             ( --)
  PrintHeader
  s| </td>".| s|   "<td CLASS='coldarkbold'>| Fields PrintTags
  PrintLoop 
  s| = SQLColumn ($cur, | 1 Fields PrintCounts
  cr
  s|     echo "<tr>".| write
  s| </td>".| s|     "<td CLASS='repheadsmall'>$| Fields PrintTags
  PrintTail
;
                                       \ some CONVERT.4TH words
: Usage abort" Usage: PHPGen [-d dsn] [-t title] sql-file php-file" ;
: Process ScanSQL PrintPHP ;
                                       \ define some options
: get-title get-argument /title 1- min title place ;
: get-dsn get-argument /dsn 1- min dsn place ;

create options  char t , ' get-title , char d , ' get-dsn , NULL ,

include lib/convert.4th                \ get's get it over with
