eg/plpinfo.plp

   1 <html>
   2
   3 <head>
   4 <title>plpinfo()</title>
   5 <style>
   6         body {background:#FFF; color:#000; font-family:sans-serif}
   7         table, h1 {width:45em; margin:1ex auto}
   8         table, h1 {border:1px solid #000; border-collapse:collapse}
   9         tr {background:#CCC; color:#000}
  10         th, td {text-align:left; vertical-align:baseline}
  11         th, td, h1 {padding:0.1ex 0.2em}
  12         th {background:#CCF; width:33%}
  13         h1 {font-size:150%; width:30em; background:#99C; color:#000}
  14         h2 {font-size:125%; text-align:center}
  15         i {color:#666}
  16 </style>
  17 </head>
  18
  19 <body>
  20 <h1>PLP Version <:= $PLP::VERSION :></h1>
  21
  22 <table border="1">
  23 <:
  24 use Config;
  25 printf "<tr><th>%s</th><td>%s</td></tr>\n", @$_ for (
  26         ["System"     => qx(uname -snrvm)],
  27         ["Server API" => $PLP::interface ? $PLP::interface : "?"],
  28         ["Perl"       => sprintf '%vd', $^V],
  29         ["Perl API"   => $Config{api_versionstring} || "?"],
  30         ["Build Date" => $Config{cf_time} || "?"],
  31         ["Debug Build" => $^P ? "yes ($^P)" : "no"],
  32         ["Thread Safety" => $Config{usethreads} ? "enabled" : "disabled"],
  33         ["Include Path" => join "; ", @INC],
  34 );
  35 :></table>
  36
  37 <h2>PLP Core</h2>
  38
  39 <table border="1">
  40 <:
  41 my %modules;
  42 s!/!::!g, s/\.pm$// and $modules{$_} = $_->VERSION || "" for keys %INC;
  43 printf "<tr><th>%s</th><td>%s</td></tr>\n", @$_ for (
  44         ["Loaded Modules" => join "<br>\n",
  45                 map "$_ $modules{$_}", sort grep /^PLP/, keys %modules
  46         ],
  47         ["Debug Output" => join("; ",
  48                 $PLP::DEBUG & 1 ? "run-time errors" : (),
  49                 $PLP::DEBUG & 2 ? "headers" : (),
  50         ) || "disabled"],
  51         ["Caching" => $PLP::use_cache ? "on" : "off"], #TODO
  52 );
  53 :></table>
  54
  55 <h2>Environment</h2>
  56
  57 <table border="1">
  58 <:
  59 s/(?<=,)/<wbr>/g for values %ENV; # allow breaks at commas (HTTP_ACCEPT*)
  60 printf("<tr><th>%s</th><td>%s</td></tr>\n",
  61         $_, defined $ENV{$_} ? $ENV{$_} : "<i>no value</i>"
  62 ) for sort keys %ENV;
  63 :></table>
  64
  65 <h2>PLP Variables</h2>
  66
  67 <table border="1">
  68 <:
  69 for my $var (qw[ get post cookies header ]) {
  70         printf("<tr><th>%s{'%s'}</th><td>%s</td></tr>\n",
  71                 $var, $_, defined $$var{$_} ? $$var{$_} : "<i>no value</i>"
  72         ) for sort keys %$var;
  73 }
  74 :></table>
  75
  76 </body>
  77 </html>