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<< >>