Hi,
I hope I'm sending this to the right list, and apologize in
advance if I'm making a mistake. I have made a minor modification
to the Apache::Registry.pm module, which I wanted to share with
the list in case you developers thought it was worth including in
the default distribution or considering further.
My code attempts to address the subroutine-closure problem (the
problem that causes data from one invocation to live on to the
next in many unmodified CGI scripts) by moving all subroutine
definitions, variable declarations (my, local) and use statements
out of handler() and into the generated packages' body.
Attached are a simple script which implements my algorithm (for
playing with) and a crude patch against Registry.pm (version 2.01)
which uses the algorithm. Since I didn't know whether people
would like my code or not, I didn't spend time updating the
documentation section of the module.
Initial tests on my personal web site indicate that this patch
works quite well.
The main caveat about my algorithm is that since perl is hard to
parse, I wimped out and made assumptions about how programmers use
white space: I assume that people indent their subroutine bodies
by at least a single space or tab and close all subroutines with a
'}' in column 1. Since this requirement might break some scripts,
my patch doesn't activate unless the comment #MASH_OK is found
somewhere within the script.
Any feedback is most welcome, but please CC: any followups to my
personal address ([EMAIL PROTECTED]), since I'm not subscribed to this
list. And thanks for mod_perl. :-)
--
Bjarni R. Einarsson PGP: 02764305, B7A3AB89
[EMAIL PROTECTED] -><- http://bre.klaki.net/
Check out my open-source email sanitizer: http://mailtools.anomy.net/
97c97
< my ($sub, $vars, $subs) = ($r->slurp_filename, "", "");
---
> my $sub = $r->slurp_filename;
100,107d99
< # This is a hack to help more complex perl scripts which have sane
< # white space. It requires that #MASH_OK appear in a comment
< # somewhere within the script source.
< #
< if ($sub =~ /^#MASH_OK/m) {
< ($sub, $vars, $subs) = mash($sub);
< }
<
124,125c116
< $vars,
< 'sub mod_perl_handler {',
---
> 'sub handler {',
128,129c119
< "\n}\n",
< $subs # last line comment without newline?
---
> "\n}", # last line comment without newline?
144c134
< my $cv = \&{"$package\::mod_perl_handler"};
---
> my $cv = \&{"$package\::handler"};
210,237d199
< }
<
< sub mash
< {
< 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;".$script;
<
< while ($script =~ s/([;}]\s*\n)(sub\s*[a-z0-9_]+\s*{.*?\n}\s*)/$1/si)
< {
< $subs .= "# Moved following subroutine...\n".$2;
< }
<
< while ($script =~ s/([;}]\s*)(my\s+|local\s+)([\$\@\%\*a-zA-Z_]+|\([^\)]+\))/$1
$3/si)
< {
< $vars .= $2.$3.";\n";
< }
< while ($script =~ s/([;}]\s*)(use\s+[^;]+;\s*)/$1/si)
< {
< $vars .= $2;
< }
<
< return ($script, $vars, $subs);
#!/usr/bin/perl -w
#
# This is a simple script which transforms other scripts into
# packages with call-in functions.
#
# This script makes assumptions about programming style and white
# space, because perl syntax is hairy. Too bad.
#
use strict;
my ($script, $variables, $subs) = mash(join('',<STDIN>));
print join("\n",
'package BogusPackageName;',
'use Apache qw(exit);',
$variables,
'sub BogusPackageHandler {',
$script,
"\n} # End of BogusPackageHandler\n",
$subs);
sub mash
{
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;".$script;
while ($script =~ s/([;}]\s*\n)(sub\s*[a-z0-9_]+\s*{.*?\n}\s*)/$1/si)
{
$subs .= "# Moved following subroutine...\n".$2;
}
while ($script =~ s/([;}]\s*)(my\s+|local\s+)([\$\@\%\*a-zA-Z_]+|\([^\)]+\))/$1
$3/si)
{
$vars .= $2.$3.";\n";
}
while ($script =~ s/([;}]\s*)(use\s+[^;]+;\s*)/$1/si)
{
$vars .= $2;
}
return ($script, $vars, $subs);
}
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
