On 2001-05-10, 20:02:00 (-0700), Doug MacEachern wrote:
>
> thanks for the patch! however, Apache::Registry no longer accepts new
> features. have you looked at Apache::{PerlRun,RegistryNG} ?
No I hadn't - but now I have. Much nicer code - why hasn't it replaced
Apache::Registry? Is there any reason I shouldn't run it on my server?
> you would just need to create a new subclass that overrides the
> 'readscript' method and modifies it according to your algorithm.
> if you get that going would be great to post here and/or cpan.
Ok, attached is my proposition for "Apache::RegistryPretty", which
is an improvement over Apache::Registry as long as the input code is
"pretty". :-) I subclassed Apache::RegistryNG and wrote a
replacement for the sub_wrap routine (modifying readscript wouldn't
have worked).
This time I documented it. If you like the code, would you please
take care of submitting it to "the right place" for me, since I
haven't a clue about CPAN submission rules?
Thanks!
--
Bjarni R. Einarsson PGP: 02764305, B7A3AB89
[EMAIL PROTECTED] -><- http://bre.klaki.net/
Check out my open-source email sanitizer: http://mailtools.anomy.net/
package Apache::RegistryPretty;
use Apache::RegistryNG ();
use Apache::Constants qw(:common);
use strict;
use vars qw($VERSION @ISA);
$VERSION = '1.00';
@ISA = qw(Apache::RegistryNG);
#OO replacement for Apache::Registry
#configure like so:
# <Location /perl>
# SetHandler perl-script
# PerlHandler Apache::RegistryPretty->handler
# Options +ExecCGI
# </Location>
# see also: Apache::RegistryBB
sub sub_wrap {
my($pr, $code, $package) = @_;
$code ||= $pr->{'code'};
$package ||= $pr->{'namespace'};
my ($script, $vars, $subs) = parse_pretty_code($$code);
my $line = $pr->mark_line;
my $sub = join(
'',
'package ',
$package,
";\nuse Apache qw(exit);\n",
$vars,
"sub handler {\n",
$line,
$script,
"\n}\n",
$subs # last line comment without newline?
);
$pr->{'sub'} = \$sub;
}
sub parse_pretty_code
{
my $script = shift;
my $subs = "";
my $vars = "";
# Comments just get in the way, kill'em.
$script =~ s/^#.*$//mg;
$script =~ s/\n+/\n/sg;
$script = "1;\n".$script;
while ($script =~ s/([;}]\s*\n)(sub\s*)([a-z0-9_]+)(\s*{.*?\n}\s*)/$1/si)
{
$subs .= $2.$3.$4;
}
while ($script =~ s/([;}]\s*)(use\s+[^;]+;\s*)/$1/si)
{
$vars .= $2;
}
while ($script =~ s/([;}]\s*)(my\s+|local\s+)([\$\@\%\*a-zA-Z_]+|\([^\)]+\))/$1
$3/si)
{
$vars .= $2.$3.";\n";
}
return ($script, $vars, $subs);
}
1;
__END__
=head1 NAME
Apache::RegistryPretty - Run unaltered CGI scrips under mod_perl
=head1 SYNOPSIS
#in httpd.conf
Alias /perl/ /perl/apache/scripts/ #optional
PerlModule Apache::RegistryPretty
<Location /perl>
SetHandler perl-script
PerlHandler Apache::RegistryPretty
Options ExecCGI
...
</Directory>
=head1 DESCRIPTION
This is a specialization of the B<Apache::RegistryNG> module, which is a
replacement for B<Apache::Registry>. Most of the documentation for
B<Apache::Registry> applies to this module as well.
The main difference is that this module avoids some of the more onerous
limitations B<Apache::Registry> placed on medium-sized perl scripts which
have subroutines. With B<Apache::Registry> subroutines would often
incorrectly "remember" variable values between invokations due to them
getting treated as closures by the Perl interpretor (see the B<perlsub>
and B<perlref> man pages for more info).
B<Apache::RegistryPretty> avoids this by attempting to recognize global
variables, package inclusions (use statements) and top level
subroutines. The recognition makes assumptions about programming style
and use of white space - so it does a better job than B<Apache::Registry>
with "pretty" perl programs. Thus the name.
Global variables are expected be defined with "my" or "local". Their
definitions are stored globally within the generated packages, but
their initialization is postponed and performed within the
auto-generated handler subroutine.
Subroutines begin with a subroutine definition (e.g. "B<sub foo {>")
starting in the first column of the file, and end with a lone curly
bracket ("B<}>"), also in the first column. Any subroutines that match
these will be implemented in such a fashion that they don't exhibit the
time-warp behavior associated with the original B<Apache::Registry>.
=head1 CAVEATS
See the B<Apache::Registry> documentation.
=head1 INTERNALS
The translations performed by B<Apache::RegistryPretty> are very simple,
and are probably best illustrated by an example:
use MIME::Base64;
sub foo
{
return decode_base64(shift);
}
sub bar
{
return encode_base64(shift);
}
my $bogus = time();
print foo(bar("whee")), $bogus, "\n";
Becomes something like this:
package SomePackage;
use Apache qw(exit);
use MIME::Base64;
my $bogus;
sub handler {
1;
$bogus = time();
print foo(bar("whee")), $bogus, "\n";
}
sub foo
{
return decode_base64(shift);
}
sub bar
{
return encode_base64(shift);
}
The handler routine is then called as necessary by B<Apache::RegistryPretty>
from within an environment that looks enough like a CGI environment to fool
most scripts.
=head1 SEE ALSO
perl(1), mod_perl(3), Apache(3), Apache::Debug(3), Apache::Registry(3)
=head1 AUTHORS
Bjarni Rúnar Einarsson <B<[EMAIL PROTECTED]>>
#!/usr/bin/perl -w
#
# This is a simple hack for testing the routines in
# Apache::RegistryPretty. To run it without actually installing
# the RegistryPretty script, do the following:
#
# mkdir xyz
# cp RegistryPretty.pm transform.pl xyz/
# cd xyz
# ln -s . Apache
# ./transform.pl </path/to/a/script.pl |less
#
# You do need to have mod_perl installed though.
#
# Incidentally, if the output looks nice you can actually
# use it as a first draft of a mod_perl version of your
# script and forget about Apache::Registry etc. altogether.
#
package test;
BEGIN { push @INC, "."; }
use strict;
use Apache::RegistryPretty;
my $func = join('', <>);
my $pr = { 'code' => \$func, 'namespace' => "SomePackage" };
bless($pr);
Apache::RegistryPretty::sub_wrap($pr);
print ${ $pr->{'sub'} };
sub mark_line
{
return "";
}
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
