File: envtest.fcgi

package info (click to toggle)
libnet-async-fastcgi-perl 0.26-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 284 kB
  • sloc: perl: 2,308; makefile: 2
file content (64 lines) | stat: -rwxr-xr-x 1,337 bytes parent folder | download
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
#!/usr/bin/perl -w

use v5.14;

use IO::Async::Loop;

my $loop = IO::Async::Loop->new();

$loop->add( Example::EnvTestResponder->new( handle => \*STDIN ) );

$loop->run;

package Example::EnvTestResponder;
use base qw( Net::Async::FastCGI );

sub on_request
{
   my $self = shift;
   my ( $req ) = @_;

   my $env = $req->params();

   my $page = "";

   my $path = $env->{PATH_INFO} || "/";
   my $qs   = $env->{QUERY_STRING} || "";

   my %queryparams = map { m/^(.*?)=(.*)$/ && ( $1, $2 ) } split( m/&/, $qs );

   $page = "<h1>Request Variables</h1>\n";
   
   $page .= "<h2>Basics</h2>\n" .
           "<p>Path: <tt>$path</tt></p>\n";

   if ( keys %queryparams ) {
      $page .= "<h2>Query parameters</h2>\n" .
              "<table border=\"1\">\n";

      foreach my $key ( sort keys %queryparams ) {
         $page .= "<tr><td>$key</td><td><tt>$queryparams{$key}</tt></td></tr>\n";
      }

      $page .= "</table>\n";
   }

   $page .= "<h2>Environment variables</h2>\n";

   $page .= "<table>\n";

   foreach my $key ( sort keys %$env ) {
      $page .= "<tr><td>$key</td><td><tt>$env->{$key}</tt></td></tr>\n";
   }

   $page .= "</table>\n";

   $req->print_stdout(
      "Content-type: text/html\r\n" .
      "Content-length: " . length( $page ) . "\r\n" .
      "\r\n" .
      $page . "\r\n"
   );

   $req->finish();
}