Permalink
Browse files

Initial commit

  • Loading branch information...
0 parents commit 95b12c39b718f25f38920815de3d448f07bce81c @miyagawa miyagawa committed Sep 13, 2009
Showing with 234 additions and 0 deletions.
  1. +5 −0 .gitignore
  2. +2 −0 .shipit
  3. +4 −0 Changes
  4. +30 −0 MANIFEST
  5. +14 −0 MANIFEST.SKIP
  6. +10 −0 Makefile.PL
  7. +27 −0 README
  8. +116 −0 lib/Squatting/On/PSGI.pm
  9. +4 −0 t/00_compile.t
  10. +5 −0 xt/perlcritic.t
  11. +4 −0 xt/pod.t
  12. +9 −0 xt/podspell.t
  13. +4 −0 xt/synopsis.t
@@ -0,0 +1,5 @@
+META.yml
+Makefile
+inc/
+pm_to_blib
+*~
@@ -0,0 +1,2 @@
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN
+git.push_to = origin
@@ -0,0 +1,4 @@
+Revision history for Perl extension Squatting::On::PSGI
+
+0.01 Sun Sep 13 17:51:05 2009
+ - original version
@@ -0,0 +1,30 @@
+.gitignore
+Changes
+inc/Module/Install.pm
+inc/Module/Install/AuthorTests.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Repository.pm
+inc/Module/Install/TestBase.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+inc/Spiffy.pm
+inc/Test/Base.pm
+inc/Test/Base/Filter.pm
+inc/Test/Builder.pm
+inc/Test/Builder/Module.pm
+inc/Test/More.pm
+lib/Squatting/On/PSGI.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/00_compile.t
+xt/perlcritic.t
+xt/pod.t
+xt/podspell.t
+xt/synopsis.t
@@ -0,0 +1,14 @@
+\bRCS\b
+\bCVS\b
+\.svn/
+\.git/
+^MANIFEST\.
+^Makefile$
+~$
+\.old$
+^blib/
+^pm_to_blib
+^MakeMaker-\d
+\.gz$
+\.cvsignore
+\.shipit
@@ -0,0 +1,10 @@
+use inc::Module::Install;
+name 'Squatting-On-PSGI';
+all_from 'lib/Squatting/On/PSGI.pm';
+
+build_requires 'Test::More';
+use_test_base;
+auto_include_deps;
+author_tests('xt');
+auto_set_repository;
+WriteAll;
27 README
@@ -0,0 +1,27 @@
+This is Perl module Squatting::On::PSGI.
+
+INSTALLATION
+
+Squatting::On::PSGI installation is straightforward. If your CPAN shell is set up,
+you should just be able to do
+
+ % cpan Squatting::On::PSGI
+
+Download it, unpack it, then build it as per the usual:
+
+ % perl Makefile.PL
+ % make && make test
+
+Then install it:
+
+ % make install
+
+DOCUMENTATION
+
+Squatting::On::PSGI documentation is available as in POD. So you can do:
+
+ % perldoc Squatting::On::PSGI
+
+to read the documentation online with your favorite pager.
+
+Tatsuhiko Miyagawa
@@ -0,0 +1,116 @@
+package Squatting::On::PSGI;
+
+use strict;
+use 5.008_001;
+our $VERSION = '0.01';
+
+use CGI::PSGI;
+use CGI::Cookie;
+use Squatting::H;
+
+# p for private
+my %p;
+$p{init_cc} = sub {
+ my ($c, $env) = @_;
+ my $cc = $c->clone;
+ $cc->env = $env;
+ $cc->cookies = $p{c}->($env->{HTTP_COOKIE});
+ $cc->input = $p{i}->($env);
+ $cc->headers = { 'Content-Type' => 'text/html' };
+ $cc->v = { };
+ $cc->status = 200;
+ $cc;
+};
+
+# \%input = i($env) # Extract CGI parameters from an env object
+$p{i} = sub {
+ local *ENV = $_[0];
+ my $q = CGI->new;
+ my %i = $q->Vars;
+ +{ map {
+ if ($i{$_} =~ /\0/) {
+ $_ => [ split("\0", $i{$_}) ];
+ } else {
+ $_ => $i{$_};
+ }
+ } keys %i }
+};
+
+# \%cookies = $p{c}->($cookie_header) # Parse Cookie header(s).
+$p{c} = sub {
+ +{ map { ref($_) ? $_->value : $_ } CGI::Cookie->parse($_[0]) };
+};
+
+sub psgi {
+ my ($app, $env) = @_;
+
+ $env->{PATH_INFO} ||= "/";
+ $env->{REQUEST_PATH} ||= do {
+ my $script_name = $env->{SCRIPT_NAME};
+ $script_name =~ s{/$}{};
+ $script_name . $env->{PATH_INFO};
+ };
+ $env->{REQUEST_URI} ||= do {
+ ($env->{QUERY_STRING})
+ ? "$env->{REQUEST_PATH}?$env->{QUERY_STRING}"
+ : $env->{REQUEST_PATH};
+ };
+
+ my $res;
+ eval {
+ no strict 'refs';
+ my ($c, $args) = &{ $app . "::D" }($env->{REQUEST_PATH});
+ my $cc = $p{init_cc}->($c, $env);
+ my $content = $app->service($cc, @$args);
+
+ $res = [
+ $cc->status,
+ [ %{ $cc->{headers} } ],
+ [ $content ],
+ ];
+ };
+
+ if ($@) {
+ $res = [ 500, [ 'Content-Type' => 'text/plain' ], [ "<pre>$@</pre>" ] ];
+ }
+
+ return $res;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Squatting::On::PSGI - Run Squatting app on PSGI
+
+=head1 SYNOPSIS
+
+ # app.psgi
+ use App 'On::PSGI';
+ App->init;
+
+ my $handler = sub {
+ my $env = shift;
+ App->psgi($env);
+ };
+
+=head1 DESCRIPTION
+
+Squatting::On::PSGI is an adapter to run Squatting apps on PSGI implementations.
+
+=head1 AUTHOR
+
+Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Squatting::On::CGI> L<CGI::PSGI>
+
+=cut
@@ -0,0 +1,4 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok 'Squatting::On::PSGI' }
@@ -0,0 +1,5 @@
+use strict;
+use Test::More;
+eval q{ use Test::Perl::Critic };
+plan skip_all => "Test::Perl::Critic is not installed." if $@;
+all_critic_ok("lib");
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
@@ -0,0 +1,9 @@
+use Test::More;
+eval q{ use Test::Spelling };
+plan skip_all => "Test::Spelling is not installed." if $@;
+add_stopwords(<DATA>);
+set_spell_cmd("aspell -l en list");
+all_pod_files_spelling_ok('lib');
+__DATA__
+Tatsuhiko
+Miyagawa
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Synopsis";
+plan skip_all => "Test::Synopsis required" if $@;
+all_synopsis_ok();

0 comments on commit 95b12c3

Please sign in to comment.