X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FPlugin%2FCGIBin.pm;h=611c5e97db39e45a51b7588c0747a14eac762dc6;hb=457c1d76ed6730ef07a1ab35b1ec1c47d6c4f19d;hp=a926bd7e48ecf24c4945ade4b1aeaf8d1122505e;hpb=32b32c6209c69a810c2d0b66a8cfc6efcae66d32;p=catagits%2FCatalyst-Controller-WrapCGI.git diff --git a/lib/Catalyst/Plugin/CGIBin.pm b/lib/Catalyst/Plugin/CGIBin.pm index a926bd7..611c5e9 100644 --- a/lib/Catalyst/Plugin/CGIBin.pm +++ b/lib/Catalyst/Plugin/CGIBin.pm @@ -3,9 +3,16 @@ package Catalyst::Plugin::CGIBin; use strict; use warnings; +use Class::C3; +use URI::Escape; +use File::Slurp 'slurp'; +use File::Find::Rule (); +use Cwd; +use Catalyst::Exception (); + =head1 NAME -Catalyst::Plugin::CGIBin - Server CGIs from root/cgi-bin +Catalyst::Plugin::CGIBin - Serve CGIs from root/cgi-bin =head1 VERSION @@ -15,30 +22,86 @@ Version 0.001 our $VERSION = '0.001'; - =head1 SYNOPSIS +In MyApp.pm: + + use Catalyst; + + __PACKAGE__->setup(qw/CGIBin/); + In your .conf: + - controller MyApp::Controller::Foo + controller Foo - + pass_env PERL5LIB pass_env PATH - + =head1 DESCRIPTION -Dispatches to CGI files in root/cgi-bin through the configured controller, which -must inherit from L. - -I still need to write the code :) +Dispatches to executable CGI files in root/cgi-bin through the configured +controller, which must inherit from L. =cut +my ($cgi_controller, $cgis); + +sub setup { + my $app = shift; + + my $cwd = getcwd; + + my $cgi_bin = $app->path_to('root', 'cgi-bin'); + + chdir $cgi_bin || + Catalyst::Exception->throw( + message => 'You have no root/cgi-bin directory' + ); + + $cgi_controller = $app->config->{'Plugin::CGIBin'}{controller} || + Catalyst::Exception->throw( + message => 'You must configure a controller for Plugin::CGIBin' + ); + + for my $cgi (File::Find::Rule->executable->file->in(".")) { + my $code = do { no warnings; eval 'sub { '.slurp($cgi).' }' }; + if (!$@) { # Perl source + $cgis->{$cgi} = $code; + undef $@; + } else { # some other type of executable + $cgis->{$cgi} = sub { system "$cgi_bin/$cgi" }; + } + } + + chdir $cwd; + + $app->next::method(@_); +} + +sub dispatch { + my $c = shift; + my $path = uri_unescape($c->req->path); + + if ($path =~ m!^cgi-bin/(.*)!) { + my $cgi = $cgis->{$1}; + + if ($cgi) { + $c->controller($cgi_controller)->cgi_to_response( + $c, $cgi + ); + return; + } + } + + $c->next::method(@_); +} + =head1 AUTHOR Rafael Kitover, C<< >>