cvs commit: modperl-2.0/lib/ModPerl FunctionMap.pm WrapXS.pm
dougm 01/05/02 21:56:32
Modified:lib/ModPerl FunctionMap.pm WrapXS.pm
Log:
more better prefix guessing
Revision ChangesPath
1.7 +4 -3 modperl-2.0/lib/ModPerl/FunctionMap.pm
Index: FunctionMap.pm
===
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/FunctionMap.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- FunctionMap.pm2001/04/20 03:07:53 1.6
+++ FunctionMap.pm2001/05/03 04:56:31 1.7
@@ -65,12 +65,13 @@
my($name, $class) = ($entry-{name}, $entry-{class});
my $prefix = ;
$name =~ s/^DEFINE_//;
+$name =~ s/^mpxs_//i;
(my $guess = lc($entry-{class} || $entry-{module}) . '_') =~ s/::/_/g;
-$guess =~ s/apache_/ap_/;
+$guess =~ s/(apache)_/($1|ap)_{1,2}/;
-if ($name =~ /^$guess/) {
-$prefix = $guess;
+if ($name =~ s/^($guess).*/$1/i) {
+$prefix = $1;
}
else {
if ($name =~ /^(apr?_)/) {
1.13 +1 -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.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- WrapXS.pm 2001/05/03 04:01:53 1.12
+++ WrapXS.pm 2001/05/03 04:56:31 1.13
@@ -87,6 +87,7 @@
@{ $func } {qw(dispatch orig_args)};
if ($dispatch =~ /^MPXS_/) {
+$name =~ s/^mpxs_//;
$name =~ s/^$func-{prefix}//;
push @{ $self-{newXS}-{ $module } },
[$class\::$name, $dispatch];
cvs commit: modperl-2.0/lib/ModPerl FunctionMap.pm WrapXS.pm
dougm 01/05/02 22:41:02
Modified:lib/ModPerl FunctionMap.pm WrapXS.pm
Log:
add BOOT keyword to indicate a function should be called at BOOT time
Revision ChangesPath
1.8 +4 -1 modperl-2.0/lib/ModPerl/FunctionMap.pm
Index: FunctionMap.pm
===
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/FunctionMap.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- FunctionMap.pm2001/05/03 04:56:31 1.7
+++ FunctionMap.pm2001/05/03 05:41:02 1.8
@@ -57,7 +57,7 @@
return @missing ? \@missing : undef;
}
-my $keywords = join '|', qw(MODULE PACKAGE PREFIX);
+my $keywords = join '|', qw(MODULE PACKAGE PREFIX BOOT);
sub guess_prefix {
my $entry = shift;
@@ -129,6 +129,9 @@
}
if ($cur{ISA}) {
$self-{isa}-{ $cur{MODULE} }-{$package} = delete $cur{ISA};
+}
+if ($cur{BOOT}) {
+$self-{boot}-{ $cur{MODULE} } = delete $cur{BOOT};
}
}
else {
1.14 +12 -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.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- WrapXS.pm 2001/05/03 04:56:31 1.13
+++ WrapXS.pm 2001/05/03 05:41:02 1.14
@@ -378,6 +378,17 @@
$str;
}
+sub boot {
+my($self, $module) = @_;
+my $str = ;
+
+if (my $boot = $self-typemap-{function_map}-{boot}-{$module}) {
+$str = 'mpxs_' . $self-cname($module) . _BOOT(aTHXo);\n;
+}
+
+$str;
+}
+
sub write_xs {
my($self, $module, $functions) = @_;
@@ -428,6 +439,7 @@
print $fh PROTOTYPES: disabled\n\n;
print $fh BOOT:\n;
+print $fh $self-boot($module);
print $fh items = items; /* -Wall */\n\n;
if (my $newxs = $self-{newXS}-{$module}) {
cvs commit: modperl-2.0/lib/ModPerl FunctionMap.pm
dougm 01/03/04 19:44:58
Added: lib/ModPerl FunctionMap.pm
Log:
module for mapping functions
Revision ChangesPath
1.1 modperl-2.0/lib/ModPerl/FunctionMap.pm
Index: FunctionMap.pm
===
package ModPerl::FunctionMap;
use strict;
use warnings FATAL = 'all';
use ModPerl::MapUtil qw();
use ModPerl::ParseSource ();
use Apache::FunctionTable ();
use ModPerl::FunctionTable ();
our @ISA = qw(ModPerl::MapBase);
sub new {
my $class = shift;
bless {}, $class;
}
#for adding to function.map
sub generate {
my $self = shift;
my $missing = $self-check;
return unless $missing;
print " $_\n" for @$missing;
}
sub disabled { shift-{disabled} }
#look for functions that do not exist in *.map
sub check {
my $self = shift;
my $map = $self-get;
my @missing;
my $mp_func = ModPerl::ParseSource-wanted_functions;
for my $name (map $_-{name}, @{ $self-function_table() }) {
next if exists $map-{$name};
push @missing, $name unless $name =~ /^($mp_func)/o;
}
return @missing ? \@missing : undef;
}
#look for functions in *.map that do not exist
my $special_name = qr{(^DEFINE_|DESTROY$)};
sub check_exists {
my $self = shift;
my %functions = map { $_-{name}, 1 } @{ $self-function_table() };
my @missing = ();
for my $name (keys %{ $self-{map} }) {
next if $functions{$name};
push @missing, $name unless $name =~ $special_name;
}
return @missing ? \@missing : undef;
}
my $keywords = join '|', qw(MODULE PACKAGE PREFIX);
sub guess_prefix {
my $entry = shift;
my($name, $class) = ($entry-{name}, $entry-{class});
my $prefix = "";
$name =~ s/^DEFINE_//;
(my $guess = lc($entry-{class} || $entry-{module}) . '_') =~ s/::/_/g;
$guess =~ s/apache_/ap_/;
if ($name =~ /^$guess/) {
$prefix = $guess;
}
else {
if ($name =~ /^(apr?_)/) {
$prefix = $1;
}
}
#print "GUESS prefix=$guess, name=$entry-{name} - $prefix\n";
return $prefix;
}
sub parse {
my($self, $fh, $map) = @_;
my %cur;
my $disabled = 0;
while ($fh-readline) {
if (/($keywords)=/o) {
$disabled = s/^\W//; #module is disabled
my %words = $self-parse_keywords($_);
if ($words{MODULE}) {
%cur = ();
}
for (keys %words) {
$cur{$_} = $words{$_};
}
next;
}
my($name, $dispatch, $argspec, $alias) = split /\s*\|\s*/;
my $return_type;
if ($name =~ s/^([^:]+)://) {
$return_type = $1;
}
if ($name =~ s/^(\W)// or not $cur{MODULE} or $disabled) {
#notimplemented or cooked by hand
$map-{$name} = undef;
push @{ $self-{disabled}-{ $1 || '!' } }, $name;
next;
}
my $entry = $map-{$name} = {
name= $alias || $name,
dispatch= $dispatch,
argspec = $argspec ? [split /\s*,\s*/, $argspec] : "",
return_type = $return_type,
alias = $alias,
};
if (my $package = $cur{PACKAGE}) {
unless ($package eq 'guess') {
$cur{CLASS} = $package;
}
}
else {
$cur{CLASS} = $cur{MODULE};
}
for (keys %cur) {
$entry-{lc $_} = $cur{$_};
}
$entry-{prefix} ||= guess_prefix($entry);
#avoid 'use of uninitialized value' warnings
$entry-{$_} ||= "" for keys %{ $entry };
if ($entry-{dispatch} =~ /_$/) {
$entry-{dispatch} .= $name;
}
}
}
sub get {
my $self = shift;
$self-{map} ||= $self-parse_map_files;
}
sub prefixes {
my $self = shift;
$self = ModPerl::FunctionMap-new unless ref $self;
my $map = $self-get;
my %prefix;
while (my($name, $ent) = each %$map) {
next unless $ent-{prefix};
$prefix{ $ent-{prefix} }++;
}
[keys %prefix]
}
1;
__END__
