Finally I've had the chance to write the module to ease the agony of new mp2
users. The autogenerated ModPerl::MethodLookup includes the mapping from
method names to the corresponding package and module names.
Currently there are three modes of possible usage:
1. I-want-it-all-now:
startup.pl:
-----------
use ModPerl::MethodLookup;
ModPerl::MethodLookup::preload_all();
This preloads all mp2 libs. Something that you probably don't want to do on
the production server, but it's cool for getting started with mp2.
2. I-want-it-when-I-need-it:
httpd.conf:
-----------
PerlPostConfigHandler ModPerl::MethodLookupAuto
startup.pl:
-----------
{
package ModPerl::MethodLookupAuto;
use ModPerl::MethodLookup;
use Carp;
sub handler {
# look inside mod_perl:: Apache:: APR:: ModPerl:: excluding DESTROY
my $skip = '^(?!DESTROY$';
*UNIVERSAL::AUTOLOAD = sub {
my $method = $AUTOLOAD;
return if $method =~ /DESTROY/;
my ($modules, $hint) = ModPerl::MethodLookup::lookup($method, @_);
$hint ||= "Can't find method $AUTOLOAD";
croak $hint;
};
return 0;
}
}
YMMV, I've encountered various problems installing UNIVERSAL::AUTOLOAD before
the server has started. So I've enabled it for the request time. If you know
of a better way let me know.
Now this example doesn't really loads the modules for you. But it'll print to
stderr what module should be loaded, when a method from the not-yet-loaded
module is called. Of course you can automatically load @$modules as well if
that's what you choose. But this is not endorsed.
3. I want-it-before-I-need-it
csh:
% alias lookup "perl -MApache2 -MModPerl::MethodLookup -le \\
'print((lookup(shift))[1])'"
bash:
% alias lookup="perl -MApache2 -MModPerl::MethodLookup -le \
'print((lookup(shift))[1])'"
Now if I'm adding a call to 'construct_url' and don't know which module it
resides in I do:
% lookup construct_url
to use method 'construct_url' add:
use Apache::URI;
Voila.
------------------------------------------
Comments on the API are welcome.
I suppose I can make the lookup() function return $hint in the scalar context
and @modules in the list context. Notice that we return a list of modules,
because if there are several modules with the same method name and we fail to
guess which one it belongs to based on the first argument, we return them all
for you to choose.
------------------------------------------
You need to rebuild mod_perl (or at least run 'make xs_generate' to get this
module).
Index: lib/ModPerl/WrapXS.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/WrapXS.pm,v
retrieving revision 1.47
diff -u -r1.47 WrapXS.pm
--- lib/ModPerl/WrapXS.pm 19 Jun 2002 05:18:04 -0000 1.47
+++ lib/ModPerl/WrapXS.pm 21 Feb 2003 08:52:59 -0000
@@ -563,6 +563,128 @@
close $fh;
}
+sub write_lookup_file {
+ my $self = shift;
+
+ my %map = ();
+ while (my($module, $functions) = each %{ $self->{XS} }) {
+ my $last_prefix = "";
+ for my $func (@$functions) {
+ my $class = $func->{class};
+ my $prefix = $func->{prefix};
+ $last_prefix = $prefix if $prefix;
+
+ my $name = $func->{name};
+ if ($name =~ /^mpxs_/) {
+ #e.g. mpxs_Apache__RequestRec_
+ my $class_prefix = class_c_prefix($class);
+ if ($name =~ /$class_prefix/) {
+ $prefix = class_mpxs_prefix($class);
+ }
+ }
+ $name =~ s/^$prefix// if $prefix;
+
+ push @{ $map{$name} }, [$module, $class];
+ }
+ }
+
+ local $Data::Dumper::Terse = 1;
+ $Data::Dumper::Terse = $Data::Dumper::Terse; # warn
+ my $methods = Dumper(\%map);
+ $methods =~ s/\n$//;
+
+ my $package = "ModPerl::MethodLookup";
+ my $file = catfile "lib", "ModPerl", "MethodLookup.pm";
+ debug "creating $file";
+ open my $fh, ">$file" or die "Can't open $file: $!";
+
+ print $fh <<EOF;
+package $package;
+use strict;
+use warnings;
+
+use base qw(Exporter);
+our \@EXPORT = qw(preload_all lookup);
+
+my \$methods = $methods;
+
+EOF
+
+ print $fh <<'EOF';
+use constant MODULE => 0;
+use constant CLASS => 1;
+
+# preload_all()
+sub preload_all {
+ eval "require $_" for map $_->[MODULE], map @$_, values %$methods;
+}
+
+#
+# my ($modules, $hint) = lookup("construct_url");
+# my ($modules, $hint) = lookup("construct_url", $r);
+#
+# csh:
+# alias lookup "perl -MApache2 -MModPerl::MethodLookup -le \\
+# 'print((lookup(shift))[1])'"
+# bash:
+# alias lookup="perl -MApache2 -MModPerl::MethodLookup -le \
+# 'print((lookup(shift))[1])'"
+#
+#
+#
+sub lookup {
+ my ($method, $arg) = @_;
+
+ unless (defined $method) {
+ my $hint = "no 'method' argument was passed\n";
+ return ([], $hint);
+ }
+
+ # fully qualified function
+ if ($method =~ /(.+?)::([^:]+)$/) {
+ my ($module, $method) = ($1, $2);
+ my $hint = "to use method '$method' add:\n" . "\tuse $module;\n";
+ return ([$module], $hint);
+ }
+
+ unless (exists $methods->{$method}) {
+ my $hint = "don't know anything about method '$method'\n";
+ return ([], $hint);
+ }
+
+ my @items = @{ $methods->{$method} };
+ if (@items == 1) {
+ my $module = $items[0]->[MODULE];
+ my $hint = "to use method '$method' add:\n" . "\tuse $module ();\n";
+ return ([$module], $hint);
+ }
+ else {
+ if (defined $arg and ref $arg) {
+ my $class = ref $arg;
+ for my $item (@items) {
+ if ($class eq $item->[CLASS]) {
+ my $module = $item->[MODULE];
+ my $hint = "to use method '$method' add:\n" .
+ "\tuse $module ();\n";
+ return ([$module], $hint);
+ }
+ }
+ }
+ else {
+ my @modules = map {$_->[MODULE]} @items;
+ my $hint = "There is more than one class with method '$method'\n" .
+ "try one of:\n" . join '', map {"\tuse $_ ();\n"} @modules;
+ return (\@modules, $hint);
+ }
+ }
+
+}
+
+1;
+EOF
+ close $fh;
+}
+
sub generate {
my $self = shift;
@@ -592,6 +714,8 @@
$self->write_xs($module, $functions);
$self->write_pm($module);
}
+
+ $self->write_lookup_file;
}
#three .sym files are generated:
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
