stas 2003/02/23 18:08:31
Modified: lib/ModPerl WrapXS.pm .cvsignore
. Changes
Log:
implement a new helper module ModPerl::MethodLookup to help figure out
which module should be loaded when a certain method is reported to be
missing
Revision Changes Path
1.48 +106 -0 modperl-2.0/lib/ModPerl/WrapXS.pm
Index: WrapXS.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/WrapXS.pm,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -r1.47 -r1.48
--- WrapXS.pm 19 Jun 2002 05:18:04 -0000 1.47
+++ WrapXS.pm 24 Feb 2003 02:08:30 -0000 1.48
@@ -563,6 +563,110 @@
close $fh;
}
+sub write_lookup_method_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: $!";
+
+ my $noedit_warning = $self->ModPerl::Code::noedit_warning_hash();
+
+ print $fh <<EOF;
+$noedit_warning
+package $package;
+
+use strict;
+use warnings;
+
+my \$methods = $methods;
+
+EOF
+
+ print $fh <<'EOF';
+use constant MODULE => 0;
+use constant CLASS => 1;
+
+sub preload_all_modules {
+ eval "require $_" for map $_->[MODULE], map @$_, values %$methods;
+}
+
+sub lookup_method {
+ my ($method, $arg) = @_;
+
+ unless (defined $method) {
+ my $hint = "no 'method' argument was passed";
+ return ($hint);
+ }
+
+ # strip the package name for the fully qualified method
+ $method =~ s/.+:://;
+
+ unless (exists $methods->{$method}) {
+ my $hint = "don't know anything about method '$method'";
+ 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 ($hint, $module);
+ }
+ 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 ($hint, $module);
+ }
+ }
+ }
+ 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 ($hint, @modules);
+ }
+ }
+}
+
+1;
+EOF
+ close $fh;
+}
+
sub generate {
my $self = shift;
@@ -592,6 +696,8 @@
$self->write_xs($module, $functions);
$self->write_pm($module);
}
+
+ $self->write_lookup_method_file;
}
#three .sym files are generated:
1.2 +1 -0 modperl-2.0/lib/ModPerl/.cvsignore
Index: .cvsignore
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/.cvsignore,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- .cvsignore 5 Mar 2001 04:06:54 -0000 1.1
+++ .cvsignore 24 Feb 2003 02:08:31 -0000 1.2
@@ -1 +1,2 @@
FunctionTable.pm
+MethodLookup.pm
1.132 +4 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.131
retrieving revision 1.132
diff -u -r1.131 -r1.132
--- Changes 20 Feb 2003 01:28:25 -0000 1.131
+++ Changes 24 Feb 2003 02:08:31 -0000 1.132
@@ -10,6 +10,10 @@
=item 1.99_09-dev
+implement a new helper module ModPerl::MethodLookup to help figure out
+which module should be loaded when a certain method is reported to be
+missing. [Stas]
+
fix a bug for apr < 0.9.3, where it segfaults in apr_uri_unparse, if
hostname is set, but not the scheme. [Stas]
