home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / MapUtil.pm < prev    next >
Encoding:
Perl POD Document  |  2001-08-25  |  3.2 KB  |  157 lines
  1. package ModPerl::MapUtil;
  2.  
  3. use strict;
  4. use warnings;
  5. use Exporter ();
  6. use Apache::Build ();
  7.  
  8. our @EXPORT_OK = qw(list_first disabled_reason
  9.                     function_table structure_table
  10.                     xs_glue_dirs);
  11.  
  12. our @ISA = qw(Exporter);
  13.  
  14. my %disabled_map = (
  15.     '!' => 'disabled or not yet implemented',
  16.     '~' => 'implemented but not auto-generated',
  17.     '-' => 'likely never be available to Perl',
  18.     '>' => '"private" to apache',
  19.     '?' => 'unclassified',
  20. );
  21.  
  22. my $function_table = [];
  23.  
  24. sub function_table {
  25.     return $function_table if @$function_table;
  26.     push @INC, "xs/tables/current";
  27.     require Apache::FunctionTable;
  28.     require ModPerl::FunctionTable;
  29.     @$function_table = (@$Apache::FunctionTable, @$ModPerl::FunctionTable);
  30.     $function_table;
  31. }
  32.  
  33. my $structure_table = [];
  34.  
  35. sub structure_table {
  36.     return $structure_table if @$structure_table;
  37.     require Apache::StructureTable;
  38.     @$structure_table = (@$Apache::StructureTable);
  39.     $structure_table;
  40. }
  41.  
  42. sub disabled_reason {
  43.     $disabled_map{+shift} || 'unknown';
  44. }
  45.  
  46. sub xs_glue_dirs {
  47.     Apache::Build->build_config->mp_xs_glue_dir;
  48. }
  49.  
  50. sub list_first (&@) {
  51.     my $code = shift;
  52.  
  53.     for (@_) {
  54.         return $_ if $code->();
  55.     }
  56.  
  57.     undef;
  58. }
  59.  
  60. package ModPerl::MapBase;
  61.  
  62. *function_table = \&ModPerl::MapUtil::function_table;
  63. *structure_table = \&ModPerl::MapUtil::structure_table;
  64.  
  65. sub readline {
  66.     my $fh = shift;
  67.  
  68.     while (<$fh>) {
  69.         chomp;
  70.         s/^\s+//; s/\s+$//;
  71.         s/^\#.*//;
  72.         s/\s*\#.*//;
  73.  
  74.         next unless $_;
  75.  
  76.         if (s:\\$::) {
  77.             my $cur = $_;
  78.             $_ = $cur . $fh->readline;
  79.             return $_;
  80.         }
  81.  
  82.         return $_;
  83.     }
  84. }
  85.  
  86. our $MapDir;
  87.  
  88. my $map_classes = join '|', qw(type structure function);
  89.  
  90. sub map_files {
  91.     my $self = shift;
  92.     my $package = ref($self) || $self;
  93.  
  94.     my($wanted) = $package =~ /($map_classes)/io;
  95.  
  96.     my(@dirs) = (($MapDir || './xs'), ModPerl::MapUtil::xs_glue_dirs());
  97.  
  98.     my @files;
  99.  
  100.     for my $dir (map { -d "$_/maps" ? "$_/maps" : $_ } @dirs) {
  101.         opendir my $dh, $dir or warn "opendir $dir: $!";
  102.  
  103.         for (readdir $dh) {
  104.             next unless /\.map$/;
  105.  
  106.             my $file = "$dir/$_";
  107.  
  108.             if ($wanted) {
  109.                 next unless $file =~ /$wanted/i;
  110.             }
  111.  
  112.             #print "$package => $file\n";
  113.             push @files, $file;
  114.         }
  115.  
  116.         closedir $dh;
  117.     }
  118.  
  119.     return @files;
  120. }
  121.  
  122. sub parse_keywords {
  123.     my($self, $line) = @_;
  124.     my %words;
  125.  
  126.     for my $pair (split /\s+/, $line) {
  127.         my($key, $val) = split /=/, $pair;
  128.  
  129.         unless ($key and $val) {
  130.             die "parse error ($ModPerl::MapUtil::MapFile line $.)";
  131.         }
  132.  
  133.         $words{$key} = $val;
  134.     }
  135.  
  136.     %words;
  137. }
  138.  
  139. sub parse_map_files {
  140.     my($self) = @_;
  141.  
  142.     my $map = {};
  143.  
  144.     for my $file (map_files($self)) {
  145.         open my $fh, $file or die "open $file: $!";
  146.         local $ModPerl::MapUtil::MapFile = $file;
  147.         bless $fh, __PACKAGE__;
  148.         $self->parse($fh, $map);
  149.         close $fh;
  150.     }
  151.  
  152.     return $map;
  153. }
  154.  
  155. 1;
  156. __END__
  157.