home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / MapUtil.pm < prev    next >
Encoding:
Perl POD Document  |  2004-07-09  |  3.9 KB  |  177 lines
  1. # Copyright 2001-2004 The Apache Software Foundation
  2. #
  3. # Licensed under the Apache License, Version 2.0 (the "License");
  4. # you may not use this file except in compliance with the License.
  5. # You may obtain a copy of the License at
  6. #
  7. #     http://www.apache.org/licenses/LICENSE-2.0
  8. #
  9. # Unless required by applicable law or agreed to in writing, software
  10. # distributed under the License is distributed on an "AS IS" BASIS,
  11. # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  12. # See the License for the specific language governing permissions and
  13. # limitations under the License.
  14. #
  15. package ModPerl::MapUtil;
  16.  
  17. use strict;
  18. use warnings;
  19. use Exporter ();
  20. use Apache::Build ();
  21.  
  22. our @EXPORT_OK = qw(list_first disabled_reason
  23.                     function_table structure_table
  24.                     xs_glue_dirs);
  25.  
  26. our @ISA = qw(Exporter);
  27.  
  28. # the mapping happens in lib/ModPerl/StructureMap.pm
  29. #    '<' => 'auto-generated but gives only a read-only access'
  30. #    '&' => 'RDWR accessor to a char* field, supporting undef arg'
  31. #    '$'  => 'RONLY accessor, with WRITE accessor before child_init'
  32. my %disabled_map = (
  33.     '!' => 'disabled or not yet implemented',
  34.     '~' => 'implemented but not auto-generated',
  35.     '-' => 'likely never be available to Perl',
  36.     '>' => '"private" to apache',
  37.     '?' => 'unclassified',
  38. );
  39.  
  40. my $function_table = [];
  41.  
  42. sub function_table {
  43.     return $function_table if @$function_table;
  44.     push @INC, "xs/tables/current";
  45.     require Apache::FunctionTable;
  46.     require ModPerl::FunctionTable;
  47.     require APR::FunctionTable;
  48.     @$function_table = (@$Apache::FunctionTable, @$ModPerl::FunctionTable,
  49.                         @$APR::FunctionTable);
  50.     $function_table;
  51. }
  52.  
  53. my $structure_table = [];
  54.  
  55. sub structure_table {
  56.     return $structure_table if @$structure_table;
  57.     require Apache::StructureTable;
  58.     @$structure_table = (@$Apache::StructureTable);
  59.     $structure_table;
  60. }
  61.  
  62. sub disabled_reason {
  63.     $disabled_map{+shift} || 'unknown';
  64. }
  65.  
  66. sub xs_glue_dirs {
  67.     Apache::Build->build_config->mp_xs_glue_dir;
  68. }
  69.  
  70. sub list_first (&@) {
  71.     my $code = shift;
  72.  
  73.     for (@_) {
  74.         return $_ if $code->();
  75.     }
  76.  
  77.     undef;
  78. }
  79.  
  80. package ModPerl::MapBase;
  81.  
  82. *function_table = \&ModPerl::MapUtil::function_table;
  83. *structure_table = \&ModPerl::MapUtil::structure_table;
  84.  
  85. sub readline {
  86.     my $fh = shift;
  87.  
  88.     while (<$fh>) {
  89.         chomp;
  90.         s/^\s+//; s/\s+$//;
  91.         s/^\#.*//;
  92.         s/\s*\#.*//;
  93.  
  94.         next unless $_;
  95.  
  96.         if (s:\\$::) {
  97.             my $cur = $_;
  98.             $_ = $cur . $fh->readline;
  99.             return $_;
  100.         }
  101.  
  102.         return $_;
  103.     }
  104. }
  105.  
  106. our $MapDir;
  107.  
  108. my $map_classes = join '|', qw(type structure function);
  109.  
  110. sub map_files {
  111.     my $self = shift;
  112.     my $package = ref($self) || $self;
  113.  
  114.     my($wanted) = $package =~ /($map_classes)/io;
  115.  
  116.     my(@dirs) = (($MapDir || './xs'), ModPerl::MapUtil::xs_glue_dirs());
  117.  
  118.     my @files;
  119.  
  120.     for my $dir (map { -d "$_/maps" ? "$_/maps" : $_ } @dirs) {
  121.         opendir my $dh, $dir or warn "opendir $dir: $!";
  122.  
  123.         for (readdir $dh) {
  124.             next unless /\.map$/;
  125.  
  126.             my $file = "$dir/$_";
  127.  
  128.             if ($wanted) {
  129.                 next unless $file =~ /$wanted/i;
  130.             }
  131.  
  132.             #print "$package => $file\n";
  133.             push @files, $file;
  134.         }
  135.  
  136.         closedir $dh;
  137.     }
  138.  
  139.     return @files;
  140. }
  141.  
  142. sub parse_keywords {
  143.     my($self, $line) = @_;
  144.     my %words;
  145.  
  146.     for my $pair (split /\s+/, $line) {
  147.         my($key, $val) = split /=/, $pair;
  148.  
  149.         unless ($key and $val) {
  150.             die "parse error ($ModPerl::MapUtil::MapFile line $.)";
  151.         }
  152.  
  153.         $words{$key} = $val;
  154.     }
  155.  
  156.     %words;
  157. }
  158.  
  159. sub parse_map_files {
  160.     my($self) = @_;
  161.  
  162.     my $map = {};
  163.  
  164.     for my $file (map_files($self)) {
  165.         open my $fh, $file or die "open $file: $!";
  166.         local $ModPerl::MapUtil::MapFile = $file;
  167.         bless $fh, __PACKAGE__;
  168.         $self->parse($fh, $map);
  169.         close $fh;
  170.     }
  171.  
  172.     return $map;
  173. }
  174.  
  175. 1;
  176. __END__
  177.