Browse files

first commit

  • Loading branch information...
0 parents commit 1462b58c30b69c00fdfa374f0658d0aa6da7086e @davorg committed Dec 9, 2010
Showing with 370 additions and 0 deletions.
  1. +11 −0 app.psgi
  2. +32 −0 debug.psgi
  3. +5 −0 dir.psgi
  4. +13 −0 dump.psgi
  5. +15 −0 dump2.psgi
  6. +16 −0 dump3.psgi
  7. +17 −0 error.psgi
  8. +103 −0 form.psgi
  9. +11 −0 hello.cgi
  10. +69 −0 listing.psgi
  11. +20 −0 runtime.psgi
  12. +11 −0 time.psgi
  13. +9 −0 time.tt
  14. +23 −0 time2.psgi
  15. +15 −0 time3.psgi
11 app.psgi
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+my $app = sub {
+ my $env = shift;
+
+ return [
+ 200,
+ [ 'Content-type', 'text/plain' ],
+ [ 'Hello world' ],
+ ]
+};
32 debug.psgi
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Plack::Builder;
+
+my $app = sub {
+ my $env = shift;
+
+ return [
+ 200,
+ [ 'Content-type', 'text/html' ],
+ [ <DATA> ],
+ ]
+};
+
+builder {
+ enable 'Debug';
+ $app;
+}
+
+__DATA__
+<html>
+ <head>
+ <title>Test</title>
+ </head>
+ <body>
+ <h1>Test</h1>
+ <p>This is a test</p>
+ </body>
+</html>
5 dir.psgi
@@ -0,0 +1,5 @@
+use Plack::App::Directory;
+
+my $app = Plack::App::Directory->new({
+ root => '/home/dave/Dropbox/psgi',
+})->to_app;
13 dump.psgi
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+use Data::Dumper;
+
+my $app = sub {
+ my $env = shift;
+
+ return [
+ 200,
+ [ 'Content-type', 'text/plain' ],
+ [ Dumper $env ],
+ ];
+}
15 dump2.psgi
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+
+use Plack::Request;
+use Data::Dumper;
+
+my $app = sub {
+
+ my $req = Plack::Request->new(shift);
+
+ return [
+ 200,
+ [ 'Content-type', 'text/plain' ],
+ [ Dumper $req ],
+ ];
+}
16 dump3.psgi
@@ -0,0 +1,16 @@
+#!/usr/bin/perl
+
+use Plack::Request;
+use Plack::Response;
+use Data::Dumper;
+
+my $app = sub {
+
+ my $req = Plack::Request->new(shift);
+
+ my $res = Plack::Response->new(200);
+ $res->content_type('text/plain');
+ $res->body(Dumper $req);
+
+ return $res->finalize;
+}
17 error.psgi
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Plack::Builder;
+use HTTP::Exception;
+
+my $app = sub {
+ HTTP::Exception::500->throw(status_message => 'Everything is fine');
+};
+
+builder {
+ enable 'HTTPExceptions';
+ $app;
+};
+
103 form.psgi
@@ -0,0 +1,103 @@
+#!/usr/bin/perl
+
+use Plack::Request;
+use Data::Dumper;
+
+my $app = sub {
+
+ my $req = Plack::Request->new(shift);
+
+ my $content;
+ if (keys %{$req->parameters}) {
+ $content = response($req);
+ } else {
+ $content = form();
+ }
+
+ return [
+ 200,
+ [ 'Content-type', 'text/html' ],
+ [ $content ],
+ ];
+};
+
+sub response {
+ my $req = shift;
+
+ my $name = $req->parameters->{name};
+ my $age = $req->parameters->{age};
+ my $gender = $req->parameters->{gender};
+ my $hobbies = join ', ', $req->parameters->get_all('hobby');
+ $hobbies = 'None' unless $hobbies;
+
+ return <<END_OF_HTML;
+<html>
+ <head>
+ <title>$name</title>
+ </head>
+ <body>
+ <h1>Welcome $name</h1>
+ <p>Here are your details:</p>
+ <table>
+ <tr><th>Name:</th><td>$name</td></th><tr>
+ <tr><th>Age:</th><td>$age</td></th><tr>
+ <tr><th>Gender:</th><td>$gender</td></th><tr>
+ <tr><th>Hobbies:</th><td>$hobbies</td></th><tr>
+ </table>
+ </body>
+</html>
+END_OF_HTML
+}
+
+sub form {
+ return <<END_OF_FORM;
+<html>
+ <head>
+ <title>Test Form</title>
+ </head>
+ <body>
+ <h1>Test Form</h1>
+ <p>Tell us about yourself.</p>
+ <form method="get">
+ <table>
+ <tr>
+ <td>Name:</td>
+ <td><input type="text" name="name"><td>
+ </tr>
+ <tr>
+ <td>Age:</td>
+ <td><select name="age" size="1">
+ <option>Under 15</option>
+ <option>15 - 25</option>
+ <option>26 - 35</option>
+ <option>36 - 45</option>
+ <option>Over 45</option>
+ </select></td>
+ </tr>
+ <tr>
+ <td>Gender:</td>
+ <td><input type="radio" name="gender"
+ value="Male">Male
+ <input type="radio" name="gender"
+ value="Female">Female</td>
+ </tr>
+ <tr>
+ <td>Hobbies:</td>
+ <td><input type="checkbox" name="hobby"
+ value="Sport">Sport
+ <input type="checkbox" name="hobby"
+ value="Music">Music
+ <input type="checkbox" name="hobby"
+ value="Reading">Reading
+ <input type="checkbox" name="hobby"
+ value="Beer">Beer</td>
+ </tr>
+ <tr>
+ <td colspan="2"><input type="submit"></td>
+ </tr>
+ </table>
+ </form>
+ </body>
+</html>
+END_OF_FORM
+}
11 hello.cgi
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+my $app = sub {
+ my $env = shift;
+
+ return [
+ 200,
+ [ 'Content-type', 'text/plain' ],
+ [ 'Hello world' ],
+ ]
+};
69 listing.psgi
@@ -0,0 +1,69 @@
+use strict;
+use warnings;
+
+use Plack::Util;
+use Template;
+
+my $app = sub {
+ my $env = shift;
+
+ my $body;
+ if ($env->{PATH_INFO} =~ m|^/show/(.+)|) {
+ $body = show_file($1);
+ } elsif ($env->{PATH_INFO} =~ m|^/run/(.+)|) {
+ return run_file($1, $env);
+ } else {
+ $body = list_files();
+ }
+
+ return [
+ 200,
+ [ Content_type => 'text/html' ],
+ [ $body ]
+ ];
+};
+
+sub show_file {
+ my $file = shift;
+
+ my $fh;
+ open $fh, $file;
+ return do { local $/; <$fh> };
+}
+
+sub run_file {
+ my ($file, $env) = @_;
+
+ my $new_app = Plack::Util::load_psgi($file);
+
+ return Plack::Util::run_app $new_app, $env;
+}
+
+sub list_files {
+ opendir(my $dir, '.');
+ my @files = sort readdir($dir);
+
+ my $tt = Template->new;
+ $tt->process(\*DATA, { files => \@files }, \my $body);
+
+ return $body;
+}
+
+__DATA__
+<html>
+ <head>
+ <title>PSGI Files</title>
+ </head>
+ <body>
+ <h1>PSGI Files</h1>
+ <ul>
+[% FOREACH file IN files -%]
+[% NEXT IF file.match('^\.') -%]
+ <li>[% file %]
+ <a href="show/[% file %]">show</a>
+[% NEXT UNLESS file.match('\.psgi$') -%]
+ <a href="run/[% file %]">run</a></li>
+[% END -%]
+ </ul>
+ </body>
+</html>
20 runtime.psgi
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+
+use Plack::Builder;
+
+my $app = sub {
+ my $env = shift;
+
+ return [
+ 200,
+ [ 'Content-type', 'text/plain' ],
+ [ 'Hello world' ],
+ ]
+};
+
+builder {
+ enable 'Runtime';
+ enable 'XFramework', framework => 'MyFramework';
+ $app;
+}
+
11 time.psgi
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+my $app = sub {
+ my $env = shift;
+
+ return [
+ 200,
+ [ 'Content-type', 'text/plain' ],
+ [ scalar localtime ],
+ ]
+};
9 time.tt
@@ -0,0 +1,9 @@
+<html>
+ <head>
+ <title>Time</title>
+ </head>
+ <body>
+ <h1>Time</h1>
+ <p>The time is: [% time %].</p>
+ </body>
+</html>
23 time2.psgi
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+
+my $app = sub {
+ my $env = shift;
+
+ my $now = localtime;
+
+ return [
+ 200,
+ [ 'Content-type', 'text/html' ],
+ [
+"<html>
+ <head>
+ <title>Time</title>
+ </head>
+ <body>
+ <h1>Time</h1>
+ <p>The time is $now</p>
+ </body>
+</html>"
+ ]
+ ]
+};
15 time3.psgi
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+use Template;
+my $app = sub {
+ my $tt = Template->new;
+ my $out;
+ $tt->process('time.tt',
+ { time => scalar localtime },
+ \$out) or die $tt->error;
+
+ return [
+ 200,
+ [ 'Content-type', 'text/html' ],
+ [ $out ]
+ ]
+};

0 comments on commit 1462b58

Please sign in to comment.