Text::Vpp - Perl extension for a versatile text pre-processor

Text-Vpp documentation Contained in the Text-Vpp distribution.

Index

Code Index:

NAME

Top

Text::Vpp - Perl extension for a versatile text pre-processor

SYNOPSIS

Top

 use Text::Vpp ;

 $fin = Text::Vpp-> new('input_file_name') ;

 $fin->setVar('one_variable_name' => 'value_one', 
              'another_variable_name' => 'value_two') ;

 $res = $fin -> substitute ; # or directly $fin -> substitute('file_out') 

 die "Vpp error ",$fin->getErrors,"\n" unless $res ;

 $fout = $fin->getText ;

 print "Result is : \n\n",join("\n",@$fout) ,"\n";

DESCRIPTION

Top

This class enables to preprocess a file a bit like cpp.

First you create a Vpp object passing the name of the file to process, then you call setvar() to set the variables you need.

Finally you call substitute on the Vpp object.

NON-DESCRIPTION

Top

Note that it's not designed to replace the well known cpp. Note also that if you think of using it to pre-process a perl script, you're likely to shoot yourself in the foot. Perl has a lot of built-in mechanisms so that a pre-processor is not necessary for most cases.

On the other hand some advanced perl users do use Vpp to pre-process their code to gain speed. But in this case you should really think hard about the maintenance of your code. Adding Vpp syntax in your code will make it more difficult to maintain. Even more so if the code maintainer will not be yourself. Furthermore, the build procedure may also be more complex. So please, do consider the trade-off between speed and complexity.

INPUT FILE SYNTAX

Top

Comments

All lines beginning with '#' are skipped. (May be changed with setCommentChar())

When setActionChar() is called with '#' as a parameter, Vpp doesn't skip lines beginning with '#'. In this case, there's no comment possible.

in-line eval

Lines beginning with '@EVAL' (@ being pompously named the 'action char') are evaluated as small perl script. If a line contains (multiple) @@ Perl-Expression @@ constructs these are replaced by the value of that Perl-Expression. You can access all (non-lexically scoped) variables and subroutines from any Perl package iff you use fully qualified names, i.e. for a subroutine foo in package main use ::foo or main::foo To call one of the methods of a Vpp-object, like setActionChar, this has to called as "${self}->setActionChar('@');" Be sure you know what you do, if you call such methods from within an @EVAL line.

Multi-line input

Lines ending with \ are concatenated with the following line.

Variables substitution

You can specify variables in your text beginning with $ (like in perl, but may be changed with setPrefixChar() ) and optionally ending in a Suffix which can be specified by setSuffixChar(). These variables can be set either by the setVar() method, the setVarFromFile() method or by the 'eval' capability of Vpp (See below).

Advanced variables substitution

To use more complicated variables like hash or array accesses you have to use either the 'in-line eval' above or a cheaper and more convenient method. For that you can 'QUOTE' lines like

 @QUOTE
 any lines
 @ENDQUOTE

or

 @QUOTE ( ListPrefix [,ListSeparator] )
 any lines
 @ENDQUOTE

In both cases the lines between the '@QUOTE' and '@ENDQUOTE' are concatenated while keeping the end-of-line character.

In the resulting string all '$' are protected unless $prefix or $suffix or $ListPrefix contains a '$'. Furthermore all '@' are protected unless one of these variables contains a '@'.

Then all variables (defined by $prefix/$suffix) are preprocessed to make them ready for substitution later on. Likewise $ListPrefix (if given) is converted to '@'.

Then this possible multiline construct is quoted by Perl's 'qq' and given to Perl's eval.

Therefore any constructs which interpolate in a double quoted string, will interpolate here too, i.e. variable starting with '$' or '@' (unless protected, see above) and all characters escaped by '\'.

Note the standard trick to interpolate everything within a double quoted string by using the anonymous array construct " @{[expression]} ". The $ListSeparator is used to locally set Perl's variable '$"' (or $LIST_SEPARATOR in module English.pm). You can take any delimiting character but not brackets of any sort to delimit either ListPrefix or ListSeparator .

Note that this feature which raised a lot of discussions between the Vpp contributors should be considered as 'alpha' stage. We may have simpler ideas in the future to implement the same functionnality (hint: all other ideas are welcome). So the interface or the feature itself may be changed. Contact Helmut for further discussions.

Output generation by Perl code

For complex generation of output one can specify one or more Perl subroutines which can be called from within an @PERL statement. To specify the Perl code you say

 @PERL  <<  Termination_Regexp
 any perl source lines not matching 'Termination_Regexp'
 termination line matching 'Termination_Regexp'

