0.001 2008-06-28 15:28:46
First complete dist.
+
+0.002 2008-06-30 16:00:44
+ Converted C::P::CGIBin to C::C::CGIBin
Changes
-MANIFEST
-Makefile.PL
-README
+inc/Module/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.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/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/Catalyst/Controller/CGIBin.pm
lib/Catalyst/Controller/WrapCGI.pm
-lib/Catalyst/Plugin/CGIBin.pm
lib/CatalystX/GlobalContext.pm
+Makefile.PL
+MANIFEST
+META.yml
+README
t/00-load.t
+t/boilerplate.t
+t/cgibin.t
+t/global-context.t
+t/lib/TestApp.pm
+t/lib/TestApp/Controller/Root.pm
+t/lib/TestCGIBin.pm
+t/lib/TestCGIBin/Controller/CGIHandler.pm
+t/lib/TestCGIBin/root/cgi-bin/test.pl
+t/lib/TestCGIBin/root/cgi-bin/test.sh
t/pod-coverage.t
t/pod.t
+t/wrap-cgi.t
Task::Weaken: 0
URI: 0
parent: 0
-version: 0.001
+version: 0.002
After installing, you can find documentation for these modules with the
perldoc command.
- perldoc Catalyst::Plugin::CGIBin
+ perldoc Catalyst::Controller::CGIBin
perldoc Catalyst::Controller::WrapCGI
perldoc CatalystX::GlobalContext
--- /dev/null
+package Catalyst::Controller::CGIBin;
+
+use strict;
+use warnings;
+
+use Class::C3;
+use URI::Escape;
+use File::Slurp 'slurp';
+use File::Find::Rule ();
+use Cwd;
+use Catalyst::Exception ();
+use File::Spec::Functions 'splitdir';
+
+use parent 'Catalyst::Controller::WrapCGI';
+
+=head1 NAME
+
+Catalyst::Controller::CGIBin - Serve CGIs from root/cgi-bin
+
+=head1 VERSION
+
+Version 0.001
+
+=cut
+
+our $VERSION = '0.001';
+
+=head1 SYNOPSIS
+
+In your controller:
+
+ package MyApp::Controller::Foo;
+
+ use parent qw/Catalyst::Controller::CGIBin/;
+
+ # example of a forward to /cgi-bin/hlagh/mtfnpy.cgi
+ sub dongs : Local Args(0) {
+ my ($self, $c) = @_;
+ $c->forward($self->cgi_action('hlagh/mtfnpy.cgi'));
+ }
+
+In your .conf:
+
+ <Controller::Foo>
+ <CGI>
+ username_field username # used for REMOTE_USER env var
+ pass_env PERL5LIB
+ pass_env PATH
+ pass_env /^MYAPP_/
+ </CGI>
+ </Controller::Foo>
+
+=head1 DESCRIPTION
+
+Dispatches to executable CGI files in root/cgi-bin for /cgi-bin/ paths.
+
+A path such as C<root/cgi-bin/hlagh/bar.cgi> will get the private path
+C<foo/CGI_hlagh_bar_cgi>, for controller Foo, with the C</>s converted to C<_>s
+and prepended with C<CGI_>, as well as all non-word characters converted to
+C<_>s. This is because L<Catalyst> action names can't have non-word characters
+in them.
+
+Inherits from L<Catalyst::Controller::WrapCGI>, see the documentation for that
+module for configuration information.
+
+=cut
+
+sub register_actions {
+ my ($self, $c) = @_;
+
+ my $cwd = getcwd;
+
+ my $cgi_bin = $c->path_to('root', 'cgi-bin');
+
+ chdir $cgi_bin ||
+ Catalyst::Exception->throw(
+ message => 'You have no root/cgi-bin directory'
+ );
+
+ my $namespace = $self->action_namespace($c);
+
+ my $class = ref $self || $self;
+
+ for my $file (File::Find::Rule->executable->file->in(".")) {
+ my ($cgi, $type);
+ my $code = do { no warnings; eval 'sub { '.slurp($file).' }' };
+
+ if (!$@) {
+ $cgi = $code;
+ $type = 'Perl';
+ } else {
+ $cgi = sub { system "$cgi_bin/$file" };
+ $type = 'Non-Perl';
+ undef $@;
+ }
+
+ $c->log->info("Registering root/cgi_bin/$file as a $type CGI.")
+ if $c->debug;
+
+ my $action_name = $self->cgi_action($file);
+ my $path = join '/' => splitdir($file);
+ my $reverse = $namespace ? "$namespace/$action_name" : $action_name;
+ my $attrs = { Path => [ "cgi-bin/$path" ], Args => [ 0 ] };
+
+ $code = sub {
+ my ($controller, $context) = @_;
+ $controller->cgi_to_response($context, $cgi)
+ };
+
+ my $action = $self->create_action(
+ name => $action_name,
+ code => $code,
+ reverse => $reverse,
+ namespace => $namespace,
+ class => $class,
+ attributes => $attrs
+ );
+
+ $c->dispatcher->register($c, $action);
+ }
+
+ chdir $cwd;
+
+ $self->next::method($c, @_);
+}
+
+=head1 METHODS
+
+=head2 $self->cgi_action($cgi_path)
+
+Takes a path to a CGI from C<root/cgi-bin> such as C<foo/bar.cgi> and returns
+the action name it is registered as.
+
+=cut
+
+sub cgi_action {
+ my ($self, $cgi) = @_;
+
+ my $action_name = 'CGI_' . join '_' => splitdir($cgi);
+ $action_name =~ s/\W/_/g;
+
+ $action_name
+}
+
+=head1 AUTHOR
+
+Rafael Kitover, C<< <rkitover at cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-catalyst-controller-wrapcgi at
+rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Catalyst-Controller-WrapCGI>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+More information at:
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Controller-WrapCGI>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Catalyst-Controller-WrapCGI>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Catalyst-Controller-WrapCGI>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Catalyst-Controller-WrapCGI>
+
+=back
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2008 Rafael Kitover
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of Catalyst::Controller::CGIBin
+
+# vim: expandtab shiftwidth=4 ts=4 tw=80:
use HTTP::Request::AsCGI;
use HTTP::Request;
use URI;
+use Catalyst::Exception ();
=head1 NAME
=head1 VERSION
-Version 0.001
+Version 0.002
=cut
-our $VERSION = '0.001';
+our $VERSION = '0.002';
=head1 SYNOPSIS
<Controller::Foo>
<CGI>
+ username_field username # used for REMOTE_USER env var
pass_env PERL5LIB
pass_env PATH
- pass_env HLAGH
+ pass_env /^MYAPP_/
</CGI>
</Controller::Foo>
Allows you to run Perl code in a CGI environment derived from your L<Catalyst>
context.
+If you just want to run CGIs from files, see L<Catalyst::Controller::CGIBin>.
+
+=head1 CONFIGURATION
+
+C<$your_controller->{CGI}{pass_env}> should be an array of environment variables
+or regular expressions to pass through to your CGIs. Entries surrounded by C</>
+characters are considered regular expressions.
+
+Default is to pass the whole of C<%ENV>.
+
+C<{CGI}{username_field}> should be the field for your user's name, which will be
+read from C<$c->user->obj>. Defaults to 'username'.
+
+See L</SYNOPSIS> for an example.
+
=cut
# Hack-around because Catalyst::Engine::HTTP goes and changes
Controller, see L</SYNOPSIS> for an example. If you don't supply a list of
environment variables to pass, the whole of %ENV is used.
-Used by cgi_to_response, which is probably what you want to use as well.
+Used by cgi_to_response (above), which is probably what you want to use as well.
=cut
}
}
- my @env = @{ $self->{CGI}{pass_env} || [ keys %ENV ] };
+ my @env;
+
+ for (@{ $self->{CGI}{pass_env} }) {
+ if (m!^/(.*)/\z!) {
+ my $re = qr/$1/;
+ push @env, grep /$re/, keys %ENV;
+ } else {
+ push @env, $_;
+ }
+ }
+
+ @env = keys %ENV unless @env;
$req->content($body_content);
$req->content_length(length($body_content));
- my $user = (($c->can('user_exists') && $c->user_exists)
- ? eval { $c->user->obj->username }
+
+ my $username_field = $self->{CGI}{username_field} || 'username';
+
+ my $username = (($c->can('user_exists') && $c->user_exists)
+ ? eval { $c->user->obj->$username_field }
: '');
my $env = HTTP::Request::AsCGI->new(
$req,
- REMOTE_USER => $user,
+ ($username ? (REMOTE_USER => $username) : ()),
map { ($_, $ENV{$_}) } @env
);
select($old);
- warn "CGI invoke failed: $saved_error" if $saved_error;
-
+ Catalyst::Exception->throw(
+ message => "CGI invocation failed: $saved_error"
+ ) if $saved_error;
}
return $env->response;
=head1 SEE ALSO
-L<Catalyst::Plugin::CGIBin>, L<CatalystX::GlobalContext>,
+L<Catalyst::Controller::CGIBin>, L<CatalystX::GlobalContext>,
L<Catalyst::Controller>, L<CGI>, L<Catalyst>
=head1 AUTHOR
1; # End of Catalyst::Controller::WrapCGI
-# vim: expandtab shiftwidth=4 ts=4 tw=80:
+# vim: expandtab shiftwidth=2 ts=2 tw=80:
+++ /dev/null
-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 - Serve CGIs from root/cgi-bin
-
-=head1 VERSION
-
-Version 0.001
-
-=cut
-
-our $VERSION = '0.001';
-
-=head1 SYNOPSIS
-
-In MyApp.pm:
-
- use Catalyst;
-
- __PACKAGE__->setup(qw/CGIBin/);
-
-In your .conf:
-
- <Plugin::CGIBin>
- controller Foo
- </Plugin::CGIBin>
-
- <Controller::Foo>
- <CGI>
- pass_env PERL5LIB
- pass_env PATH
- </CGI>
- </Controller::Foo>
-
-=head1 DESCRIPTION
-
-Dispatches to executable CGI files in root/cgi-bin through the configured
-controller, which must inherit from L<Catalyst::Controller::WrapCGI>.
-
-=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<< <rkitover at cpan.org> >>
-
-=head1 BUGS
-
-Please report any bugs or feature requests to C<bug-catalyst-controller-wrapcgi at
-rt.cpan.org>, or through the web interface at
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Catalyst-Controller-WrapCGI>.
-I will be notified, and then you'll automatically be notified of progress on
-your bug as I make changes.
-
-=head1 SUPPORT
-
-More information at:
-
-=over 4
-
-=item * RT: CPAN's request tracker
-
-L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Controller-WrapCGI>
-
-=item * AnnoCPAN: Annotated CPAN documentation
-
-L<http://annocpan.org/dist/Catalyst-Controller-WrapCGI>
-
-=item * CPAN Ratings
-
-L<http://cpanratings.perl.org/d/Catalyst-Controller-WrapCGI>
-
-=item * Search CPAN
-
-L<http://search.cpan.org/dist/Catalyst-Controller-WrapCGI>
-
-=back
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright (c) 2008 Rafael Kitover
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut
-
-1; # End of Catalyst::Plugin::CGIBin
-
-# vim: expandtab shiftwidth=4 ts=4 tw=80:
=head1 DESCRIPTION
-This module, in combination with L<Catalyst::Controller::WrapCGI> is for helping
-you run legacy mod_perl code in L<Catalyst>.
+This module, in combination with L<Catalyst::Controller::WrapCGI> or
+L<Catalyst::Controller::CGIBin> is for helping you run legacy mod_perl code in
+L<Catalyst>.
You save a copy of $c somewhere at the beginning of the request cycle, and it is
then accessible through an export where you need it.
-You can then rip out Apache:: type things, and replace them with things based on
-$c.
+You can then rip out C<Apache::> type things, and replace them with things based on
+C<$c>.
-What we really need is a set of Apache:: compatibility classes, but that doesn't
+What we really need is a set of C<Apache::> compatibility classes, but that doesn't
exist yet.
DO NOT USE THIS MODULE IN NEW CODE
weaken $c;
}
+=head1 SEE ALSO
+
+L<Catalyst::Controller::CGIBin>, L<Catalyst::Controller::WrapCGI>,
+L<Catalyst>
+
=head1 AUTHOR
Rafael Kitover, C<< <rkitover at cpan.org> >>
BEGIN {
use_ok( 'Catalyst::Controller::WrapCGI' );
- use_ok( 'Catalyst::Plugin::CGIBin' );
+ use_ok( 'Catalyst::Controller::CGIBin' );
use_ok( 'CatalystX::GlobalContext' );
}
);
module_boilerplate_ok('lib/Catalyst/Controller/WrapCGI.pm');
- module_boilerplate_ok('lib/Catalyst/Plugin/CGIBin.pm');
+ module_boilerplate_ok('lib/Catalyst/Controller/CGIBin.pm');
module_boilerplate_ok('lib/CatalystX/GlobalContext.pm');
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin '$Bin';
+use lib "$Bin/lib";
+
+use Test::More tests => 4;
+
+use Catalyst::Test 'TestCGIBin';
+use HTTP::Request::Common;
+
+my $response = request POST '/cgi-bin/test.pl', [
+ foo => 'bar',
+ bar => 'baz'
+];
+
+is($response->content, 'foo:bar bar:baz', 'POST to Perl CGI File');
+
+$response = request POST '/cgihandler/dongs', [
+ foo => 'bar',
+ bar => 'baz'
+];
+
+is($response->content, 'foo:bar bar:baz',
+ 'POST to Perl CGI File through a forward');
+
+$response = request POST '/cgihandler/mtfnpy', [
+ foo => 'bar',
+ bar => 'baz'
+];
+
+is($response->content, 'foo:bar bar:baz',
+ 'POST to Perl CGI File through a forward via cgi_action');
+
+SKIP: {
+ skip "Can't run shell scripts on non-*nix", 1
+ if $^O eq 'MSWin32' || $^O eq 'VMS';
+
+ is(get('/cgi-bin/test.sh'), "Hello!\n", 'Non-Perl CGI File');
+}
--- /dev/null
+package TestCGIBin;
+
+use Catalyst;
+
+__PACKAGE__->setup;
+
+1;
--- /dev/null
+package TestCGIBin::Controller::CGIHandler;
+
+use parent 'Catalyst::Controller::CGIBin';
+
+# try out a forward
+sub dongs : Local Args(0) {
+ my ($self, $c) = @_;
+ $c->forward('/cgihandler/CGI_test_pl');
+}
+
+# try resolved forward
+sub mtfnpy : Local Args(0) {
+ my ($self, $c) = @_;
+ $c->forward($self->cgi_action('test.pl'));
+}
+
+1;
+++ /dev/null
-package TestPlugin;
-
-use Catalyst;
-
-__PACKAGE__->config->{'Plugin::CGIBin'} = {
- controller => 'CGIHandler'
-};
-
-__PACKAGE__->setup(qw/CGIBin/);
-
-1;
+++ /dev/null
-package TestPlugin::Controller::CGIHandler;
-
-use parent 'Catalyst::Controller::WrapCGI';
-
-1;
+++ /dev/null
-#!perl
-
-use strict;
-use warnings;
-
-use FindBin '$Bin';
-use lib "$Bin/lib";
-
-use Test::More tests => 2;
-
-use Catalyst::Test 'TestPlugin';
-use HTTP::Request::Common;
-
-my $response = request POST '/cgi-bin/test.pl', [
- foo => 'bar',
- bar => 'baz'
-];
-
-is($response->content, 'foo:bar bar:baz', 'POST to Perl CGI File');
-
-is(get('/cgi-bin/test.sh'), "Hello!\n", 'Non-Perl CGI File');
projects / catagits/Catalyst-Controller-WrapCGI.git / commitdiff