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 / StructureMap.pm < prev    next >
Encoding:
Perl POD Document  |  2001-04-18  |  2.8 KB  |  131 lines
  1. package ModPerl::StructureMap;
  2.  
  3. use strict;
  4. use warnings FATAL => 'all';
  5. use ModPerl::MapUtil qw(structure_table);
  6.  
  7. our @ISA = qw(ModPerl::MapBase);
  8.  
  9. sub new {
  10.     my $class = shift;
  11.     bless {}, $class;
  12. }
  13.  
  14. sub generate {
  15.     my $self = shift;
  16.     my $map = $self->get;
  17.  
  18.     for my $entry (@{ structure_table() }) {
  19.         my $type = $entry->{type};
  20.         my $elts = $entry->{elts};
  21.  
  22.         next unless @$elts;
  23.         next if $type =~ $self->{IGNORE_RE};
  24.         next unless grep {
  25.             not exists $map->{$type}->{ $_->{name} }
  26.         } @$elts;
  27.  
  28.         print "<$type>\n";
  29.         for my $e (@$elts) {
  30.             print "   $e->{name}\n";
  31.         }
  32.         print "</$type>\n\n";
  33.     }
  34. }
  35.  
  36. sub disabled { shift->{disabled} }
  37.  
  38. sub check {
  39.     my $self = shift;
  40.     my $map = $self->get;
  41.  
  42.     my @missing;
  43.  
  44.     for my $entry (@{ structure_table() }) {
  45.         my $type = $entry->{type};
  46.  
  47.         for my $name (map $_->{name}, @{ $entry->{elts} }) {
  48.             next if exists $map->{$type}->{$name};
  49.             next if $type =~ $self->{IGNORE_RE};
  50.             push @missing, "$type.$name";
  51.         }
  52.     }
  53.  
  54.     return @missing ? \@missing : undef;
  55. }
  56.  
  57. sub check_exists {
  58.     my $self = shift;
  59.  
  60.     my %structures;
  61.     for my $entry (@{ structure_table() }) {
  62.         $structures{ $entry->{type} } = { map {
  63.             $_->{name}, 1
  64.         } @{ $entry->{elts} } };
  65.     }
  66.  
  67.     my @missing;
  68.  
  69.     while (my($type, $elts) = each %{ $self->{map} }) {
  70.         for my $name (keys %$elts) {
  71.             next if exists $structures{$type}->{$name};
  72.             push @missing, "$type.$name";
  73.         }
  74.     }
  75.  
  76.     return @missing ? \@missing : undef;
  77. }
  78.  
  79. sub parse {
  80.     my($self, $fh, $map) = @_;
  81.  
  82.     my($disabled, $class);
  83.     my %cur;
  84.  
  85.     while ($fh->readline) {
  86.         if (m:^(\W?)</?([^>]+)>:) {
  87.             my $args;
  88.             $disabled = $1;
  89.             ($class, $args) = split /\s+/, $2, 2;
  90.  
  91.             %cur = ();
  92.             if ($args and $args =~ /E=/) {
  93.                 %cur = $self->parse_keywords($args);
  94.             }
  95.  
  96.             $self->{MODULES}->{$class} = $cur{MODULE} if $cur{MODULE};
  97.  
  98.             next;
  99.         }
  100.         elsif (s/^(\w+):\s*//) {
  101.             push @{ $self->{$1} }, split /\s+/;
  102.             next;
  103.         }
  104.  
  105.         if (s/^(\W)\s*// or $disabled) {
  106.             $map->{$class}->{$_} = undef;
  107.             push @{ $self->{disabled}->{ $1 || '!' } }, "$class.$_";
  108.         }
  109.         else {
  110.             $map->{$class}->{$_} = 1;
  111.         }
  112.     }
  113.  
  114.     if (my $ignore = $self->{IGNORE}) {
  115.         $ignore = join '|', @$ignore;
  116.         $self->{IGNORE_RE} = qr{^($ignore)};
  117.     }
  118.     else {
  119.         $self->{IGNORE_RE} = qr{^$};
  120.     }
  121. }
  122.  
  123. sub get {
  124.     my $self = shift;
  125.  
  126.     $self->{map} ||= $self->parse_map_files;
  127. }
  128.  
  129. 1;
  130. __END__
  131.