Note, that any output have to use the predefined Perl sub Vpp_Out. Note, that the subroutine names should be unique even across included files. To access the variables set by e.g. setVar, you have to use the predefined hash-ref $VAR. Here is an example which generates constants for a C-program which amount to the probability that you draw a specified sequence out of a set.

 @PERL << ^END_OF_PERL$
 sub Chances($$) {
   my ($nseq,$num) = @_;
   # compute the chance to draw a sequence of nseq specific balls
   # out of num balls.
   my $chance;
   if ( $nseq > $num ) {
     $chance= 0;
   } else {
     $chance= 1;
     for (my $k=1; $k <= $nseq; $k++) {
       $chance*= $k/($num-$k);
     }
   }
   Vpp_Out("const double chance_${nseq}_of_$num = $chance;");
 }
 END_OF_PERL

This produces no output by itself. Lateron you can use it as

 @EVAL &Chances(7,49)

to produce the C-statement

 const double chance_7_of_49 = 1.35815917929809e-08;

Output generation by shell code

For complex generation of output one can also specify one or more shell commands which can be called from within an @SHELL statement.

To include the output of the shell command into your text, you can specify: @SHELL [some shell command]

For instance: @SHELL ls Vpp.pm

You can also specify a more complex shell command with: @SHELL << Termination_Regexp any shell code not matching 'Termination_Regexp' termination line matching 'Termination_Regexp'

Unlike the @PERL command, there's no need to call Vpp_Out from the shell code. All the STDOUT of the shell commands will be included in the text.

Setting variables

Lines beginning by @ are 'evaled' using variables defined by setVar() or setVarFromFile(). You can use only scalar variables. This way, you can also define variables in your text which can be used later.

Conditional statements

Text::Vpp understands @IF, @ELSIF, @ENDIF,and so on. @INCLUDE and @IF can be nested.

@IF and @ELSIF are followed by a Perl expression which will be evaled using the variables you have defined (either with setVar(), setVarFromFile() or in an @EVAL line).

Loop statements

Text::Vpp also understands

@FOREACH $MyLoopVar ( Perl-List-Expression ) ... (any) lines which may depend on $MyLoopVar @ENDFOR

These loops may be nested.

Inclusion

Text::Vpp understands @INCLUDE Filename or Perl-Expression @INCLUDE { action => '\\', backslash => 0, file => 'add_on.001' }

The file name may be a bare words if it contains only alphanumeric characters or '-', '.' or '_'. Otherwise, the file name must be quoted.

If the Perl-Expression is a string, it is taken as a filename.

If it is an anonymous hash, it must have a value for the key 'file' and it may have values for 'action', 'comment', 'prefix', 'suffix', 'substitute' and 'backslash'. If given these values will override the current values during the processing of the included file.

Constructor

Top

new(file, optional_var_hash_ref, ...)

The constructor call new(file, optional_var_hash_ref,optional_action_char, optional_comment_char, optional_prefix_char, optional_suffix_char, optional_substitute, optional_backslash_switch);

creates the Vpp object. The file parameter may be a filename or a blessed reference for an object which "can('getline')". The second parameter can be a hash containing all variables needed for the substitute method, the following (optional) parameters specify the corresponding special characters.

Methods

Top

substitute([output_file])

Perform the substitute, inclusion, and so on and write the result in output_file. This maybe a filename or a blessed reference which "can('print')" . Returns 1 on completion, 0 in case of an error.

If output_file is not specified this function stores the substitution result in an internal variable. The result can be retrieved with getText()

 You may prefix the filename with >> to get the output
 appended to an existing file.

rewind()

If method 'substitute' is called more than once, you have to call 'rewind' in between. CAUTION If you have called method 'new' with a blessed reference instead of a filename, you must not call 'rewind' unless your object has a 'seek' method. Otherwise you have to do actions yourself which simulate 'rewind' for your object.

getText()

  Returns an array ref containing the result. You can then get the total
  file with  join "\n",@{VppObj->getText}

getErrors()

Returns an array ref containing the errors.

setVar( key1=> value1, key2 => value2 ,...) or setVar(hash_ref)

Declare variables for the substitute. Note that calling this function clobbers previously stored values.

setVarFromFile( Filename_or_Ref )

Declares a File or an object which can 'getline'. The file must contain a valid Perl expression yielding an anonymous hash, as created e.g. by Data::Dumper Note that calling this function clobbers previously stored values.

setActionChar(char)

Enables the user to use different char as action char. (default @)

Example: setActionChar('#') will enable Vpp to understand #include, #ifdef ..

setCommentChar(char)

