You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@apache.org on 2001/04/12 00:38:21 UTC
cvs commit: modperl-2.0/util source_scan.pl
dougm 01/04/11 15:38:21
Modified: lib/Apache ParseSource.pm
util source_scan.pl
Log:
generate Apache::ConstantsTable
Revision Changes Path
1.13 +128 -27 modperl-2.0/lib/Apache/ParseSource.pm
Index: ParseSource.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/ParseSource.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- ParseSource.pm 2001/03/05 00:04:55 1.12
+++ ParseSource.pm 2001/04/11 22:38:17 1.13
@@ -87,7 +87,8 @@
}
my @includes;
- my $unwanted = join '|', qw(ap_listen internal version);
+ my $unwanted = join '|', qw(ap_listen internal version
+ apr_optional mod_include);
for my $dir (@dirs) {
File::Find::finddepth({
@@ -124,59 +125,151 @@
return $filename;
}
+my $filemode = join '|',
+ qw{READ WRITE CREATE APPEND TRUNCATE BINARY EXCL BUFFERED DELONCLOSE};
-my $defines_wanted = join '|', qw{
-OK DECLINED DONE
-DECLINE_CMD DIR_MAGIC_TYPE
-METHODS
-HTTP_ M_ OPT_ SATISFY_ REMOTE_
-OR_ ACCESS_CONF RSRC_CONF
-};
+my %defines_wanted = (
+ Apache => {
+ common => [qw{OK DECLINED DONE}],
+ methods => [qw{M_ METHODS}],
+ options => [qw{OPT_}],
+ satisfy => [qw{SATISFY_}],
+ remotehost => [qw{REMOTE_}],
+ http => [qw{HTTP_}],
+# config => [qw{DECLINE_CMD}],
+# types => [qw{DIR_MAGIC_TYPE}],
+ override => [qw{OR_ ACCESS_CONF RSRC_CONF}],
+ },
+ APR => {
+ poll => [qw{APR_POLL}],
+ common => [qw{APR_SUCCESS}],
+ error => [qw{APR_E}],
+ fileperms => [qw{APR_\w(READ|WRITE|EXECUTE)}],
+ finfo => [qw{APR_FINFO_}],
+ filepath => [qw{APR_FILEPATH_}],
+ filemode => ["APR_($filemode)"],
+ flock => [qw{APR_FLOCK_}],
+ socket => [qw{APR_SO_}],
+ limit => [qw{APR_LIMIT}],
+ hook => [qw{APR_HOOK_}],
+ },
+);
+
+my %defines_wanted_re;
+while (my($class, $groups) = each %defines_wanted) {
+ while (my($group, $wanted) = each %$groups) {
+ my $pat = join '|', @$wanted;
+ $defines_wanted_re{$class}->{$group} = $pat; #qr{^($pat)};
+ }
+}
+
+my %enums_wanted = (
+ Apache => { map { $_, 1 } qw(cmd_how) },
+ APR => { map { $_, 1 } qw(apr_shutdown_how) },
+);
my $defines_unwanted = join '|', qw{
HTTP_VERSION
};
-my %enums_wanted = map { $_, 1 } qw(cmd_how);
-
sub get_constants {
my($self) = @_;
my $includes = $self->find_includes;
- my @constants;
+ my(%constants, %seen);
for my $file (@$includes) {
open my $fh, $file or die "open $file: $!";
while (<$fh>) {
- if (s/^\#define\s+//) {
- next unless /^($defines_wanted)/o;
- next if /^($defines_unwanted)/o;
- push @constants, (split /\s+/)[0];
- } elsif (m/^\s*enum\s+(\w+)\s+\{/) {
- my $e = $self->get_enum($1, $fh);
- push @constants, @$e if $e;
+ if (s/^\#define\s+(\w+)\s+.*/$1/) {
+ chomp;
+ next if $seen{$_}++;
+ $self->handle_constant(\%constants);
+ }
+ elsif (m/enum[^\{]+\{/) {
+ $self->handle_enum($fh, \%constants);
}
}
close $fh;
}
- return \@constants;
+ #maintain a few handy shortcuts from 1.xx
+ #aliases are defined in ModPerl::Code
+ push @{ $constants{'Apache'}->{common} },
+ qw(NOT_FOUND FORBIDDEN AUTH_REQUIRED SERVER_ERROR);
+
+ return \%constants;
}
-sub get_enum {
- my($self, $name, $fh) = @_;
+sub handle_constant {
+ my($self, $constants) = @_;
+ my $keys = keys %defines_wanted_re; #XXX broken bleedperl ?
+
+ return if /^($defines_unwanted)/o;
+
+ while (my($class, $groups) = each %defines_wanted_re) {
+ my $keys = keys %$groups; #XXX broken bleedperl ?
+
+ while (my($group, $re) = each %$groups) {
+ next unless /^($re)/;
+ push @{ $constants->{$class}->{$group} }, $_;
+ return;
+ }
+ }
+}
+
+sub handle_enum {
+ my($self, $fh, $constants) = @_;
+
+ my($name, $e) = $self->parse_enum($fh);
+ return unless $name;
+
+ $name =~ s/_e$//;
+
+ my $class;
+ for (keys %enums_wanted) {
+ next unless $enums_wanted{$_}->{$name};
+ $class = $_;
+ }
- return unless $enums_wanted{$name};
- local $_;
+ return unless $class;
+ $name =~ s/^apr_//;
+
+ push @{ $constants->{$class}->{$name} }, @$e if $e;
+}
+
+#this should win an award for worlds lamest parser
+sub parse_enum {
+ my($self, $fh) = @_;
+ my $code = $_;
my @e;
+
+ unless ($code =~ /;\s*$/) {
+ local $_;
+ while (<$fh>) {
+ $code .= $_;
+ last if /;\s*$/;
+ }
+ }
- while (<$fh>) {
- last if /\};/;
- next unless /^\s*(\w+)/;
+ my $name;
+ if ($code =~ s/^\s*enum\s+(\w*)\s*//) {
+ $name = $1;
+ }
+ elsif ($code =~ s/^\s*typedef\s+enum\s+//) {
+ $code =~ s/\s*(\w+)\s*;\s*$//;
+ $name = $1;
+ }
+ $code =~ s:/\*.*?\*/::sg;
+ $code =~ s/\s*=\s*\d+//g;
+ $code =~ s/^[^\{]*\{//s;
+ $code =~ s/\}[^;]*;?//s;
+
+ while ($code =~ /\b(\w+)\b,?/g) {
push @e, $1;
}
- return \@e;
+ return ($name, \@e);
}
sub wanted_functions { shift->{prefix_re} }
@@ -277,6 +370,14 @@
my $name = shift || 'Apache::StructureTable';
$self->write_pm($file, $name, $self->get_structs);
+}
+
+sub write_constants_pm {
+ my $self = shift;
+ my $file = shift || 'ConstantsTable.pm';
+ my $name = shift || 'Apache::ConstantsTable';
+
+ $self->write_pm($file, $name, $self->get_constants);
}
sub write_pm {
1.4 +2 -0 modperl-2.0/util/source_scan.pl
Index: source_scan.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/util/source_scan.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- source_scan.pl 2001/03/05 03:57:40 1.3
+++ source_scan.pl 2001/04/11 22:38:20 1.4
@@ -12,6 +12,8 @@
$p->parse;
+$p->write_constants_pm;
+
$p->write_functions_pm;
$p->write_structs_pm;