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 / Preprocessor.pm < prev    next >
Encoding:
Perl POD Document  |  2004-05-24  |  31.1 KB  |  1,009 lines
  1. # $Id: Preprocessor.pm,v 1.32 2004/05/24 14:02:08 rcaputo Exp $
  2.  
  3. package POE::Preprocessor;
  4.  
  5. use strict;
  6.  
  7. use vars qw($VERSION);
  8. $VERSION = do {my@r=(q$Revision: 1.32 $=~/\d+/g);sprintf"%d."."%04d"x$#r,@r};
  9.  
  10. use Carp qw(croak);
  11. use Filter::Util::Call;
  12. use Symbol qw(gensym);
  13. use File::Path qw(mkpath);
  14. use File::Spec;
  15.  
  16. sub MAC_PARAMETERS () { 0 }
  17. sub MAC_CODE       () { 1 }
  18. sub MAC_NAME       () { 2 } # only used in temporary %macro
  19. sub MAC_FILE       () { 3 }
  20. sub MAC_LINE       () { 4 } # only used in temporary %macro
  21.  
  22. sub STATE_PLAIN     () { 0x0000 }
  23. sub STATE_MACRO_DEF () { 0x0001 }
  24.  
  25. sub COND_FLAG   () { 0 }
  26. sub COND_LINE   () { 1 }
  27. sub COND_INDENT () { 2 }
  28.  
  29. BEGIN {
  30.   if (defined $ENV{POE_PREPROC_DUMP}) {
  31.     eval "sub DUMP_EXPANDED () { 1 }";
  32.     eval "sub DUMP_BASE     () { '$ENV{POE_PREPROC_DUMP}' }";
  33.   }
  34.   else {
  35.     eval "sub DUMP_EXPANDED () { 0 }";
  36.     eval "sub DUMP_BASE     () { die }";
  37.   }
  38. };
  39.  
  40. #sub DEBUG () { 1 }
  41. #sub DEBUG_INVOKE () { 1 }
  42. #sub DEBUG_DEFINE () { 1 }
  43.  
  44. #sub WARN_DEFINE  () { 1 }
  45.  
  46. BEGIN {
  47.   defined &DEBUG        or eval 'sub DEBUG        () { 0 }'; # preprocessor
  48.   defined &DEBUG_INVOKE or eval 'sub DEBUG_INVOKE () { 0 }'; # macro invocs
  49.   defined &DEBUG_DEFINE or eval 'sub DEBUG_DEFINE () { 0 }'; # macro defines
  50.   defined &WARN_DEFINE  or eval 'sub WARN_DEFINE  () { 0 }'; # redefine warning
  51. };
  52.  
  53. ### Start of regexp optimizer.
  54.  
  55. # text_trie_trie is virtually identical to code in Ilya Zakharevich's
  56. # Text::Trie::Trie function.  The minor differences involve hardcoding
  57. # the minimum substring length to 1 and sorting the output.
  58.  
  59. sub text_trie_trie {
  60.   my @list = @_;
  61.   return shift if @_ == 1;
  62.   my (@trie, %first);
  63.  
  64.   foreach (@list) {
  65.     my $c = substr $_, 0, 1;
  66.     if (exists $first{$c}) {
  67.       push @{$first{$c}}, $_;
  68.     }
  69.     else {
  70.       $first{$c} = [ $_ ];
  71.     }
  72.   }
  73.  
  74.   foreach (sort keys %first) {
  75.     # Find common substring
  76.     my $substr = $first{$_}->[0];
  77.     (push @trie, $substr), next if @{$first{$_}} == 1;
  78.     my $l = length($substr);
  79.     foreach (@{$first{$_}}) {
  80.       $l-- while substr($_, 0, $l) ne substr($substr, 0, $l);
  81.     }
  82.     $substr = substr $substr, 0, $l;
  83.  
  84.     # Feed the trie.
  85.     @list = map {substr $_, $l} @{$first{$_}};
  86.     push @trie, [$substr, text_trie_trie(@list)];
  87.   }
  88.  
  89.   @trie;
  90. }
  91.  
  92. # This is basically Text::Trie::walkTrie, but it's hardcoded to build
  93. # regular expressions.
  94.  
  95. sub text_trie_as_regexp {
  96.   my @trie   = @_;
  97.   my $num    = 0;
  98.   my $regexp = '';
  99.  
  100.   foreach (@trie) {
  101.     $regexp .= '|' if $num++;
  102.     if (ref $_ eq 'ARRAY') {
  103.       $regexp .= $_->[0] . '(?:';
  104.  
  105.       # If the first tail is empty, make the whole group optional.
  106.       my ($tail, $first);
  107.       if (length $_->[1]) {
  108.         $tail  = ')';
  109.         $first = 1;
  110.       }
  111.       else {
  112.         $tail  = ')?';
  113.         $first = 2;
  114.       }
  115.  
  116.       # Recurse into the group of tails.
  117.       if ($#$_ > 1) {
  118.         $regexp .= text_trie_as_regexp( @{$_}[$first .. $#$_] );
  119.       }
  120.       $regexp .= $tail;
  121.     }
  122.     else {
  123.       $regexp .= $_;
  124.     }
  125.   }
  126.  
  127.   $regexp;
  128. }
  129.  
  130. ### End of regexp optimizer.
  131.  
  132. # These must be accessible from outside the current package.
  133. use vars qw(%conditional_stacks %excluding_code %exclude_indent);
  134.  
  135. sub fix_exclude {
  136.   my $package_name = shift;
  137.   $excluding_code{$package_name} = 0;
  138.   if (@{$conditional_stacks{$package_name}}) {
  139.     foreach my $flag (@{$conditional_stacks{$package_name}}) {
  140.       unless ($flag->[COND_FLAG]) {
  141.         $excluding_code{$package_name} = 1;
  142.         $exclude_indent{$package_name} = $flag->[COND_INDENT];
  143.         last;
  144.       }
  145.     }
  146.   }
  147. }
  148.  
  149. my (%constants, %macros, %const_regexp, %macro);
  150.  
  151. sub import {
  152.  
  153.     my $self = shift;
  154.     my %args;
  155.     if(@_ > 1) {
  156.         %args = @_;
  157.     }
  158.  
  159.     # Outer closure to define a unique scope.
  160.     { my $macro_name = '';
  161.       my ($macro_line, $enum_index);
  162.       my ($package_name, $file_name, $line_number) = (caller)[0,1,2];
  163.       my $const_regexp_dirty = 0;
  164.       my $state = STATE_PLAIN;
  165.       my $dump_file;
  166.  
  167.       DUMP_EXPANDED and do {
  168.         my ($vol, $dir, $file) = File::Spec->splitpath($file_name);
  169.         my $dest_dir      = File::Spec->catdir(DUMP_BASE, $dir);
  170.         my $dest_filename = File::Spec->catfile($dest_dir, $file);
  171.  
  172.         mkpath($dest_dir, 0, 0777);
  173.         $dump_file = gensym;
  174.         open $dump_file, ">$dest_filename"
  175.           or die "POE::Preprocessor could not create $dest_filename: $!";
  176.         print $dump_file "package $package_name;\n";
  177.       };
  178.  
  179.     # The following block processes inheritance requests for
  180.     # macros/constants and enums.  added by sungo 09/2001
  181.     my @isas;
  182.  
  183.     if($args{isa}) {
  184.         if(ref $args{isa} eq 'ARRAY') {
  185.             foreach my $isa (@{$args{isa}}) {
  186.                 push @isas, $isa;
  187.             }
  188.         } else {
  189.             push @isas, $args{isa};
  190.         }
  191.         foreach my $isa (@isas) {
  192.             eval "use $isa";
  193.             croak "Unable to load $isa : $@" if $@;
  194.  
  195.             foreach my $const (keys %{$constants{$isa}}) {
  196.                 $constants{$package_name}->{$const} =
  197.                   $constants{$isa}->{$const};
  198.                 $const_regexp_dirty = 1;
  199.             }
  200.  
  201.             foreach my $macro (keys %{$macros{$isa}}) {
  202.                 $macros{$package_name}->{$macro} = $macros{$isa}->{$macro};
  203.             }
  204.         }
  205.     }
  206.  
  207.     $conditional_stacks{$package_name} = [ ];
  208.     $excluding_code{$package_name} = 0;
  209.  
  210.     my $set_const = sub {
  211.       my ($name, $value) = @_;
  212.  
  213.       if (WARN_DEFINE && exists $constants{$package_name}->{$name}) {
  214.         warn "const $name redefined at $file_name line $line_number\n"
  215.           unless $constants{$package_name}->{$name} eq $value;
  216.       }
  217.  
  218.       $constants{$package_name}->{$name} = $value;
  219.       $const_regexp_dirty++;
  220.  
  221.       DEBUG_DEFINE and
  222.         warn( ",-----\n",
  223.               "| Defined a constant: $name = $value\n",
  224.               "`-----\n"
  225.             );
  226.     };
  227.  
  228.     # Define the filter sub.
  229.     filter_add
  230.       ( sub {
  231.           my $status = filter_read();
  232.           $line_number++;
  233.  
  234.           ### Handle errors or EOF.
  235.           if ($status <= 0) {
  236.             if (@{$conditional_stacks{$package_name}}) {
  237.               die( "include block never closed.  It probably started " .
  238.                    "at $file_name line " .
  239.                    $conditional_stacks{$package_name}->[0]->[COND_LINE] . "\n"
  240.                  );
  241.             }
  242.             DUMP_EXPANDED and close $dump_file;
  243.             return $status;
  244.           }
  245.  
  246.           ### Usurp modified Perl syntax for code inclusion.  These
  247.           ### are hardcoded and always handled.
  248.  
  249.           # Only do the conditionals if there's a flag present.
  250.           if (/\#\s*include/) {
  251.  
  252.             # if (...) { # include
  253.             if (/^(\s*)if\s*\((.+)\)\s*\{\s*\#\s*include\s*$/) {
  254.               my $space = (defined $1) ? $1 : '';
  255.               $_ =
  256.                 ( $space .
  257.                   "BEGIN { push( \@{\$" . __PACKAGE__ .
  258.                   "::conditional_stacks{'$package_name'}}, " .
  259.                   "[ !!$2, $line_number, '$space' ] ); \&" . __PACKAGE__ .
  260.                   "::fix_exclude('$package_name'); }; # $_"
  261.                 );
  262.               s/\#\s+/\# /;
  263.  
  264.               # Dummy line in the macro.
  265.               if ($state & STATE_MACRO_DEF) {
  266.                 local $_ = $_;
  267.                 s/B/\# B/;
  268.                 $macro_line++;
  269.                 $macro{$package_name}->[MAC_CODE] .= $_;
  270.                 DEBUG and
  271.                   warn sprintf "%4d M: # mac 1: %s", $line_number, $_;
  272.               }
  273.               else {
  274.                 DEBUG and warn sprintf "%4d C: %s", $line_number, $_;
  275.               }
  276.  
  277.               DUMP_EXPANDED and do {
  278.                 print $dump_file $_;
  279.                 close $dump_file if $status <= 0;
  280.               };
  281.               return $status;
  282.             }
  283.  
  284.             # } # include
  285.             elsif (/^\s*\}\s*\#\s*include\s*$/) {
  286.               s/^(\s*)/$1\# /;
  287.               pop @{$conditional_stacks{$package_name}};
  288.               &fix_exclude($package_name);
  289.  
  290.               unless ($state & STATE_MACRO_DEF) {
  291.                 DEBUG and warn sprintf "%4d C: %s", $line_number, $_;
  292.                 DUMP_EXPANDED and do {
  293.                   print $dump_file $_;
  294.                   close $dump_file if $status <= 0;
  295.                 };
  296.                 return $status;
  297.               }
  298.             }
  299.  
  300.             # } else { # include
  301.             elsif (/^\s*\}\s*else\s*\{\s*\#\s*include\s*$/) {
  302.               unless (@{$conditional_stacks{$package_name}}) {
  303.                 die( "else { # include ... without if or unless " .
  304.                      "at $file_name line $line_number\n"
  305.                    );
  306.                 DUMP_EXPANDED and do {
  307.                   print $dump_file $_;
  308.                   close $dump_file;
  309.                 };
  310.                 return -1;
  311.               }
  312.  
  313.               s/^(\s*)/$1\# /;
  314.               $conditional_stacks{$package_name}->[-1]->[COND_FLAG] =
  315.                 !$conditional_stacks{$package_name}->[-1]->[COND_FLAG];
  316.               &fix_exclude($package_name);
  317.  
  318.               unless ($state & STATE_MACRO_DEF) {
  319.                 DEBUG and warn sprintf "%4d C: %s", $line_number, $_;
  320.  
  321.                 DUMP_EXPANDED and do {
  322.                   print $dump_file $_;
  323.                   close $dump_file if $status <= 0;
  324.                 };
  325.                 return $status;
  326.               }
  327.             }
  328.  
  329.             # unless (...) { # include
  330.             elsif (/^(\s*)unless\s*\((.+)\)\s*\{\s*\#\s*include\s*$/) {
  331.               my $space = (defined $1) ? $1 : '';
  332.               $_ = ( $space .
  333.                      "BEGIN { push( \@{\$" . __PACKAGE__ .
  334.                      "::conditional_stacks{'$package_name'}}, " .
  335.                      "[ !$2, $line_number, '$space' ] ); \&" . __PACKAGE__ .
  336.                      "::fix_exclude('$package_name'); }; # $_"
  337.                    );
  338.               s/\#\s+/\# /;
  339.  
  340.               # Dummy line in the macro.
  341.               if ($state & STATE_MACRO_DEF) {
  342.                 local $_ = $_;
  343.                 s/B/\# B/;
  344.                 $macro_line++;
  345.                 $macro{$package_name}->[MAC_CODE] .= $_;
  346.                 DEBUG and
  347.                   warn sprintf "%4d M: # mac 2: %s", $line_number, $_;
  348.               }
  349.               else {
  350.                 DEBUG and warn sprintf "%4d C: %s", $line_number, $_;
  351.               }
  352.  
  353.               DUMP_EXPANDED and do {
  354.                 print $dump_file $_;
  355.                 close $dump_file if $status <= 0;
  356.               };
  357.               return $status;
  358.             }
  359.  
  360.             # } elsif (...) { # include
  361.             elsif (/^(\s*)\}\s*elsif\s*\((.+)\)\s*\{\s*\#\s*include\s*$/) {
  362.               unless (@{$conditional_stacks{$package_name}}) {
  363.                 die( "Include elsif without include if or unless " .
  364.                      "at $file_name line $line_number\n"
  365.                    );
  366.                 DUMP_EXPANDED and do {
  367.                   print $dump_file $_;
  368.                   close $dump_file;
  369.                 };
  370.                 return -1;
  371.               }
  372.  
  373.               my $space = (defined $1) ? $1 : '';
  374.               $_ = ( $space .
  375.                      "BEGIN { \$" . __PACKAGE__ .
  376.                      "::conditional_stacks{'$package_name'}->[-1] = " .
  377.                      "[ !!$2, $line_number, '$space' ]; \&" . __PACKAGE__ .
  378.                      "::fix_exclude('$package_name'); }; # $_"
  379.                    );
  380.               s/\#\s+/\# /;
  381.  
  382.               # Dummy line in the macro.
  383.               if ($state & STATE_MACRO_DEF) {
  384.                 local $_ = $_;
  385.                 s/B/\# B/;
  386.                 $macro_line++;
  387.                 $macro{$package_name}->[MAC_CODE] .= $_;
  388.                 DEBUG and
  389.                   warn sprintf "%4d M: # mac 3: %s", $line_number, $_;
  390.               }
  391.               else {
  392.                 DEBUG and warn sprintf "%4d C: %s", $line_number, $_;
  393.               }
  394.  
  395.               DUMP_EXPANDED and do {
  396.                 print $dump_file $_;
  397.                 close $dump_file if $status <= 0;
  398.               };
  399.               return $status;
  400.             }
  401.           }
  402.  
  403.           ### Not including code, so comment it out.  Don't return
  404.           ### $status here since the code may well be in a macro.
  405.           if ($excluding_code{$package_name}) {
  406.             s{^($exclude_indent{$package_name})?}
  407.              {$exclude_indent{$package_name}\# };
  408.  
  409.             # Kludge: Must thwart macros on this line.
  410.             s/\{\%(.*?)\%\}/MACRO($1)/g;
  411.  
  412.             unless ($state & STATE_MACRO_DEF) {
  413.               DEBUG and warn sprintf "%4d C: %s", $line_number, $_;
  414.               DUMP_EXPANDED and do {
  415.                 print $dump_file $_;
  416.                 close $dump_file if $status <= 0;
  417.               };
  418.               return $status;
  419.             }
  420.           }
  421.  
  422.           ### Inside a macro definition.
  423.           if ($state & STATE_MACRO_DEF) {
  424.  
  425.             # Close it!
  426.             if (/^\}\s*$/) {
  427.               $state = STATE_PLAIN;
  428.  
  429.               DEBUG_DEFINE and
  430.                 warn
  431.                   ( ",-----\n",
  432.                     "| Defined macro $macro_name\n",
  433.                     "| Parameters: ",
  434.                     @{$macro{$package_name}->[MAC_PARAMETERS]}, "\n",
  435.                     "| Code: {\n",
  436.                     $macro{$package_name}->[MAC_CODE],
  437.                     "| }\n",
  438.                     "`-----\n"
  439.                   );
  440.  
  441.               $macro{$package_name}->[MAC_CODE] =~ s/^\s*//;
  442.               $macro{$package_name}->[MAC_CODE] =~ s/\s*$//;
  443.  
  444.               if ( WARN_DEFINE &&
  445.                    exists $macros{$package_name}->{$macro_name}
  446.                  ) {
  447.                 warn( "macro $macro_name redefined at ",
  448.                       "$file_name line $line_number\n"
  449.                     )
  450.                   if ( $macros{$package_name}->{$macro_name}->[MAC_CODE] ne
  451.                        $macro{$package_name}->[MAC_CODE]
  452.                      );
  453.               }
  454.  
  455.               $macros{$package_name}->{$macro_name} = $macro{$package_name};
  456.  
  457.               $macro_name = '';
  458.             }
  459.  
  460.             # Otherwise append this line to the macro.
  461.             else {
  462.               $macro_line++;
  463.               $macro{$package_name}->[MAC_CODE] .= $_;
  464.             }
  465.  
  466.             # Either way, the code must not go on.
  467.             $_ = "# mac 4: $_";
  468.             DEBUG and warn sprintf "%4d M: %s", $line_number, $_;
  469.  
  470.             DUMP_EXPANDED and do {
  471.               print $dump_file $_;
  472.               close $dump_file if $status <= 0;
  473.             };
  474.             return $status;
  475.           }
  476.  
  477.           ### Ignore everything after __END__ or __DATA__.  This works
  478.           ### around a coredump in 5.005_61 through 5.6.0 at the
  479.           ### expense of preprocessing data and documentation.
  480.           if (/^__(END|DATA)__\s*$/) {
  481.             $_ = "# $_";
  482.             DUMP_EXPANDED and do {
  483.               print $dump_file $_;
  484.               close $dump_file;
  485.             };
  486.             return 0;
  487.           }
  488.  
  489.           ### We're done if we're excluding code.
  490.           if ($excluding_code{$package_name}) {
  491.             DUMP_EXPANDED and do {
  492.               print $dump_file $_;
  493.               close $dump_file if $status <= 0;
  494.             };
  495.             return $status;
  496.           }
  497.  
  498.           ### Define an enum.
  499.           if (/^enum(?:\s+(\d+|\+))?\s+(.*?)\s*$/) {
  500.             my $temp_line = $_;
  501.  
  502.             $enum_index = ( (defined $1)
  503.                             ? ( ($1 eq '+')
  504.                                 ? $enum_index
  505.                                 : $1
  506.                               )
  507.                             : 0
  508.                           );
  509.             foreach (split /\s+/, $2) {
  510.               &{$set_const}($_, $enum_index++);
  511.             }
  512.  
  513.             $_ = "# $temp_line";
  514.  
  515.             DEBUG and warn sprintf "%4d E: %s", $line_number, $_;
  516.  
  517.             DUMP_EXPANDED and do {
  518.               print $dump_file $_;
  519.               close $dump_file if $status <= 0;
  520.             };
  521.             return $status;
  522.           }
  523.  
  524.           ### Define a constant.
  525.           if (/^const\s+(\S+)\s+(.+?)\s*$/i) {
  526.             &{$set_const}($1, $2);
  527.             $_ = "# $_";
  528.             DEBUG and warn sprintf "%4d E: %s", $line_number, $_;
  529.  
  530.             DUMP_EXPANDED and do {
  531.               print $dump_file $_;
  532.               close $dump_file if $status <= 0;
  533.             };
  534.             return $status;
  535.           }
  536.  
  537.           ### Begin a macro definition.
  538.           if (/^macro\s*(\w+)\s*(?:\((.*?)\))?\s*\{\s*$/) {
  539.             $state = STATE_MACRO_DEF;
  540.  
  541.             my $temp_line = $_;
  542.  
  543.             $macro_name = $1;
  544.             $macro_line = 0;
  545.             my @macro_params =
  546.               ( (defined $2)
  547.                 ? split(/\s*\,\s*/, $2)
  548.                 : ()
  549.               );
  550.  
  551.             $macro{$package_name} =
  552.               [ \@macro_params, # MAC_PARAMETERS
  553.                 '',             # MAC_CODE
  554.                 $macro_name,    # MAC_NAME
  555.                 $file_name,     # MAC_FILE
  556.                 $line_number,   # MAC_LINE
  557.               ];
  558.  
  559.             $_ = "# $temp_line";
  560.             DEBUG and warn sprintf "%4d D: %s", $line_number, $_;
  561.  
  562.             DUMP_EXPANDED and do {
  563.               print $dump_file $_;
  564.               close $dump_file if $status <= 0;
  565.             };
  566.             return $status;
  567.           }
  568.  
  569.           ### Perform macro substitutions.
  570.           my $substitutions = 0;
  571.           while (/(\{\%\s+(\S+)\s*(.*?)\s*\%\})/gs) {
  572.             my ($name, $params) = ($2, $3);
  573.  
  574.             # Backtrack to the beginning of the substitution so that
  575.             # the newly inserted text may also be checked.
  576.             pos($_) -= length($1);
  577.  
  578.             DEBUG_INVOKE and
  579.               warn ",-----\n| macro invocation: $name $params\n";
  580.  
  581.             if (exists $macros{$package_name}->{$name}) {
  582.  
  583.               my @use_params = split /\s*\,\s*/, $params;
  584.               my @mac_params =
  585.                 @{$macros{$package_name}->{$name}->[MAC_PARAMETERS]};
  586.  
  587.               if (@use_params != @mac_params) {
  588.                 warn( "macro $name paramter count (",
  589.                       scalar(@use_params),
  590.                       ") doesn't match defined count (",
  591.                       scalar(@mac_params),
  592.                       ") at $file_name line $line_number\n"
  593.                     );
  594.  
  595.                 DUMP_EXPANDED and do {
  596.                   print $dump_file $_;
  597.                   close $dump_file if $status <= 0;
  598.                 };
  599.                 return $status;
  600.               }
  601.  
  602.               # Build a new bit of code here.
  603.               my $substitution = $macros{$package_name}->{$name}->[MAC_CODE];
  604.               my $macro_file   = $macros{$package_name}->{$name}->[MAC_FILE];
  605.               my $macro_line   = $macros{$package_name}->{$name}->[MAC_LINE];
  606.  
  607.               foreach my $mac_param (@mac_params) {
  608.                 my $use_param = shift @use_params;
  609.                 1 while ($substitution =~ s/$mac_param/$use_param/g);
  610.               }
  611.  
  612.               unless ($^P) {
  613.                 my @sub_lines = split /\n/, $substitution;
  614.                 my $sub_line = @sub_lines;
  615.                 while ($sub_line--) {
  616.                   splice( @sub_lines, $sub_line, 0,
  617.                           "# line $line_number " .
  618.                           "\"macro $name (defined in $macro_file at line " .
  619.                           ($macro_line + $sub_line + 1) . ") " .
  620.                           "invoked from $file_name\""
  621.                         );
  622.                 }
  623.                 $substitution = join "\n", @sub_lines;
  624.               }
  625.  
  626.               substr($_, pos($_), length($1)) = $substitution;
  627.               $_ .= "# line " . ($line_number+1) . " \"$file_name\"\n"
  628.                 unless $^P;
  629.  
  630.               DEBUG_INVOKE and warn "$_`-----\n";
  631.  
  632.               $substitutions++;
  633.             }
  634.             else {
  635.               die( "macro $name has not been defined ",
  636.                    "at $file_name line $line_number\n"
  637.                  );
  638.               last;
  639.             }
  640.           }
  641.  
  642.           # Only rebuild the constant regexp if necessary.  This
  643.           # prevents redundant regexp rebuilds when defining several
  644.           # constants all together.
  645.           if ($const_regexp_dirty) {
  646.             $const_regexp{$package_name} =
  647.               text_trie_as_regexp
  648.                 ( text_trie_trie(keys %{$constants{$package_name}})
  649.                 );
  650.             $const_regexp_dirty = 0;
  651.           }
  652.  
  653.           # Perform constant substitutions.
  654.           if (defined $const_regexp{$package_name}) {
  655.             $substitutions +=
  656.               s[\b($const_regexp{$package_name})\b]
  657.                [$constants{$package_name}->{$1}]sg;
  658.           }
  659.  
  660.           # Trace substitutions.
  661.           if (DEBUG) {
  662.             if ($substitutions) {
  663.               foreach my $line (split /\n/) {
  664.                 warn sprintf "%4d S: %s\n", $line_number, $line;
  665.               }
  666.             }
  667.             else {
  668.               warn sprintf "%4d |: %s", $line_number, $_;
  669.             }
  670.           }
  671.  
  672.           DUMP_EXPANDED and do {
  673.             print $dump_file $_;
  674.             close $dump_file if $status <= 0;
  675.           };
  676.           return $status;
  677.         }
  678.       );
  679.   }
  680. }
  681.  
  682. # Clear a package's macros.  Used for destructive testing.
  683. sub clear_package {
  684.   my ($self, $package) = @_;
  685.   delete $constants{$package};
  686.   delete $macros{$package};
  687.   delete $const_regexp{$package};
  688.   delete $macro{$package};
  689. }
  690.  
  691. 1;
  692.  
  693. __END__
  694.  
  695. =head1 NAME
  696.  
  697. POE::Preprocessor - a macro/const/enum preprocessor
  698.  
  699. =head1 SYNOPSIS
  700.  
  701.   use POE::Preprocessor;
  702.  
  703.   # use POE::Preprocessor ( isa => 'POE::SomeModule' );
  704.  
  705.   macro max (one,two) {
  706.     ((one) > (two) ? (one) : (two))
  707.   }
  708.  
  709.   print {% max $one, $two %}, "\n";
  710.  
  711.   const PI 3.14159265359
  712.  
  713.   print "PI\n";  # Substitutions don't grok Perl!
  714.  
  715.   enum ZERO ONE TWO
  716.   enum 12 TWELVE THIRTEEN FOURTEEN
  717.   enum + FIFTEEN SIXTEEN SEVENTEEN
  718.  
  719.   print "ZERO ONE TWO TWELVE THIRTEEN FOURTEEN FIFTEEN SIXTEEN SEVENTEEN\n";
  720.  
  721.   if ($expression) {      # include
  722.      ... lines of code ...
  723.   }                       # include
  724.  
  725.   unless ($expression) {  # include
  726.     ... lines of code ...
  727.   } elsif ($expression) { # include
  728.     ... lines of code ...
  729.   } else {                # include
  730.     ... lines of code ...
  731.   }                       # include
  732.  
  733. =head1 DESCRIPTION
  734.  
  735. POE::Preprocessor is a Perl source filter that implements a simple
  736. macro substitution language.  Think of it like compile-time code
  737. templates.
  738.  
  739. =head2 Macros
  740.  
  741. Macros are defined with the C<macro> statement.  The syntax is similar
  742. to Perl subs:
  743.  
  744.   macro macro_name (parameter_0, parameter_1) {
  745.     macro code ... parameter_0 ... parameter_1 ...
  746.   }
  747.  
  748. The open brace is required to be on the same line as the C<macro>
  749. statement.  The Preprocessor doesn't analyze macro bodies.  Instead,
  750. it assumes that any closing brace in the leftmost column ends an open
  751. macro.
  752.  
  753. The parameter list is optional for macros that don't accept
  754. parameters.
  755.  
  756.   macro macro_name {
  757.     macro code;
  758.   }
  759.  
  760. Macros are substituted into a program with a syntax borrowed from
  761. Iaijutsu and altered slightly to jive with Perl's native syntax.
  762.  
  763.   {% macro_name $param_1, 'param two' %}
  764.  
  765. This is the code the first macro would generate:
  766.  
  767.   macro code ... $param_1 ... 'param two' ...
  768.  
  769. It's very simplistic.  See POE::Kernel for extensive macro use.
  770.  
  771. =head2 Constants and Enumerations
  772.  
  773. The C<const> command defines a constant.
  774.  
  775.   const CONSTANT_NAME    'constant value'
  776.   const ANOTHER_CONSTANT 23
  777.  
  778. Enumerations are defined with the C<emun> command.  Enumerations start
  779. from zero by default:
  780.  
  781.   enum ZEROTH FIRST SECOND ...
  782.  
  783. If the first parameter of an enumeration is a number, then the
  784. enumerated constants will start with that value:
  785.  
  786.   enum 10 TENTH ELEVENTH TWELFTH
  787.  
  788. C<enum> statements may not span lines.  If the first enumeration
  789. parameter is a plus sign, the constants will start where a previous
  790. C<enum> left off.
  791.  
  792.   enum 13 THIRTEENTH FOURTEENTH  FIFTEENTH
  793.   enum +  SIXTEENTH  SEVENTEENTH EIGHTEENTH
  794.  
  795. =head2 Conditional Code Inclusion (#ifdef)
  796.  
  797. The preprocessor supports something like cpp's #if/#else/#endif by
  798. usurping a bit of Perl's conditional syntax.  The following
  799. conditional statements will be evaluated at compile time if they are
  800. followed by the comment C<# include>:
  801.  
  802.   if (EXPRESSION) {      # include
  803.     BLOCK;
  804.   } elsif (EXPRESSION) { # include
  805.     BLOCK;
  806.   } else {               # include
  807.     BLOCK;
  808.   }                      # include
  809.  
  810.   unless (EXPRESSION) {  # include
  811.     BLOCK;
  812.   }                      # include
  813.  
  814. The code in each conditional statement's BLOCK will be included or
  815. excluded in the compiled code depending on the outcome of its
  816. EXPRESSION.
  817.  
  818. Conditional includes are nestable, but else and elsif must be on the
  819. same line as the previous block's closing brace, as they are in the
  820. previous example.
  821.  
  822. Conditional includes are experimental pending a decision on how useful
  823. they are.
  824.  
  825. =head1 IMPORTING MACROS/CONSTANTS
  826.  
  827.     use POE::Preprocessor ( isa => 'POE::SomeModule' );
  828.  
  829. This method of calling Preprocessor causes the macros and constants of
  830. C<POE::SomeModule> to be imported for use in the current namespace.
  831. These macros and constants can be overriden simply by defining items
  832. in the current namespace of the same name.
  833.  
  834. Note: if the macros in C<POE::SomeModule> require additional perl
  835. modules, any code which imports these macros will need to C<use>
  836. those modules as well.
  837.  
  838. =head1 DEBUGGING
  839.  
  840. POE::Preprocessor has three debugging constants which may be defined
  841. before the first time POE::Preprocessor is used.
  842.  
  843. To trace source filtering in general, and to see the resulting code
  844. and operations performed on each line:
  845.  
  846.   sub POE::Preprocessor::DEBUG () { 1 }
  847.  
  848. To trace macro invocations as they happen:
  849.  
  850.   sub POE::Preprocessor::DEBUG_INVOKE () { 1 }
  851.  
  852. To see macro, constant, and enum definitions:
  853.  
  854.   sub POE::Preprocessor::DEBUG_DEFINE () { 1 }
  855.  
  856. To see warnings when a macro or constant is redefined:
  857.  
  858.   sub POE::Preprocessor::WARN_DEFINE () { 1 }
  859.  
  860. =head1 ENVIRONMENT
  861.  
  862. Setting the POE_PREPROC_DUMP environment variable causes
  863. POE::Preprocessor to write new copies of the modules it expands.
  864. POE_PREPROC_DUMP should contain the name of a base directory.  It
  865. need not exist.  All the expanded files will be written under the
  866. directory in POE_PREPROC_DUMP.
  867.  
  868. Note: Some modules such as POE::Kernel alter the macros they load at
  869. compile time.  Versions of these modules created by POE_PREPROC_DUMP
  870. may only be used in the same situation they were created in.  For
  871. instance, a version of POE::Kernel created with Gtk support macros may
  872. only be used in Gtk programs from that point on.
  873.  
  874. Note: Because POE::Preprocessor can only dump source code from the
  875. point it it is used in a file, it should be the first statement after
  876. C<package Foo;> in a module.  Otherwise code before it will be missing
  877. from the resulting expanded file.  POE::Preprocessor will create a new
  878. C<package Foo;> line to replace the one that it could not see.
  879.  
  880. This is good:
  881.  
  882.   package Foo;  # Not seen but simulated in the expanded version.
  883.   use POE::Preprocessor;
  884.   use Carp;     # Seen and included in the expanded version.
  885.  
  886. This is bad:
  887.  
  888.   package Foo;  # Not seen but simulated in the expanded version.
  889.   use Carp;     # Not seen and OMITTED FROM the expanded version.
  890.   use POE::Preprocessor;
  891.  
  892. =head1 PERLAPP, PERL2EXE, AND PAR SUPPORT
  893.  
  894. PerlApp, perl2exe, and PAR are program archivers, similar to Java's
  895. JAR.  These utilities bundle your program with its dependencies and
  896. perhaps a perl executable.  The result is a single, large file that
  897. may be more easily deployable than the usual Perl program.
  898.  
  899. The archivers find dependencies by looking for C<use> statements.  POE
  900. does a lot of dynamic loading at startup, so its C<use> statements are
  901. not always detectable.
  902.  
  903. To work around the issue, add C<use> statements for modules that are
  904. missing from your bundled distribution.
  905.  
  906. Things to look for:
  907.  
  908. PerlApp cannot find modules imported using the L<POE> module.  That
  909. is, this will not work:
  910.  
  911.   use POE qw(A B C);
  912.  
  913. This is the working equivalent:
  914.  
  915.   # Dynamically required by POE::Kernel.
  916.   use POE::Resource::Aliases;
  917.   use POE::Resource::Events;
  918.   use POE::Resource::Extrefs;
  919.   use POE::Resource::FileHandles;
  920.   use POE::Resource::SIDs;
  921.   use POE::Resource::Sessions;
  922.   use POE::Resource::Signals;
  923.   use POE::Resource::Statistics;
  924.  
  925.   # Dynamically required by POE.pm.
  926.   use POE::Kernel;
  927.   use POE::Session;
  928.  
  929.   use POE::A;
  930.   use POE::B;
  931.   use POE::C;
  932.  
  933. PerlApp does not support POE::Processor or any other source filter, so
  934. it's necessary to generate a static version of the files to be
  935. included.  Setting the C<POE_PREPROC_DUMP> environment variable will
  936. cause POE::Preprocessor to dump a processed version of the file.
  937.  
  938.   set POE_PREPROC_DUMP=c:\rocco\preproc
  939.  
  940. Run the program.  As the program is run, its preprocessed files will
  941. be placed in subdirectories under L<POE_PREPROC_DUMP>.
  942.  
  943.   perl MyPoeApp.perl
  944.  
  945. The preprocessed files must now be found, and their parent directory
  946. must be placed in the PERL5LIB environment variable.
  947.  
  948.   C:\rocco\POE-0.20>dir /b /a:d /s c:\rocco\preproc
  949.  
  950. Might show these directories:
  951.  
  952.   C:\rocco\preproc\POE
  953.   C:\rocco\preproc\POE\Kernel
  954.  
  955. The POE modules have been dumped into "C:\rocco\preproc\POE" and its
  956. subdirectories.  For C<use POE::Foo> to find POE/Foo.pm, the
  957. "c:\rocco\preproc" directory must be prepended to PERL5LIB.
  958.  
  959.   set PERL5LIB=c:\rocco\preproc
  960.  
  961. PerlApp can finally build an EXE version of the program.
  962.  
  963.   perlapp --exe MyPoeApp.exe --clean MyPoeApp.perl
  964.  
  965. MyPoeApp.exe should now be a stand-alone executable version of your
  966. Perl program.
  967.  
  968. Thanks to...
  969.  
  970. Zoltan Kandi for testing and documenting this.
  971.  
  972. Lance Braswell for pointing out the POE::Resource classes need to be
  973. loaded.
  974.  
  975. =head1 BUGS
  976.  
  977. Source filters are line-based, and so is the macro language.  The only
  978. constructs that may span lines are macro definitions, and those *must*
  979. span lines.
  980.  
  981. The regular expressions that detect and replace code are simplistic
  982. and may not do the right things when given challenging Perl syntax to
  983. parse.  For example, constants are replaced within strings.
  984.  
  985. Substitution is done in two phases: macros first, then constants.  It
  986. would be nicer (and more dangerous) if the phases looped around and
  987. around until no more substitutions occurred.
  988.  
  989. The regexp builder makes silly subexpressions like /(?:|m)/.  That
  990. could be done better as /m?/ or /(?:jklm)?/ if the literal is longer
  991. than a single character.
  992.  
  993. The "# include" directives are not compatible with the
  994. POE_PREPROC_DUMP environment variable.
  995.  
  996. =head1 SEE ALSO
  997.  
  998. The regexp optimizer is based on code in Ilya Zakharevich's
  999. Text::Trie.
  1000.  
  1001. =head1 AUTHOR & COPYRIGHT
  1002.  
  1003. POE::Preprocessor is Copyright 2000 Rocco Caputo.  Some parts are
  1004. Copyright 2001 Matt Cashner. All rights reserved.  POE::Preprocessor
  1005. is free software; you may redistribute it and/or modify it under
  1006. the same terms as Perl itself.
  1007.  
  1008. =cut
  1009.