Wapp

Check-in [bf65f413cf]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Change wapp-debug-puts-env to just wapp-debug-env.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: bf65f413cf787fa740f361c6a8d23df5b582afbec03eac7cb91deb8e06e81fc4
User & Date: drh 2018-01-30 17:06:56.736
Context
2018-01-30
17:28
Support the -Dvariable=value option to set global TCL variables. (check-in: 6fa89b7c98 user: drh tags: trunk)
17:06
Change wapp-debug-puts-env to just wapp-debug-env. (check-in: bf65f413cf user: drh tags: trunk)
16:09
Pass the HTTPS CGI parameter through to the application code. (check-in: 622563732a user: drh tags: trunk)
Changes
Unified Diff Ignore Whitespace Patch
Changes to test01.tcl. 
1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32






33
34
35
36
37
38
39

# Invoke as "tclsh test01.tcl" and then surf the website that pops up
# to verify the logic in wapp.
#
source wapp.tcl
proc wapp-default {} {
  global wapp
  set B [wapp-param BASE_URL]
  set R [wapp-param SCRIPT_NAME]
  wapp-cache-control max-age=15
  wapp "<h1>Hello, World!</h1>\n"
  wapp "<ol>"
  wapp-unsafe "<li><p><a href='$R/env'>Wapp Environment</a></p>\n"

  wapp-subst {<li><p><a href='%html($B)/fullenv'>Full Environment</a>\n}
  set crazy [lsort [dict keys $wapp]]
  wapp-subst {<li><p><a href='%html($B)/env?keys=%url($crazy)'>}
  wapp "Environment with crazy URL</a>\n"
  wapp-trim {
    <li><p><a href='%html($B)/lint'>Lint</a>
    <li><p><a href='%html($B)/errorout'>Deliberate error</a>
    <li><p><a href='%html($B)/encodings'>Encoding checks</a>
    <li><p><a href='%html($B)/redirect'>Redirect to env</a>
  }
  set x "%string(...)"
  set v abc'def\"ghi\\jkl
  wapp-subst {<li>%html($x) substitution test: "%string($v)"\n}
  wapp "</ol>"
  if {[dict exists $wapp showenv]} {
    wapp-page-env
  }
}
proc wapp-page-redirect {} {
  wapp-redirect env






}
proc wapp-page-env {} {
  global wapp
  wapp-set-cookie env-cookie simple
  wapp "<h1>Wapp Environment</h1>\n"
  wapp-unsafe "<form method='GET' action='[wapp-param SELF_URL]'>\n"
  wapp "<input type='checkbox' name='showhdr'"













>
|



















>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46

# Invoke as "tclsh test01.tcl" and then surf the website that pops up
# to verify the logic in wapp.
#
source wapp.tcl
proc wapp-default {} {
  global wapp
  set B [wapp-param BASE_URL]
  set R [wapp-param SCRIPT_NAME]
  wapp-cache-control max-age=15
  wapp "<h1>Hello, World!</h1>\n"
  wapp "<ol>"
  wapp-unsafe "<li><p><a href='$R/env'>Wapp Environment</a></p>\n"
  wapp-subst {<li><p><a href='env2'>Environment using wapp-debug-env</a>\n}
   wapp-subst {<li><p><a href='%html($B)/fullenv'>Full Environment</a>\n}
  set crazy [lsort [dict keys $wapp]]
  wapp-subst {<li><p><a href='%html($B)/env?keys=%url($crazy)'>}
  wapp "Environment with crazy URL</a>\n"
  wapp-trim {
    <li><p><a href='%html($B)/lint'>Lint</a>
    <li><p><a href='%html($B)/errorout'>Deliberate error</a>
    <li><p><a href='%html($B)/encodings'>Encoding checks</a>
    <li><p><a href='%html($B)/redirect'>Redirect to env</a>
  }
  set x "%string(...)"
  set v abc'def\"ghi\\jkl
  wapp-subst {<li>%html($x) substitution test: "%string($v)"\n}
  wapp "</ol>"
  if {[dict exists $wapp showenv]} {
    wapp-page-env
  }
}
proc wapp-page-redirect {} {
  wapp-redirect env
}
proc wapp-page-env2 {} {
  wapp-trim {
    <h1>Wapp Environment using wapp-debug-env</h1>
    <pre>%html([wapp-debug-env])</pre>
  }
}
proc wapp-page-env {} {
  global wapp
  wapp-set-cookie env-cookie simple
  wapp "<h1>Wapp Environment</h1>\n"
  wapp-unsafe "<form method='GET' action='[wapp-param SELF_URL]'>\n"
  wapp "<input type='checkbox' name='showhdr'"
︙︙
Changes to wapp.tcl.
︙︙
248
249
250
251
252
253
254
255
256
257
258
259
260
261

262
263
264
265

266
267
268
269
270
271
272

        append res "$p:$ln: unsafe \"wapp-subst\" call: \"[string trim $x]\"\n"
      }
    }
  }
  return $res
}

# Applications under development can invoke this routine to cause the
# environment for the current request to be written to standard output,
# as a debugging aid.  This routine has no place in a production
# application
#
proc wapp-debug-puts-env {} {
  global wapp

  foreach var [lsort [dict keys $wapp]] {
    if {[string index $var 0]=="."} continue
    puts "$var = [list [dict get $wapp $var]]"
  }

}

# Start up the wapp framework.  Parameters are a list passed as the
# single argument.
#
#    -server $PORT         Listen for HTTP requests on this TCP port $PORT
#








|
<
|
<

|

>


|

>








248
249
250
251
252
253
254
255

256

257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272

        append res "$p:$ln: unsafe \"wapp-subst\" call: \"[string trim $x]\"\n"
      }
    }
  }
  return $res
}

# Return a string that descripts the current environment.  Applications

# might find this useful for debugging.

#
proc wapp-debug-env {} {
  global wapp
  set out {}
  foreach var [lsort [dict keys $wapp]] {
    if {[string index $var 0]=="."} continue
    append out "$var = [list [dict get $wapp $var]]\n"
  }
  return $out
}

# Start up the wapp framework.  Parameters are a list passed as the
# single argument.
#
#    -server $PORT         Listen for HTTP requests on this TCP port $PORT
#
︙︙