The Perl Toolchain Summit 2025 Needs You: You can help ๐Ÿ™ Learn more

YORHEL / TUWF-1.6 / examples / MyWebsite / InfoDump.pm 

            

              
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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123

              
#!/usr/bin/perl
# This example demonstrates how one can fetch request information
package MyWebsite::InfoDump;
use strict;
use warnings;
use TUWF ':html';
TUWF::any ['get','post'], '/info' => sub {
  my $tr = sub { Tr; td shift; td shift; end };
  html;
   head;
    style type => 'text/css';
     txt 'thead td { font-weight: bold }';
     txt 'td { border: 1px outset; padding: 3px }';
    end;
   end;
   body;
    h1 'TUWF Info Dump';
    p;
     txt 'You can use ';
     a href => '/info/forms', 'these forms';
     txt ' to generate some interesting GET/POST data.';
    end;
    h2 'GET Parameters';
    table;
     thead; Tr; td 'Name'; td 'Value'; end; end;
     $tr->($_, join "\n---\n", tuwf->reqGet($_)) for (tuwf->reqGets);
    end;
    h2 'POST Parameters';
    table;
     thead; Tr; td 'Name'; td 'Value'; end; end;
     $tr->($_, join "\n---\n", tuwf->reqPost($_)) for (tuwf->reqPosts);
    end;
    h2 'Uploaded files';
    table;
     thead; Tr; td 'Name'; td 'File size - File name - Mime type'; end; end;
     $tr->($_, length(tuwf->reqUploadRaw($_)).' - '.tuwf->reqPost($_).' - '.tuwf->reqUploadMIME($_)) for (tuwf->reqUploadMIMEs);
    end;
    h2 'HTTP Headers';
    table;
     thead; Tr; td 'Header'; td 'Value'; end; end;
     $tr->($_, tuwf->reqHeader($_)) for (tuwf->reqHeader);
    end;
    h2 'HTTP Cookies';
    table;
     thead; Tr; td 'Cookie'; td 'Value'; end; end;
     $tr->($_, tuwf->reqCookie($_)) for (tuwf->reqCookie);
    end;
    h2 'Misc. request functions';
    table;
     thead; Tr; td 'Function'; td 'Return value'; end; end;
     $tr->($_, tuwf->$_) for(qw{
       reqProtocol reqMethod reqPath reqBaseURI reqURI reqQuery reqHost reqIP
     });
    end;
  end;
};
TUWF::get '/info/forms' => sub {
  html;
   body;
    h1 'Forms for generating some input for /info';
    a href => '/info', 'Back to /info';
    h2 'GET';
    form method => 'GET', action => '/info';
     for (0..5) {
       input type => 'checkbox', name => 'checkthing', value => $_, id => "checkthing_$_", $_%2 ? (checked => 'checked') : ();
       label for => "checkthing_$_", "checkthing $_";
     }
     br;
     label for => 'textfield', 'Text field: ';
     input type => 'text', name => 'textfield', id => 'textfield', value => 'Hello Text Field!';
     br;
     input type => 'submit';
    end;
    h2 'POST (urlencoded)';
    form method => 'POST', action => '/info';
     for (0..5) {
       input type => 'checkbox', name => 'checkbox', value => $_, id => "checkbox_$_", $_%2 ? (checked => 'checked') : ();
       label for => "checkbox_$_", "checkbox $_";
     }
     br;
     label for => 'text', 'Text: ';
     use utf8;
     input type => 'text', name => 'text', id => 'text', value => 'ใ“ใ‚“ใซใกใฏ';
     br;
     input type => 'submit';
    end;
    h2 'POST (multipart)';
    form method => 'POST', action => '/info', enctype => 'multipart/form-data';
     for (0..5) {
       input type => 'checkbox', name => 'check', value => $_, id => "check_$_", $_%2 ? (checked => 'checked') : ();
       label for => "check_$_", "check $_";
     }
     br;
     label for => 'file1', 'File 1: '; input type => 'file', name => 'file1', id => 'file1';
     br;
     label for => 'file2', 'File 2: '; input type => 'file', name => 'file2', id => 'file2';
     br;
     input type => 'submit';
    end;
   end;
  end;
};
1;