Enables the user to use different char as comment char. (default #) This value may be set to undef so that no comments are possible.

setPrefixChar(char)

Enables the user to use different char(s) as prefix char(s), i.e. variables in your text (only) are prefixed by that character(s) instead of the default '$'. If no suffix character(s) has been defined (or set to 'undef') variables may be specified in the form ${variable} where '$' is the current prefix char(s). This form is necessary, if any character which is allowed within a name (regexp '\w') immediately follows the variable. Note, that all variables in 'actions' (like @@ @EVAL @FOREACH @IF) must still be prefixed by '$'.

setSuffixChar(char)

Enables the user to use different char(s) as suffix char(s), i.e. variables in your text (only) are suffixed by that character(s). Note, that all variables in 'actions' (like @@ @EVAL @FOREACH @IF) don't use this.

setSubstitute([prefix,suffix])

Enables the user to specify the prefix and suffix used to mark a Perl expression within the text that will be replaced by its value. The default value is twice the 'action' char as suffix and prefix.

ignoreBackslash()

By default, line ending with '\' are glued to the following line (like in ksh). Once this method is called '\' will be left as is.

CAVEATS

Top

Version 1.0 now requires files included with '@INCLUDE' to be quoted. Version 1.1 now requires calls to method 'rewind' if 'substitute' is called more than once for the same Vpp-object.

AUTHOR

Top

Dominique Dumont Dominique_Dumont@grenoble.hp.com

Copyright (c) 1996-2001 Dominique Dumont. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Additional bugs have been introduced by Helmut Jarausch jarausch@igpm.rwth-aachen.de

SEE ALSO

Top

perl(1),Text::Template(3).

Text-Vpp documentation Contained in the Text-Vpp distribution. 
############################################################
#
# $Header: /home/domi/perlDev/Text_Vpp/RCS/Vpp.pm,v 1.27 2005/06/09 13:52:13 domi Exp $
#
# $Source: /home/domi/perlDev/Text_Vpp/RCS/Vpp.pm,v $
# $Revision: 1.27 $
# $Locker:  $
# 
############################################################

package Text::Vpp;

require 5.6.0;
use strict;
use vars qw($VERSION);
use IO::File ;
use Carp ;

use AutoLoader qw/AUTOLOAD/ ;

$VERSION = '1.17' ;

# tiny FiFo "package"

sub F_new  { return [1]; }

sub F_reset { my $FiFo = $_[0]; $FiFo->[0]= 1; $#$FiFo= 0; }

sub F_tell { return $_[0]->[0]; }

sub F_seek { $_[0]->[0]= $_[1]; }

sub F_print { push @{$_[0]}, $_[1]; }

sub F_getline { my $FiFo = $_[0]; return $FiFo->[($FiFo->[0])++]; }

#---------------------


sub new
  {
    my $type = shift ;
	
    my $self      = {} ;
    my $file      = shift ;
    my $ref       = shift ;
    my $action    = shift ;
    my $comment   = shift ;
    my $prefix    = shift;
    my $suffix    = shift;
    my $substitute= shift;
    my $backslash = shift;
    
    if (defined $ref && (ref($ref) eq "HASH"))
      {
        $self->{var} = $ref ;
      }
    
    $self->{action}    = defined $action    ? $action    : '@' ;
    $self->{comment}   = defined $comment   ? $comment   : '#' ;
    $prefix= '$'  unless defined($prefix); #';  # for xemacs
    $self->{prefix}    = $prefix ;
    $self->{suffix}    = $suffix;
    $self->{substitute}= $substitute;
    $self->{backslash} = defined $backslash ? $backslash :  1  ;
    if ( UNIVERSAL::can($file,'getline') )
      { $self->{fileDesc}= $file; $self->{name}= ref($file); }
    else
      { $self->{fileDesc} = new IO::File;
        $self->{fileDesc}->open($file) || die "can't open $file \n";
        $self->{name} = $file ;
      }

    $self->{Fifo}= F_new;
	
    $self= bless $self,$type ;

    $self->setActionChar($self->{action});
    $self->setPrefixChar($self->{prefix});
    $self->setSuffixChar($self->{suffix});
    $self->setSubstitute($self->{substitute});
    $self->setCommentChar($self->{comment});
    
    return $self;
  }


sub myEval 
  {
    my $self = shift ;
    my $expression = shift ;
    my $out = shift ;

    # transform each $xxx into $self->{var}{$xxx}
    # this allows for the creation of new variables
    # one may use the construction ${\w} to protect against this
    $expression =~ s[\$(\w+)\b] [\$self->{var}{$1}]g ;

    local *Vpp_Out= ref $out ? sub{push @$out,@_;} : 
      sub {die "Cannot call Vpp_Out in \@INCLUDE line";} ;
    my $return = eval($expression) ;

    if ($@ ne "") 
      {
        die "Error in eval : $@ \n",
        "line : $expression \nfile: $self->{name} line $.\n";
      }

    return ($return);
  }

sub ReplaceVars
  {
    my $self = shift ;

    $_[0] =~ s[\$({?)(\w+)\b(}?)]
            [if (defined($self->{var}{$2}))
              { "\$self->{var}{$2}" . ( !$1 ? $3 : '' ); }
              else {"\$$1$2$3";}
            ]ge ;

  }

sub myExpression
  {
    my $self = shift ;
    my $expression = shift ;
	
    $self->ReplaceVars($expression);
	
    my $return = eval($expression) ;
	
    if ($@ ne "") 
      {
        die "Error in eval : $@ \n",
        "line : $expression \nfile: $self->{name} line $.\n";
      }

    return ($return);
  }


sub substitute
  {
    #return array ref made of new file
    my ($self,$fileOut) = @_ ;
    
    $self->{errorText} = [] ;
    $self->{error} = 0;
    
    $self->{IF_Level}= 0;  $self->{FOR_Level}= 0;
    
    my $res = $self->processBlock(1,1,0,0,0) ;

    chomp @$res ;

    if (defined $fileOut)
      { 
        if ( UNIVERSAL::can($fileOut,'print') )
          { 
            $fileOut->print(join("\n",@$res) ,"\n") ; 
          }
        else
          { 
            print "writing $fileOut\n";
            my $FileOut = $fileOut;
            $FileOut= ">$fileOut"  unless $fileOut =~/^>/;
            my $SubsOut = new IO::File;
            unless( $SubsOut->open($FileOut) )
              {
                $self->snitch("cannot open $fileOut") ;
                return 0 ;
              }
            print $SubsOut join("\n",@$res) ,"\n" ;
            close $SubsOut ;
          }
      }
    else
      {
        $self->{result} = $res ;
      }
    
    return  (not $self->{error} ) ;
  }

sub getText
  {
    my $self = shift ;
    return $self->{result} ;
  }

sub getErrors
  {
    my $self = shift  ;
    return $self->{errorText} ;
  }

sub Vpp_Out {croak "Original Vpp_Out called";}

sub do_shell
  {
    my $self=shift;
    my $shell_code = shift;
    my $out= `$shell_code`;
    warn "Error in SHELL code : status is $? \n",
      "in file: $self->{name} line $.\n",
        "code was\n$shell_code"  if  $? > 0;
    split(/\n/,$out) ;
  }

sub processBlock 
  {
	# three parameters :
	# GlobExpand : false if nothing should be expanded
	# Expand : true if the calling ifdef is true
    my ($self,$globExpand,$expand,$EnterLoop,$useFiFo,$ScanOnly)=@_ ;
    $expand= 0  unless $globExpand;
    my $FiFo      = $self->{Fifo};
    
    my $out = [] ;
    
    # Done is used to evaluate the elsif
    my ($done) = $expand ;
    
    # Stage is used for syntax check
    my ($stage) = ($self->{IF_Level} == 0 || $EnterLoop) ? 0 : 1 ;
    
    my ($line,$keep,$SubsIt) ;
    local $/ = "\n";            # revert to standard line ending
    
    my $Within_Perl_Input = 0;
    my $Perl_Input_Termination;
    my $Perl_Code;

    my $Within_Shell_Input = 0;
    my $Shell_Input_Termination;
    my $Shell_Code;

    # attention: keep the following declaration in sync with
    #            the assignments whence processing 'EVAL' line
    my $action    = $self->{action} ;
    my $comment   = $self->{comment};
    my $prefix    = $self->{prefix} ;
    my $suffix    = $self->{suffix} ;
    my $substitute= $self->{substitute};
    my $backslash = $self->{backslash};
    my $VarPat    = $self->{VarPat};
    my $commentPat = $self->{commentPat};
    my $actionPat  = $self->{actionPat};
    my $ifPat      = $self->{ifPat};
    my $elsifPat   = $self->{elsifPat};
    my $elsePat    = $self->{elsePat};
    my $endifPat   = $self->{endifPat};
    my $includePat = $self->{includePat};
    my $evalPat    = $self->{evalPat};
    my $quotePat   = $self->{quotePat};
    my $endquotePat= $self->{endquotePat};
    my $subsPat    = $self->{subsPat};
    my $subsLeadPat= $self->{subsLeadPat};
    my $foreachPat = $self->{foreachPat};
    my $endforPat  = $self->{endforPat};
    my $perlPat    = $self->{perlPat};
    my $shellPat  = $self->{shellPat};

    if ( $useFiFo )
      { 
        $line= F_getline($FiFo); 
      }
    else 
      { 
        $line = $self->{fileDesc}->getline;
        F_print($FiFo,$line)  if  $ScanOnly;
      }
    
    while (defined($line)) 
      {
        if ( $Within_Perl_Input ) {
          if ( $line =~ /$Perl_Input_Termination/ ) {
            $Within_Perl_Input= 0;
            if ( $expand ) {
	      # $VAR may be used in eval'ed code
	      my $VAR = $self->{var} ;
	      local *Vpp_Out= sub {push @$out, @_; };
              my $res = eval($Perl_Code);
              die "Error in eval(uating) PERL code : $@ \n",
                "in file: $self->{name} line $.\n",
                "code was\n$Perl_Code"  if  $@;
            }
          } else {
            $Perl_Code.= $line;
          }
          next;
        }

        if ( $Within_Shell_Input ) {
          if ( $line =~ /$Shell_Input_Termination/ ) {
            $Within_Shell_Input= 0;
            push (@$out, $self->do_shell($Shell_Code)) if ( $expand );
          } else {
            $Shell_Code.= $line;
          }
          next;
        }

        chomp($line);
        #skip commented lines
        next if (defined $commentPat and $line =~ $commentPat);
		
        # get following line if the line is ended by \
        # (followed by tab or whitespaces)
        if ($backslash == 1 and $line =~ s/\\\s*$//) 
          {
            $keep .= $line ;
            next ;
          }
        
        my $lineIn;
        if (defined $keep)
          {
            $lineIn = $keep.$line ;
            undef $keep ;
          } 
        else
          {
            $lineIn = $line ;
          }
        
        study $lineIn;
        if ($lineIn =~ s/$ifPat//i) 
          {
            # process the lines after the IF,
            # don't evaluate the boolean expression if  ! $expand
            my ($expandLoc) = $expand && $self->myExpression($lineIn) ;
            my $Current_IF_Level = $self->{IF_Level}++;
            push @$out, 
            @{$self->processBlock($expand,$expandLoc,0,$useFiFo,$ScanOnly)};

            if ( $self->{IF_Level} != $Current_IF_Level )
              { 
                $self->snitch("illegal nesting of FOREACH and IF"); return [];
	      }
          }
        elsif ($lineIn =~ s/$elsifPat//) 
          {
            # process the lines after the ELSIF, done is set if the block
            # is expanded
            unless ($stage == 1 or $stage ==2) 
              {
                $self->snitch("unexpected elsif");
              }
            $stage = 2 ;
            if ( $done )       # if-condition was true
              { $expand= 0; }  # now we are in the else
            else
              { # if-condition was false, so here we have a new chance
                $expand = $globExpand  &&  $self->myExpression($lineIn) ;
                $done = $expand ;
              }
          }
        elsif ($lineIn =~ $elsePat) 
          {
            if ($stage == 0 || $stage == 3 ) 
              {
                $self->snitch("unexpected else");
              }
            $stage = 3 ;
            $expand = $globExpand  &&  !$done ;
          } 
        elsif ($lineIn =~ $endifPat) 
          {
            if ($stage == 0) {$self->snitch("unexpected endif");}
            $self->{IF_Level}--;
            return $out ;
          }
        elsif ($lineIn =~ s/$foreachPat//)
          { 
            my ($emptyLoop,$Current_FOR_Level,$Start_of_Loop) 
              = (1,$self->{FOR_Level},1);

            if ( $expand )
              { 
                my $LoopExpr = $lineIn;
                $LoopExpr =~ s/^\s*my\s//;  # remove my if there
                my $LoopVar ;
		$LoopVar = $1 if $LoopExpr =~ s/\$(\w+)//;

                $self->ReplaceVars($LoopExpr);
                my @LoopList= eval $LoopExpr;
                if ( $@ ) 
                  { 
                    die "Error in FOREACH-List-Expression: $@\n",
                    "line : $lineIn\nfile: $self->{name} line $.\n";
                  }
                $emptyLoop= scalar(@LoopList) == 0;

                unless ($emptyLoop)
                  { 
                    if ( $self->{FOR_Level} == 0 )
                      { 
                        F_reset($FiFo);
                        $self->{FOR_Level}++;
                        $self->processBlock(0,0,1,0,1); # Scan Only
                        if ( $Current_FOR_Level != $self->{FOR_Level} )
                          { 
                            $self->snitch("illegal nesting for IF and FOREACH"); 
                            return []; 
                          }
                        $Start_of_Loop= 1;
                      }
                    else { $Start_of_Loop= F_tell($FiFo); }

                    foreach my $LpVar (@LoopList)
                      { 
                        $self->{var}{$LoopVar}= $LpVar;
                        $self->{FOR_Level}++;
                        F_seek($FiFo,$Start_of_Loop);

                        push @$out, @{$self->processBlock(1,1,1,1,0)} ;

                        if ( $Current_FOR_Level != $self->{FOR_Level} )
                          { 
                            $self->snitch("illegal nesting for IF and FOREACH"); 
                            return []; 
                          }
                      }
                  }
              }

            if ($emptyLoop) # loop has never been executed
              { 
                if ( $self->{FOR_Level} == 0 )
                  { 
                    $self->{FOR_Level}++;
                    $self->processBlock(0,0,1,0,0); # just skip
                  }
                else
                  { 
                    $self->{FOR_Level}++;
                    $self->processBlock(0,0,1,$useFiFo,$ScanOnly); # process but don't expand
                  }
                if ( $Current_FOR_Level != $self->{FOR_Level} )
                  { 
                    $self->snitch("illegal nesting for IF and FOREACH"); 
                    return []; 
                  }
              }
          }
        elsif ($lineIn =~ $endforPat)
          {  
            $self->{FOR_Level}--; return $out;
          }
        elsif ($lineIn =~ $includePat)
          { 
            if ( $expand )
              {
                # look like we've got a new file to slurp
                $lineIn =~ s/$includePat//;
                my $newFile;
                my $Incl = $lineIn =~ /^[\w_\-.]+$/ ? 
                  $lineIn : $self->myEval($lineIn);

                if ( ref($Incl) eq 'HASH' )
                  { 
                    $Incl->{action}=	$action     unless defined $Incl->{action};
                    $Incl->{comment}=	$comment    unless defined $Incl->{comment};
                    $Incl->{prefix}=	$prefix     unless defined $Incl->{prefix};
                    $Incl->{suffix}=	$suffix     unless defined $Incl->{suffix};
                    $Incl->{substitute}=    $substitute unless defined $Incl->{substitute};
                    $Incl->{backslash}=	$backslash  unless defined $Incl->{backslash};
                    unless ( defined $Incl->{file} )
                      { 
                        $self->snitch("illegal file at include $lineIn");  
                        return []; 
                      }
                        
                    $newFile =  Text::Vpp-> new ($Incl->{file}, $self->{var},
                                                 $Incl->{action}, $Incl->{comment},
                                                 $Incl->{prefix}, $Incl->{suffix},
                                                 $Incl->{substitute}, $Incl->{backslash});
                  }
                else
                  { 
                    $newFile =  Text::Vpp-> new ($Incl, $self->{var},
				                 $action,$comment,$prefix,$suffix,
                                                 $substitute,$backslash) ;
                  }

                if ($newFile->substitute())
                  {
                    my $res = $newFile->getText() ;
                    push @$out, @$res ;
                  } 
                else
                  {
                    # an error occured
                    push @{$self->{errorText}}, @{$newFile->getErrors()} ;
                    $self->{error} = 1;
                    return $out  ;
                  }
                undef $newFile ;
              }
          }
        elsif ($lineIn =~ s/$evalPat//)
          {
            if ( $expand ) {$self->myEval($lineIn, $out);}

            # reassign in case there was a change to some
            # of the following
            # attention: keep the following assignments in sync with
            #            with the declarations at the beginning of this sub
            $action     = $self->{action} ;
            $comment    = $self->{comment};
            $prefix     = $self->{prefix} ;
            $suffix     = $self->{suffix} ;
            $substitute = $self->{substitute};
            $backslash  = $self->{backslash};
            $VarPat     = $self->{VarPat};
            $commentPat = $self->{commentPat};
            $actionPat  = $self->{actionPat};
            $ifPat      = $self->{ifPat};
            $elsifPat   = $self->{elsifPat};
            $elsePat    = $self->{elsePat};
            $endifPat   = $self->{endifPat};
            $includePat = $self->{includePat};
            $evalPat    = $self->{evalPat};
            $quotePat   = $self->{quotePat};
            $endquotePat= $self->{endquotePat};
            $subsPat    = $self->{subsPat};
            $subsLeadPat= $self->{subsLeadPat};
            $foreachPat = $self->{foreachPat};
            $endforPat  = $self->{endforPat};
            $perlPat    = $self->{perlPat};
            $shellPat   = $self->{shellPat};
          }
        elsif ($lineIn =~ s/$perlPat//)
          {  $Within_Perl_Input= 1;
             $Perl_Code= "";
             $lineIn =~ s/\s*$//;
             $Perl_Input_Termination= qr/$lineIn/;
          }
        elsif ($lineIn =~ s/$shellPat//)
          {  
            if ($lineIn =~ s/<<\s*//)
              {
                $Within_Shell_Input= 1;
                $Shell_Code= "";
                $lineIn =~ s/\s*$//;
                $Shell_Input_Termination= qr/$lineIn/;
              }
            else
              {
                push @$out, $self->do_shell($lineIn);
              }
          }
        elsif ( $lineIn =~ /$quotePat/ )
          { 
            my $Str = $lineIn; $Str =~ s/$quotePat//;
            my ($ListSeparator,$ListPrefix);
            #  format   @QUOTE (ListPrefix,ListSeparator)
            if ( $Str =~ /^\(/ )
              {
                if ( $Str =~ /^\(\s*(\S)([^\1]*?)\1\s*(?:,\s*(\S)([^\2]*?)\3\s*\))?/ )
                  { $ListPrefix= $2; $ListSeparator= $4; }
                else { $self->snitch("illegal QUOTE action : $lineIn"); }
              }
            $Str= '';
            
            while(1)
              { 
                if ( $useFiFo ) { $line= F_getline($FiFo); }
                else 
                  { 
                    $line = $self->{fileDesc}->getline;
                    F_print($FiFo,$line)  if  $ScanOnly;
                  }
                last if $line =~ $endquotePat;
                
                unless ( defined $line )
                  { 
                    $self->snitch("EOF while scanning QUOTE"); 
                    return []; 
                  }

                $Str.= $line if ( $expand );
              }
                    
            if ( $expand )
              { 
                # protect '$' and '@'
                if ( "$prefix$suffix" !~ /\$/  
                     && ( !defined($ListPrefix)  || $ListPrefix !~ /\$/ ) )
                  { $Str =~ s/(?<!\\)\$/\\\$/g; }
                
                if ( "$prefix$suffix" !~ /\@/  
                     && ( !defined($ListPrefix)  || $ListPrefix !~ /\@/ ) )
                  { $Str =~ s/(?<!\\)\@/\\\@/g; }
                      
                if ( defined $ListPrefix ) { $Str =~ s/\Q$ListPrefix\E/\@/g; }

                # substitute variables
                if ( defined $suffix )
                  {
                    $Str =~ s[$VarPat][\$self->{var}{$1}]g;
                  }
                else
                  {
                    $Str =~ s[$VarPat]
                                            [ { "\$self->{var}{$2}" . ( !$1 ? $3 : '' ) ;} ]ge ;
                  }
                
                if ( defined $ListSeparator )
                  { local $"= $ListSeparator; $Str = eval("qq($Str)"); }
                else { $Str = eval("qq($Str)"); }
                
                if ($@ ne "")
                  {
                    die "Error in QUOTE/eval : $@ \n",
                    "expression:\n$Str\n\nfile: $self->{name} line $.\n";
                  }
                
                chomp $Str;
                push @$out, split /\n/,$Str;
              }
          }
        elsif ( $SubsIt=($lineIn =~ $subsLeadPat)  ||  $lineIn !~ $actionPat )
          {
            # process the line
            if ($expand) 
              { 
                if ( $SubsIt )  # eval substitution parts
                  { 
                    $lineIn =~ s/$subsPat/$self->myExpression($1)/ge;
                  }
                            
                # substitute variables
                if ( defined $suffix )
                  {
                    $lineIn =~ s[$VarPat]
                                            [ if (defined($self->{var}{$1})) 
                                                { $self->{var}{$1};}
                                                else    {"$prefix$1$suffix"  ;}
                                            ]ge ;
                  }
                else
                  {
                    $lineIn =~ s[$VarPat]
                                            [ if (defined($self->{var}{$2})) 
                                                { $self->{var}{$2} . ( !$1 ? $3 : '' ) ;}
                                                else    {"$prefix$1$2$3"  ;}
                                            ]ge ;
                  }
                
                push @$out, $lineIn ;
              }
          }
        else
          {
            $self->snitch("Unknown command :$lineIn") ;
          }
      }
    
    continue
      { 
        if ( $useFiFo ) 
          { $line= F_getline($FiFo); }
        else 
          { 
            $line = $self->{fileDesc}->getline;
            F_print($FiFo,$line)  if  $ScanOnly;
          }
      }

	
    if ($self->{IF_Level} > 0 ) 
      {
        $self->snitch("Finished inside a conditionnal block");
      }
    elsif ( $self->{FOR_Level} > 0 ) 
      {
        $self->snitch("Finished inside a FOREACH block");
      }

    return $out ;
  }

1;

__END__


# Preloaded methods go here.


#'


#'


sub rewind
  {
    my $self = shift ;
    $self->{fileDesc}->seek(0,0);
  }


# Autoload methods go after __END__ and are processed by the autosplit program.


sub setVar 
  {
    my $self = shift ;
    
    if (ref($_[0]) eq 'HASH')
      {
        $self->{var} = shift ;
      }
    else
      {
        %{$self->{var}} = @_ ;
      }
  }


sub setVarFromFile
  {
    my ($self,$file) = @_ ;
    my ($expression, $line) = '';
    
    if ( UNIVERSAL::can($file,'getline') )
      { 
        while ( defined ($line= $file->getline) )
          { $expression.= $line; }
      }
    else
      { 
        my $Input = new IO::File $file
          or die "couldn't find file $file";
        local $/; $expression= <$Input>;
        close $Input;
      }

    require Safe;
    my $SafeObj = Safe->new;
    $self->{var}= $SafeObj->reval($expression);
  }



sub setActionChar
  {
    my ($self,$action) = @_ ;
    
    $self->{action} 	= $action ;
    $self->{ifPat} 		= qr/^\s*\Q$action\Eif(?=\W)\s*/i;
    $self->{elsePat} 	= qr/^\s*\Q$action\Eelse\s*/i;
    $self->{elsifPat} 	= qr/^\s*\Q$action\Eelsif(?=\W)\s*/i;
    $self->{endifPat} 	= qr/^\s*\Q$action\Eendif\s*/i;
    $self->{includePat} 	= qr/^\s*\Q$action\Einclude(?=\W)\s*/i;
    $self->{evalPat} 	= qr/^\s*\Q$action\Eeval(?=\W)\s*/i;
    $self->{quotePat} 	= qr/^\s*\Q$action\Equote\s*/i;
    $self->{endquotePat} 	= qr/^\Q$action\Eendquote\s*/i;
    $self->{foreachPat} 	= qr/^\s*\Q$action\Eforeach(?=\W)\s*/i;
    $self->{endforPat} 	= qr/^\s*\Q$action\Eendfor\s*/i;
    $self->{perlPat}        = qr/^\s*\Q$action\Eperl\s+<<\s*/i;
    $self->{shellPat}        = qr/^\s*\Q$action\Eshell\s*/i;
    $self->{actionPat} 	= qr/^\s*\Q$action\E\w/; # unknown action
    $self->setSubstitute(undef)  unless defined $self->{substitute}
  }


sub setCommentChar
  {
    my ($self,$comment) = @_ ;
    if ( defined $comment )
      { $self->{commentPat}= qr/^\s*\Q$comment\E/i; }
    else {$self->{commentPat}= undef; }
    $self->{comment} = $comment;
  }


#'

sub setPrefixChar
  {
    my ($self,$prefix) = @_;
    my $suffix;
    $self->{prefix}    = $prefix ;
    if ( defined ($suffix= $self->{suffix}) )
      { $self->{VarPat}= qr/\Q$prefix\E(\w+)\b\Q$suffix\E/; }
    else
      { $self->{VarPat}= qr/\Q$prefix\E({?)(\w+)\b(}?)/; }
  }
                                                         


#'

sub setSuffixChar
  {
    my ($self,$suffix) = @_;
    $self->{suffix}    = $suffix ;
    my $prefix = $self->{prefix};
    if ( defined $suffix )
      { $self->{VarPat}= qr/\Q$prefix\E(\w+)\b\Q$suffix\E/; }
    else
      { $self->{VarPat}= qr/\Q$prefix\E({?)(\w+)\b(}?)/; } 
  }
                                                         


sub setSubstitute
  {
	my ($self,$subs) = @_;
        die "invalid call to setSubstitute : $subs"
          if ( defined($subs) && ref($subs) ne 'ARRAY' );
        
        $self->{substitute}    = $subs ;
        
        if ( defined $subs )
          { my ($subspre,$subssuf) = @$subs;
            $self->{subsPat} = qr/\Q$subspre\E(.*?)\Q$subssuf\E/;
            $self->{subsLeadPat}= qr/\Q$subspre\E/;
          }
        else
          { my $action= $self->{action};
            $self->{subsPat} = qr/\Q$action$action\E(.*?)\Q$action$action\E/;
            $self->{subsLeadPat}= qr/\Q$action$action\E/;
          }
  }



sub ignoreBackslash
  {
    my $self =shift ;
	
    $self->{backslash} = 0 ;
  }

sub snitch
  {
    my $self = shift ;
    my $msg = shift ;
    my $emsg = "Error in $self->{name} line ".
      $self->{fileDesc}->input_line_number. " : $msg\n" ;

    push @{$self->{errorText}}, $emsg ;
    $self->{error} = 1;
    warn ($emsg);
  }