On Fri, Oct 22, 2004 at 01:54:42PM -0400, Michael wrote:
I'm going to go a head and try to make my plugin backwards compatible to a degree, but I'm not sure how much that compatibility will be used since I'm encouraging everyone who uses it to use the straight mod_perl api.
I think this is a good approach. However, you never know when code that was originally written for a mod_perl environment may need to be deployed into a mod_cgi environment. Not having to twiddle with it to get it to work in either situations would be useful.
This will make my job of keeping it compatible harder, but should make everyone happier in the end. :)
Yes, but you'll get some help along the way. It will be very useful to have common methods (header_*) which DTRT according to the environment they are in.
Ok, here's another stab at this. I've include a test application module that I've been using to make sure stuff works together. Please look at the code, docs, test, etc and see if there is anything I might have left out.
Thanks to everyone for all their comments, criticism, and feature requests.
and yes I still left the Apache::Reload in :) I promise it's gone when an official release is made.
-- Michael Peters Developer Plus Three, LP
NAME
CGI::Application::Plugin::Apache - Allow CGI::Application to use
Apache::* modules without interferenceSYNOPSIS
use base 'CGI::Application';
use CGI::Application::Plugin::Apache qw(:all);# then later we join our hero in a run mode...
sub mode1 {
my $self = shift;
my $q = $self->query(); # $q is an Apache::Request obj not a CGI.pm obj
# do some stuff
# now we can bake a cookie using Apache::Cookie without interference
$cookie = Apache::Cookie->new(
$q,
-name => 'foo',
-value => 'bar',
-expires => '+2h',
);
$cookie->bake;
# now let's play with the content_type and other headers
$q->content_type('text/plain');
$q->header_out('MyHeader' => 'MyValue'); # do other stuff
return $content;
}1;
DESCRIPTION
This plugin helps to try and fix some of the annoyances of using
CGI::Application in a pure mod_perl environment. CGI::Application
assumes that you use CGI.pm, but I wanted to avoid it's bloat and have
access to the performance of the Apache::* modules so along came this
plugin. At the current moment it only does two things:Use Apache::Request as the "$self->query" object thus avoiding the
creation of the CGI.pm object.
Override the way CGI::Application creates and prints it's HTTP headers.
Since it was using CGI.pm's "header()" and "redirect()" method's we
needed an alternative. So now we use the "Apache->send_http_header()"
method. This has a few additional benefits other than just not using
CGI.pm. It means that we can use other Apache::* modules that might also
create outgoing headers (e.g. Apache::Cookie) without CGI::Application
clobbering them.
EXPORTED METHODS
This module uses Exporter to provide methods to your application module.
Most of the time you will never actually use these methods since they
are used by CGI::Application itself, but I figured you'd like to know
what's going on.
No methods are exported by default. It is up to you to pick and choose,
but please choose wisely. You can import all of the methods by using:use CGI::Application::Plugin::Apache qw(:all);
It is recommended that you import all of them since some methods will
require others.. but the choice is yours. For instance, if you want to
override any method then you may not want to import it from here.handler()
This method gives your application the ability to run as a straight
mod_perl handler. It simply creates an instance of you application and
then runs it (using "$app->new()" and "$app->run()"). It does not pass
any arguments into either method. It then returns an
"Apache::Constants::OK" value. If you need anything more than this,
please feel free to not import this method and write your own. You could
do it like this:
package MyApp;
use base 'CGI::Application';
use CGI::Application::Plugin::Apache qw(:all !handler); sub handler {
# do what every you want here
}cgiapp_get_query()
This overrides CGI:App's method for retrieving the query object. This is
the standard way of using something other than CGI.pm so it's no
surprise that we use it here. It simply creates and returns a new
Apache::Request object from "Apache->request".
_send_headers()
I didn't like the idea of exporting this private method (I'd rather
think it was a 'protected' not 'private) but right now it's the only way
to have any say in how the HTTP headers are created. Please see "HTTP
Headers" for more details.
HTTP Headers
We encourage you to learn the mod_perl way of manipulating headers and
cookies. It's really not that hard we promise. But incase you're easing
your way into it, we try and provide as much backward compatibility as
possible. Cookies
HTTP cookies should now be created using Apache::Cookie and it's
"bake()" method not with "header_add()" or "header_props()".You can still do the following to create a cookie
my $cookie = CGI::Cookie->new(
-name => 'foo',
-value => 'bar',
);
$self->header_add(-cookie => $cookie);But now we encourage you to do the following
my $cookie = Apache::Cookie->new(
$self->query,
-name => 'foo',
-value => 'bar',
);
$cookie->bake(); Redirects
You can still do the following to perform an HTTP redirect $self->header_props( uri => $some_url);
$self->header_type('redirect');
return '';But now we encourage you to do the following
$self->query->header_out(Location => $some_url);
$self->query->status(REDIRECT);
return '';But it's really up to you.
MISC
Upon using this module you completely leave behind the world of CGI.pm.
Don't look back or you might turn into a pillar of salt. You will have
to look at and read the docs of the Apache::* modules. But don't worry,
they are really easy to use and were designed to mimic the interface of
CGI.pm and family. If you are trying to use this module but don't want to have to change
your previous code that uses "header_props()" or "header_add()" then we
try to help you out by being as CGI compatible as we can, but it is
always better to use the mod_perl api. If you still want to use
"header_props()" or "header_add()" remeber that it will cause a
performance hit. If for some reason you are using this plugin in a non-mod_perl
environment, it will try to do the right thing by simply doing nothing
:)AUTHOR
Michael Peters <[EMAIL PROTECTED]>SEE ALSO
* CGI::Application
* Apache
* Apache::Request
* Apache::CookieLICENSE
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.package CGI::Application::Plugin::Apache; use strict; use base 'Exporter'; use Apache; use Apache::Request; use Apache::Reload; use Apache::Constants qw(:common :response); use Carp;
$CGI::Application::Plugin::Apache::VERSION = 0.03;
use vars qw(@EXPORT_OK %EXPORT_TAGS);
BEGIN {
# only do stuff if we are running under mod_perl
if( $ENV{MOD_PERL} ) {
@EXPORT_OK = qw(handler cgiapp_get_query _send_headers);
%EXPORT_TAGS = (all => [EMAIL PROTECTED]);
}
}
sub handler ($$) {
my ($self, $r) = @_;
$r->status(OK);
my $app = $self->new();
$app->run();
return $r->status();
}
sub cgiapp_get_query {
my $self = shift;
my $apr = Apache::Request->new( Apache->request() );
return $apr;
}
sub _send_headers {
my $self = shift;
my $q = $self->query();
my $header_type = $self->header_type();
# if we are redirecting try and do it with header_out
if ($header_type eq 'redirect') {
my %props = $self->header_props();
my $url = '';
foreach my $key (keys %props) {
$url = $props{$key}
if($key =~ /uri$/i);
}
# if we actually have a url
if($url) {
$q->header_out(Location => $url);
$q->status(REDIRECT);
$q->send_http_header()
} else {
# else they are trying to redirect with giving a destination
croak("header_type of 'redirect' without a uri");
}
} elsif ($header_type eq 'header' ) {
my %props = $self->header_props();
# if we have any header props then use CGI to handle them
if( scalar(%props) ) {
#require CGI;
#my $cgi = CGI->new();
my $header = _handle_cgi_header_props($q, %props);
#$self->query->send_cgi_header($header) if($header);
} else {
# else use to Apache send the header
$self->query->send_http_header('text/html');
}
} elsif( $header_type eq 'none' ) {
# don't do anything here either...
} else {
# croak() if we have an unknown header type
croak ("Invalid header_type '$header_type'");
}
# Don't return anything so headers aren't sent twice
return "";
}
###################################################################
#THE FOLLOWING SUBS ARE ADAPTED FROM Lincoln Stein's CGI.pm module
###################################################################
sub _handle_cgi_header_props {
my($q,@p) = @_;
my($type,$status,$cookie,$target,$expires,$charset,$attachment,$p3p,$other) =
_rearrange_props(
[
['TYPE','CONTENT_TYPE','CONTENT-TYPE'],
'STATUS',
['COOKIE','COOKIES'],
'TARGET',
'EXPIRES',
'CHARSET',
'ATTACHMENT',
'P3P'
],
@p
);
$type ||= 'text/html';
$type .= "; charset=$charset"
if( $type =~ m!^text/! and $type !~ /\bcharset\b/ and $charset );
$q->content_type($type);
$q->status($status) if($status);
if( $target ) {
$q->header_out('Window-Target' => $target);
}
if ( $p3p ) {
$p3p = join ' ',@$p3p if ref($p3p) eq 'ARRAY';
$q->header_out('P3P' => qq(policyref="/w3c/p3p.xml"));
$q->header_out('CP' => $p3p);
}
# send all the cookies -- there may be several
if ( $cookie ) {
my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie;
foreach (@cookie) {
my $cs = '';
if( UNIVERSAL::isa($_,'CGI::Cookie') ||
UNIVERSAL::isa($_,'Apache::Cookie') ) {
$cs = $_->as_string;
} else {
$cs = $_;
}
$q->headers_out->add('Set-Cookie' => $cs);
}
}
# if the user indicates an expiration time, then we need
# both an Expires and a Date header (so that the browser
# uses OUR clock)
if( $expires ) {
$q->header_out('Expires' => _expires($expires,'http'));
}
if( $attachment ) {
$q->header_out('Content-Disposition' => qq(attachment;
filename="$attachment"));
}
foreach my $key (keys %$other) {
$q->header_out(ucfirst($key) => $other->{$key});
}
$q->send_http_header();
return '';
}
sub _rearrange_props {
my($order,@param) = @_;
# map parameters into positional indices
my ($i,%pos);
$i = 0;
foreach (@$order) {
foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{lc($_)} = $i; }
$i++;
}
my (@result,%leftover);
$#result = $#$order; # preextend
while (@param) {
my $key = lc(shift(@param));
$key =~ s/^\-//;
if (exists $pos{$key}) {
$result[$pos{$key}] = shift(@param);
} else {
$leftover{$key} = shift(@param);
}
}
push (@result,\%leftover) if %leftover;
return @result;
}
# This internal routine creates date strings suitable for use in
# cookies and HTTP headers. (They differ, unfortunately.)
# Thanks to Mark Fisher for this.
sub _expires {
my($time,$format) = @_;
$format ||= 'http';
my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;
# pass through preformatted dates for the sake of _expire_calc()
$time = _expire_calc($time);
return $time unless $time =~ /^\d+$/;
# make HTTP/cookie date string from GMT'ed time
# (cookies use '-' as date separator, HTTP uses ' ')
my($sc) = ' ';
$sc = '-' if $format eq "cookie";
my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
$year += 1900;
return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT",
$WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);
}
# This internal routine creates an expires time exactly some number of
# hours from the current time. It incorporates modifications from
# Mark Fisher.
sub _expire_calc {
my($time) = @_;
my(%mult) = ('s'=>1,
'm'=>60,
'h'=>60*60,
'd'=>60*60*24,
'M'=>60*60*24*30,
'y'=>60*60*24*365);
# format for time can be in any of the forms...
# "now" -- expire immediately
# "+180s" -- in 180 seconds
# "+2m" -- in 2 minutes
# "+12h" -- in 12 hours
# "+1d" -- in 1 day
# "+3M" -- in 3 months
# "+2y" -- in 2 years
# "-3m" -- 3 minutes ago(!)
# If you don't supply one of these forms, we assume you are
# specifying the date yourself
my($offset);
if (!$time || (lc($time) eq 'now')) {
$offset = 0;
} elsif ($time=~/^\d+/) {
return $time;
} elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
$offset = ($mult{$2} || 1)*$1;
} else {
return $time;
}
return (time+$offset);
}
sub _unescapeHTML {
my ($string, $charset) = @_;
return undef unless defined($string);
my $latin = defined $charset ? $charset =~ /^(ISO-8859-1|WINDOWS-1252)$/i : 1;
# thanks to Randal Schwartz for the correct solution to this one
$string=~ s[&(.*?);]{
local $_ = $1;
/^amp$/i ? "&" :
/^quot$/i ? '"' :
/^gt$/i ? ">" :
/^lt$/i ? "<" :
/^#(\d+)$/ && $latin ? chr($1) :
/^#x([0-9a-f]+)$/i && $latin ? chr(hex($1)) :
$_
}gex;
return $string;
}
1;
__END__
=pod
=head1 NAME
CGI::Application::Plugin::Apache - Allow CGI::Application to use Apache::* modules
without interference
=head1 SYNOPSIS
use base 'CGI::Application';
use CGI::Application::Plugin::Apache qw(:all);
# then later we join our hero in a run mode...
sub mode1 {
my $self = shift;
my $q = $self->query(); # $q is an Apache::Request obj not a CGI.pm obj
# do some stuff
# now we can bake a cookie using Apache::Cookie without interference
$cookie = Apache::Cookie->new(
$q,
-name => 'foo',
-value => 'bar',
-expires => '+2h',
);
$cookie->bake;
# now let's play with the content_type and other headers
$q->content_type('text/plain');
$q->header_out('MyHeader' => 'MyValue');
# do other stuff
return $content;
}
1;
=head1 DESCRIPTION
This plugin helps to try and fix some of the annoyances of using L<CGI::Application> in
a pure mod_perl environment. L<CGI::Application> assumes that you use L<CGI.pm|CGI>,
but I wanted
to avoid it's bloat and have access to the performance of the Apache::* modules so
along
came this plugin. At the current moment it only does two things:
=over
=item Use Apache::Request as the C<< $self->query >> object thus avoiding the creation
of the CGI.pm object.
=item Override the way L<CGI::Application> creates and prints it's HTTP headers. Since
it was using
L<CGI.pm|CGI>'s C<< header() >> and C<< redirect() >> method's we needed an
alternative. So now we
use the C<< Apache->send_http_header() >> method. This has a few additional benefits
other
than just not using L<CGI.pm|CGI>. It means that we can use other Apache::* modules
that might
also create outgoing headers (e.g. L<Apache::Cookie>) without L<CGI::Application>
clobbering
them.
=back
=head1 EXPORTED METHODS
This module uses L<Exporter> to provide methods to your application module. Most of
the time
you will never actually use these methods since they are used by L<CGI::Application>
itself,
but I figured you'd like to know what's going on.
No methods are exported by default. It is up to you to pick and choose, but please
choose
wisely. You can import all of the methods by using:
use CGI::Application::Plugin::Apache qw(:all);
It is recommended that you import all of them since some methods will require others..
but
the choice is yours. For instance, if you want to override any method then you may not
want
to import it from here.
=head2 handler()
This method gives your application the ability to run as a straight mod_perl handler.
It simply
creates an instance of you application and then runs it (using C<< $app->new() >> and
C<< $app->run() >>). It does not pass any arguments into either method. It then
returns an
C<< Apache::Constants::OK >> value. If you need anything more than this, please feel
free to
not import this method and write your own. You could do it like this:
package MyApp;
use base 'CGI::Application';
use CGI::Application::Plugin::Apache qw(:all !handler);
sub handler {
# do what every you want here
}
=head2 cgiapp_get_query()
This overrides CGI:App's method for retrieving the query object. This is the standard
way
of using something other than CGI.pm so it's no surprise that we use it here. It simply
creates and returns a new L<Apache::Request> object from C<< Apache->request >>.
=head2 _send_headers()
I didn't like the idea of exporting this private method (I'd rather think it was a
'protected'
not 'private) but right now it's the only way to have any say in how the HTTP headers
are created.
Please see L<"HTTP Headers"> for more details.
=head1 HTTP Headers
We encourage you to learn the mod_perl way of manipulating headers and cookies. It's
really not
that hard we promise. But incase you're easing your way into it, we try and provide as
much
backward compatibility as possible.
=head2 Cookies
HTTP cookies should now be created using L<Apache::Cookie> and it's C<< bake() >>
method not with
C<< header_add() >> or C<< header_props() >>.
You can still do the following to create a cookie
my $cookie = CGI::Cookie->new(
-name => 'foo',
-value => 'bar',
);
$self->header_add(-cookie => $cookie);
But now we encourage you to do the following
my $cookie = Apache::Cookie->new(
$self->query,
-name => 'foo',
-value => 'bar',
);
$cookie->bake();
=head2 Redirects
You can still do the following to perform an HTTP redirect
$self->header_props( uri => $some_url);
$self->header_type('redirect');
return '';
But now we encourage you to do the following
$self->query->header_out(Location => $some_url);
$self->query->status(REDIRECT);
return '';
But it's really up to you.
=head1 MISC
Upon using this module you completely leave behind the world of L<CGI.pm|CGI>. Don't
look back or
you might turn into a pillar of salt. You will have to look at and read the docs of
the Apache::*
modules. But don't worry, they are really easy to use and were designed to mimic the
interface
of L<CGI.pm|CGI> and family.
If you are trying to use this module but don't want to have to change your previous
code that
uses C<< header_props() >> or C<< header_add() >> then we try to help you out by being
as CGI
compatible as we can, but it is always better to use the mod_perl api. If you still
want to use
C<< header_props() >> or C<< header_add() >> remeber that it will cause a performance
hit.
If for some reason you are using this plugin in a non-mod_perl environment, it will
try to
do the right thing by simply doing nothing :)
=head1 AUTHOR
Michael Peters <[EMAIL PROTECTED]>
=head1 SEE ALSO
=over 8
=item * L<CGI::Application>
=item * L<Apache>
=item * L<Apache::Request>
=item * L<Apache::Cookie>
=back
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
package ApachePlugin::Test;
use base 'CGI::Application';
use strict;
use warnings;
use Apache::Reload;
use CGI::Cookie;
use CGI::Application::Plugin::Apache qw(:all);
use Apache::Cookie;
my $content = "<h1>HELLO THERE</h1>";
sub setup {
my $self = shift;
$self->start_mode('header');
$self->run_modes(
header => 'header',
redirect => 'redirect',
add_header => 'add_header',
cgi_cookie => 'cgi_cookie',
apache_cookie => 'apache_cookie',
baking_apache_cookie => 'baking_apache_cookie',
cgi_and_apache_cookies => 'cgi_and_apache_cookies',
cgi_and_baked_cookies => 'cgi_and_baked_cookies',
);
}
sub header {
my $self = shift;
$self->header_type('header');
return "<h1>HELLO THERE</h1>"
. "<h3>Im in runmode header</h3>";
}
sub redirect {
my $self = shift;
$self->header_type('redirect');
$self->header_props(
-uri => 'http://www.google.com',
);
return "<h1>HELLO THERE</h1>"
. "<h3>Im in runmode redirect</h3>";
}
sub add_header {
my $self = shift;
$self->header_type('header');
$self->header_add(
-me => 'Myself and I',
);
return "<h1>HELLO THERE</h1>"
. "<h3>Im in runmode add_header</h3>";
}
sub cgi_cookie {
my $self = shift;
$self->header_type('header');
my $cookie = CGI::Cookie->new(
-name => 'cgi_cookie',
-value => 'yum',
);
$self->header_add(
-cookie => $cookie,
);
return "<h1>HELLO THERE</h1>"
. "<h3>Im in runmode cgi_cookie</h3>";
}
sub apache_cookie {
my $self = shift;
$self->header_type('header');
my $cookie = Apache::Cookie->new(
$self->query,
-name => 'apache_cookie',
-value => 'yummier',
);
$self->header_add(
-cookie => $cookie,
);
return "<h1>HELLO THERE</h1>"
. "<h3>Im in runmode apache_cookie</h3>";
}
sub baking_apache_cookie {
my $self = shift;
$self->header_type('header');
my $cookie = Apache::Cookie->new(
$self->query,
-name => 'baked_cookie',
-value => 'yummiest',
);
$cookie->bake;
return "<h1>HELLO THERE</h1>"
. "<h3>Im in runmode baking_apache_cookie</h3>";
}
sub cgi_and_apache_cookies {
my $self = shift;
$self->header_type('header');
my $cookie1 = CGI::Cookie->new(
-name => 'cgi_cookie',
-value => 'yum : both',
);
my $cookie2 = Apache::Cookie->new(
$self->query,
-name => 'apache_cookie',
-value => 'yummier : both',
);
$self->header_props(
-cookie => [$cookie2, $cookie1],
);
return "<h1>HELLO THERE</h1>"
. "<h3>Im in runmode cgi_and_apache_cookies</h3>";
}
sub cgi_and_baked_cookies {
my $self = shift;
$self->header_type('header');
my $cookie1 = CGI::Cookie->new(
-name => 'cgi_cookie',
-value => 'yum : both',
);
my $cookie2 = Apache::Cookie->new(
$self->query,
-name => 'baked_cookie',
-value => 'yummier : both',
);
$self->header_props(
-cookie => $cookie1,
);
$cookie2->bake;
return "<h1>HELLO THERE</h1>"
. "<h3>Im in runmode cgi_and_baked_cookies</h3>";
}
1;
--------------------------------------------------------------------- Web Archive: http://www.mail-archive.com/[EMAIL PROTECTED]/ http://marc.theaimsgroup.com/?l=cgiapp&r=1&w=2 To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
