#!/usr/bin/perl
*VERSION = \'2.04';                        # the version of jamal
*umask = \0777;                            # directory permission when a new dir is created
$timeNow = time();                         # 
*SYSmacroOpen  = \'{';                     # macro opening string default value
*SYSmacroClose = \'}';                     # macro closing string default value
$macroOpen  = $SYSmacroOpen;               # current macro opening string
$macroClose = $SYSmacroClose;              # current macro closing string
$MacroOpen  = quotemeta $macroOpen;        # current macro opening match
$MacroClose = quotemeta $macroClose;       # current macro closing match
$mopenCNL = &CNL($macroOpen);              # new line characters in macro opening string
$mcloseCNL = &CNL($macroClose);            # new line characters in macro closing string
@MacStack = ();
$OutputError = 0; #by default erroneous macros result empty string
$SuppressOutput = 0;
$TraceFile = undef;
$LastFileNameDisplayedOnTraceOutput = '';
$Source = undef;
$Destination = undef;
@Macrofiles = ();
%Macro = ();  # $Macro {'name'} = 'body of the macro';
%MacArg = (); # $MacArg{'name'} = ref to argument string array
%MacroStack = ();
%Module = ();
%minV = (); %maxV = ();
%ModRequire = ();
@FILE = ();
%LINE = ();
@BaseModules = ();
$BaseModule = undef; # no base module by default
$ExtensionVerbatim = 0;
while( $_ = shift @ARGV ){
  if( s/^\-// ){#this is option
    if( $_ eq '?' || $_ eq 'h' ){
      &help; exit;
      }
    if( $_ eq 'm' ){
      push @Macrofiles, shift @ARGV;
      next;
      }
    if( $_ eq 'I' ){
      push @INC, shift @ARGV;
      next;
      }
    if( $_ eq '0' ){
      $SuppressOutput = 1;
      next;
      }
    if( $_ =~ /\D(\w+)((?:.|\n)*?)=((?:.|\n)*)$/ ){
      &DefineMacro($1,$2,$3);
      next;
      }
    if( $_ eq 'd' ){
      $OutputError = 1;
      next;
      }
    if( $_ eq 't' ){
      $TraceFile = shift @ARGV;
      next
      }
    &Error("Invalid option. Ignored.",$_);
    }else{
    unless( defined($Source) ){
      $Source = $_; next;
      }
    unless( defined($Destination) ){
      $Destination = $_; next;
      }
    print STDERR "There are too many command line arguments\njamal -?";
    exit;
    }
  }
unless( defined $Source ){
  &Error('No input is defined.');
  exit;
  }
if( $TraceFile && &maked($TraceFile) && !open(TRACE,">$TraceFile")){
  &Error("Trace file can not be opened.",$TraceFile);
  $TraceFile = undef;
  }
$Source =~ s{\\}{/}g;
$Destination =~ s{\\}{/}g;
&PredefineMacro;
for $macrofile ( @Macrofiles ){
  &DoFile($macrofile);
  }
if( $Destination && &maked($Destination) && !open($Destination,">$Destination") ){
  &Error('Output file can not be opened.',$Destination);
  exit;
  }
$output = &DoFile($Source);
if( $Destination ){
  print $Destination $$output;
  close $Destination;
  }else{ print $$output unless $SuppressOutput }
exit;
sub DoFile {
  my $file = shift;
  my $output = '';
  push @FILE,$file;
  $LINE{$file} = 1;
  unless( open($file,"<$file") ){
    print STDERR "Input file '$file' cannot be opened.\n";
    if( $#FILE > 0 ){
      print STDERR " Include hierarchy leading to this file name:\n";
      pop @FILE;
      my $lastFile = pop @FILE;
      my $spc = 0;
      for( @FILE ){
        print STDERR ' ' x $spc++," file $_ at line ",$LINE{$_}," included\n";
        }
      print STDERR ' ' x $spc++," file $lastFile at line ",$LINE{$lastFile}," tried to include this file\n";
      }
    return \'';
    }
  my $o_irs = $/; undef $/;
  my $input = <$file>;
  close $file;
  $/ = $o_irs;
  $input =~ s{\\\n\_\s*}{}g;
  $input =~ s{\\\n}{}g; # escape new lines
  $input =~ s{\\$}{};   # last line end w/o new line
  my $return = &DoInput( \$input , $file , 0);
  pop @FILE;
  return $return;
  }
sub DoInput {
  my $input = shift;
  my $file  = shift;
  my $level = shift;
  my $output = '';
  while( length($$input) > 0 ){
    if( index($$input,$macroOpen) == 0 ){
      $$input = substr($$input,length($macroOpen));
      $LINE{$file} += $mopenCNL unless $level;
      my $macro = &ChopMacro($input,$level);
      &Trace('M',$macro,$level);
      my $LineNR = $LINE{$file} + &CNL($$macro) + $mcloseCNL;
      unless( substr($$macro,0,1) eq '@' ){
        my $oldLine = $LINE{$file};
        $macro    = &DoInput($macro,$file,$level);
        $LINE{$file} = $oldLine;
        &Trace('M',$macro,$level);
        }
      $output  .= &EvalMacro($macro,$file,$level);
      $LINE{$file} = $LineNR unless $level;
      }else{
      my $i;
      if( -1 < ($i = index($$input,$macroOpen)) ){
        $lll = substr($$input,0,$i);
        $output .= $lll;
        &Trace('L',\$lll,$level);
        $LINE{$file} += &CNL($lll) unless $level;
        $$input = substr($$input,$i);
        }else{
        &Trace('L',$input,$level);
        $output .= $$input;
        $LINE{$file} += &CNL($$input) unless $level;
        $$input = '';
        }
      }
    }
  return \$output;
  }
sub ChopMacro {
  my $input = shift;
  my $Counter = 1;# we are after one macro opening brace
  my $output = '';
  my $chop;
  while( $Counter ){# while there is any opened macro
    if( length($$input) == 0 ){# some macro was not closed
      &Error('Erroneous macro nesting.',$output);
      return \$output;
      }
    if( index($$input,$macroOpen) == 0 ){
      $$input = substr($$input,length($macroOpen));
      $Counter ++; #count the new opening
      $output .= $macroOpen;
      }
    elsif( index($$input,$macroClose) == 0 ){
      $$input = substr($$input,length($macroClose));
      $Counter --; # count the closing
      return \$output unless $Counter > 0;
      $output .= $macroClose;
      }else{
      my $i = index($$input,$macroOpen);
      my $j = index($$input,$macroClose);
      $i = $j if $j < $i && $j != -1 || $i == -1;
      if( -1 < $i){
        $output .= substr($$input,0,$i);
        $$input = substr($$input,$i);
        }else{
        $output .= $$input;
        $$input = '';
        }
      }
    }
  }
sub EvalMacro {
  my $input = shift;
  my $ReferenceFileName = shift;
  my $level = shift;
  my $verbatim = 0;
  my $ReportNotDefinedMacro = 1;
  $verbatim = 1 if $$input =~ s/^(?:#|@)verbatim\s+// ;
  my $char,$index=0; while( ($char=substr($$input,$index,1)) eq ' ' ||
                             $char eq "\n" || char eq "\t" || char eq "\r" ){ $index++ }
  if( ($char = substr($$input,$index,1)) eq '@' || $char eq '#' ){
    $index ++;
    while( ($char=substr($$input,$index,1)) eq ' ' ||
            $char eq "\n" || char eq "\t" || char eq "\r" ){ $index++ }
    $$input = substr($$input,$index);
    $index = 1; # this is built in macro
    }else{
    if( substr($$input,$index,1) eq '?' ){
      $index++;
      while( ($char=substr($$input,$index,1)) eq ' ' ||
              $char eq "\n" || char eq "\t" || char eq "\r" ){ $index++ }
      $ReportNotDefinedMacro = 0;
      }
    $$input = substr($$input,$index) if $index > 0;
    $index = 0; # this is user defined macro
    }
  if( $index ){
    if( $$input =~ /^\w*\:\:/ ){#/^(\w*)((?:\:\:\w+)+)/ ){
      $$input =~ s/^(\w*)//;
      my $base = $1;
      $$input =~ s/((?:\:\:\w+)+)//;
      my $macro = $1;
      $base = $BaseModule unless $base;
      $@ = '';
      local $ExtensionVerbatim = 0;
      local $InputFileName = $ReferenceFileName;
      local $OutputFileName = $Destination;
      my $result = eval "&jamal::$base$macro(" . '$$input)';
      if( ! $@ ){
        return $result if $ExtensionVerbatim ;
        $result = &DoInput(\$result,$ReferenceFileName,$level+1);
        return $$result;
        }else{
        return &Error("Extension macro resulted the error: $@",$$input);
        }
      }
    if( $$input =~ /^require(\W.*)$/ ){
      my $rversion = &Split($1,1);
      $rversion = $rversion->[0];
      if( $rversion > $VERSION ){
        &Error("This file requires jamal V$rversion and I am only $VERSION",$$input);
        exit;
        }
      return '';
      }
    if( $$input =~ /^with(\W.*)$/ ){
      my $package = &Split($1,1);
      if( $$package ){
        push @BaseModules,$BaseModule;
        $BaseModule = $$package;
        }else{ $BaseModule = pop @BaseModules }
      return '';
      }
    if( $$input =~ /^use(\W.*)$/ ){
      my ($package,$version) = @{Split($1,2)};
      $version = '' unless defined $version;
      if( defined $Module{$package} ){
        &Warning("Extension $package is already loaded.",$$input);
        }
      $@ = '';
      $Module{$package} = $version;
      $jamal::VersionWasCalled = 0; $jamal::RequireWasCalled = 0;
      eval "use jamal::$package";
      if( ! $@ ){
        if( $version && (
            (defined($maxV{$package}) && $maxV{$package} < $version) ||
            (defined($minV{$package}) && $minV{$package} > $version) )){
          &Error("Extension $package does not implement the requested version $version.",$$input);
          exit;#this is a severe error
          }
        if( ! $jamal::VersionWasCalled ){
          &Error("Extension $package does not specify its own version.",$$input);
          }
        if( ! $jamal::RequireWasCalled ){
          &Error("Extension $package does not specify the jamal version it requires.",$$input);
          }
        push @BaseModules,$BaseModule;
        $BaseModule = $package;
        return '';
        }else{
        delete $Module{$package};
        return &Error("Extension $package is not found. Error message: $@",$$input);
        }
      }
    if( $$input =~ /^sep(\W.*)$/ ){
      my $seps = $1;
      my ($mO,$mC) = @{&Split($seps,2)};
      if( $mO eq '' ){
        &Error("Semantic error in macro SEP would result empty macro open string",$$input);
        return '';
        }
      if( $mC eq '' ){
        &Error("Semantic error in macro SEP would result empty macro close string",$$input);
        return '';
        }
      $macroOpen = $mO;
      $macroClose = $mC;
      $MacroOpen = quotemeta $macroOpen;
      $MacroClose = quotemeta $macroClose;
      $mopenCNL = &CNL($macroOpen);
      $mcloseCNL = &CNL($macroClose);
      return '';
      }
    if( $$input =~ /^for\s+(\w+)\s*((?:.|\n)*)$/ ){
      my $loopV = quotemeta $1;
      my $loop = $2;
      $loop =~ s/^(.|\n)//;
      my $term = &CharPair($1);
      $loop =~ s/^((?:.|\n)*?)$term//;
      my $loopP = $1;
      if( $loopP =~ /^\s*((?:\+|\-)?\d+)\s*\.\.\.?\s*((?:\+|\-)?\d+)\s*$/ ){
        my $s = $1; my $e=$2;
        my $output = '';
        while(1){
          my $wp = $loop;
          $wp =~ s/$loopV/$s/g;
          $output .= $wp;
          last if $s == $e;
          if( $s < $e ){ $s++ }else{ $s-- }
          }
        $output = &DoInput(\$output,$ReferenceFileName,$level+1);
        return $$output;
        }
      my $argv = &Split( $loopP );
      my $output = '';
      for( @$argv ){
        my $wp = $loop;
        $wp =~ s/$loopV/$_/g;
        $output .= $wp;
        }
      $output = &DoInput(\$output,$ReferenceFileName,$level+1);
      return $$output;
      }
    if( $$input =~ /^dir(\W(?:.|\n)*)$/ ){
      my $macro = $1;
      my $sortorder = '';
      my $html = 0;
      $macro =~ s/^(.|\n)//;
      my $sep = $1;
      if( $sep =~ /^\s+$/ ){
        $sep = '\s+';
        $macro =~ s/^\s*//;
        }else{ $sep = quotemeta $sep }
      $macro =~ m{(.*?)$sep(.*?)$sep((?:.|\n)*)$};
      my $rdir = $1;
      my $pattern = $2;
      my $body = $3;
      my $RefD = '';
      my $recurse = 0;
      my $pat = $pattern;
      while( $pat =~ s{^\s*\-}{} ){
        while( $pat =~ s{^(\w|\.)}{} ){
          my $f = $1;
          if( $f eq 'h' ){ $html = 1; next; }# get html parameters from the files
          if( $f eq 'S' ){
            $pat =~ s{^(n|t|s|d)(a|d)?}{};
            $html = 1 if $1 eq 't';
            $sortorder = $1 . ($2 ? $2 : 'a') ;
            next;
            }
          if( $f eq 'i' || $f eq 'o' ){
            if( $RefD ne '' ){
              &Error('Ambiguous directory definition.',$$input);
              next;
              }else{ $RefD = $f; next; }
            }
          if( $f eq 'R' ){ $recurse = 1; next; }
          next if $f =~ /\.|z|s|d|f/;
          &Error("Invalid dir option $f",$$input);
          }
        }
      $RefD = 'i' unless $RefD;
      my $dir;
      $dir = &Relative($ReferenceFileName,$rdir) if $RefD eq 'i' || ($RefD eq 'o' && !$Destination);
      $dir = &Relative($Destination,$rdir) if $RefD eq 'o' && $Destination;
      my @filist;
      if( $recurse ){
        opendir(D,$dir);
        my @f = readdir(D);
        closedir(D);
        my @DirsLeft = ();
        my $qdir = '';
        while(1){
          $qdir = $qdir . '/' if $qdir;
          for( @f ){
            if( -d "$dir/$qdir$_" ){
              push @DirsLeft , "$qdir$_" unless $_ eq '.' || $_ eq '..';
              }
            push @filist , "$qdir$_";
            }
          last if $#DirsLeft == -1;
          $qdir = pop @DirsLeft;
          opendir(D,"$dir/$qdir");
          @f = readdir(D);
          closedir(D);
          }
        }else{
        opendir(D,$dir);
        @filist = readdir(D);
        closedir(D);
        }
      while( $pattern =~ s{^\s*\-}{} ){
        while( $pattern =~ s{^(\w|\.)}{} ){
          my $f = $1;
          if( $f eq 'S' ){
            $pattern =~ s{^(n|t|s|d)(a|d)?}{};
            next;
            }
          @filist = grep( -z "$dir/$_" , @filist) if $f eq 'z';
          @filist = grep( -s "$dir/$_" , @filist) if $f eq 's';
          @filist = grep( -d "$dir/$_" , @filist) if $f eq 'd';
          @filist = grep( -f "$dir/$_" , @filist) if $f eq 'f';
          @filist = grep( !/^\.$/ && !/^\.\.$/ && !/\/\.$/ && !/\/\.\.$/ , @filist) if $f eq '.';
          }
        }
      $pattern =~ s{^\s*}{};
      if( $pattern ){
        $pattern = quotemeta $pattern;
        $pattern =~ s{\\\*}{\.*}g;
        @filist = grep( m/^$pattern$/ , @filist);
        }
      my @FileArray = ();
      for $filename (@filist){
        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
            $atime,$mtime,$ctime,$blksize,$blocks) = stat("$dir/$filename");
        my @params = ();
        push @params, ($filename, "$rdir/$filename", $size, &ConvertDate($mtime), &ConvertTime($mtime), $mtime );
        if( $html ){
          my ($title) = &HtmlParameters("$dir/$filename");
          push @params, $title;
          }else{ push @params, '' }
        push @FileArray, \@params;
        }
      @FileArray = sort { $a->[0] cmp $b->[0] } @FileArray if $sortorder eq 'na';
      @FileArray = sort { $b->[0] cmp $a->[0] } @FileArray if $sortorder eq 'nd';
      @FileArray = sort { $a->[6] cmp $b->[6] } @FileArray if $sortorder eq 'ta';
      @FileArray = sort { $b->[6] cmp $a->[6] } @FileArray if $sortorder eq 'td';
      @FileArray = sort { $a->[2] <=> $b->[2] } @FileArray if $sortorder eq 'sa';
      @FileArray = sort { $b->[2] <=> $a->[2] } @FileArray if $sortorder eq 'sd';
      @FileArray = sort { $a->[5] <=> $b->[5] } @FileArray if $sortorder eq 'da';
      @FileArray = sort { $b->[5] <=> $a->[5] } @FileArray if $sortorder eq 'dd';
      my $output = '';
      push @LoopMacroStack,$Macro{'$file$name'};
      push @LoopMacroStack,$Macro{'$file$url'};
      push @LoopMacroStack,$Macro{'$file$size'};
      push @LoopMacroStack,$Macro{'$file$date'};
      push @LoopMacroStack,$Macro{'$file$time'};
      push @LoopMacroStack,$Macro{'$html$title'};
      push @LoopMacroStack,$WeAreInLoop;
      $WeAreInLoop = 1;
      for $f (@FileArray){
        $f->[0] =~ m{(.*)\.(.*)};
        $Macro{'$file$nam'}  = $1;
        $Macro{'$file$e'}     = $2;
        $Macro{'$file$name'}  = $f->[0];
        $Macro{'$file$url'}   = $f->[1];
        $Macro{'$file$size'}  = $f->[2];
        $Macro{'$file$date'}  = $f->[3];
        $Macro{'$file$time'}  = $f->[4];
        $Macro{'$html$title'} = $f->[6];
        my $bdy = $body;
        $bdy = &DoInput(\$bdy,$ReferenceFileName,$level+1);
        $output .= $$bdy;
        }
      $WeAreInLoop = pop @LoopMacroStack;
      $Macro{'$html$title'}= pop @LoopMacroStack;
      $Macro{'$file$time'} = pop @LoopMacroStack;
      $Macro{'$file$date'} = pop @LoopMacroStack;
      $Macro{'$file$size'} = pop @LoopMacroStack;
      $Macro{'$file$url'}  = pop @LoopMacroStack;
      $Macro{'$file$name'} = pop @LoopMacroStack;
      $output = &DoInput(\$output,$ReferenceFileName,$level+1);
      return $$output;
      }
    if( $$input =~ /^months(\W(?:.|\n)*)$/ ){
      my $macro = $1;
      my $list = &Split($macro,12);
      $MonthNames = $list;
      if( $#$list < 11 ){
        return &Error('There are not enough month names defined:' , $$input);
        }elsif( $#$list > 11 ){
        return &Error('There are too many month names defined:' , $$input);
        }
      return '';
      }
    if( $$input =~ /^days(\W(?:.|\n)*)$/ ){
      my $macro = $1;
      my $list = &Split($macro,7);
      $DayNames = $list;
      if( $#$list < 6 ){
        return &Error('There are not enough day names defined:' , $$input);
        }elsif( $#$list > 6 ){
        return &Error('There are too many day names defined:' , $$input);
        }
      return '';
      }
    if( $$input =~ /^format\s+time=((?:.|\n)*)$/ ){
      $TimeFormat = $1;
      return '';
      }
    if( $$input =~ /^format\s+date=((?:.|\n)*)$/ ){
      $DateFormat = $1;
      return '';
      }
    if( $$input =~ /^format\s+am=((?:.|\n)*)$/ ){
      $AM = $1;
      return '';
      }
    if( $$input =~ /^format\s+pm=((?:.|\n)*)$/ ){
      $PM = $1;
      return '';
      }
    if( $$input =~ /^time\s*$/ ){
      my $output = &ConvertTime($timeNow);
      $output = &DoInput(\$output,$ReferenceFileName,$level+1);
      return $$output;
      }
    if( $$input =~ /^date\s*$/ ){
      my $output = &ConvertDate($timeNow);
      $output = &DoInput(\$output,$ReferenceFileName,$level+1);
      return $$output;
      }
    if( $$input =~ /^select(\W(?:.|\n)*)$/ ){
      my $macro = $1;
      my ($n,$list) = @{&Split($macro,2)};
      my @list = @{&Split($list)};
      my $output = $list[$n];
      $output = &DoInput(\$output,$ReferenceFileName,$level+1);
      return $$output;
      }
    if( $$input =~ /^if(\W(?:.|\n)*)$/ ){
      my $macro = $1;
      my ($test,$then,$else) = @{&Split($macro,3)};
      my $output = $test ? $then : $else;
      $output = &DoInput(\$output,$ReferenceFileName,$level+1);
      return $$output;
      }
    if( $$input =~ /^null\s*((?:.|\n)*)$/ ){
      return $1;
      }
    if( $$input =~ /^comment\s*((?:.|\n)*)$/ ){
      return'';
      }
    my $f1 = substr($$input,0,1);
    my $f2 = substr($$input,0,2);
    my $f3 = substr($$input,0,3);
    my $match = 0;
    my ($op,$macro);
    if( $f3 =~ m{and|not} ){
      $match = 1;
      $op = $f3;
      $macro = substr($$input,3);
      }
    elsif( $f2 =~ m{<=|>=|!=|eq|ne|gt|lt|ge|le|or} ||
           $f2 =~ m{-(z|s|d|f|e|t)}i ){
      $match = 1;
      $op = $f2;
      $macro = substr($$input,2);
      }
    elsif( $f1 =~ m{^(=|<|>|\*|/|\+|-|)$} ){
      $match = 1;
      $op = $f1;
      $macro = substr($$input,1);
      }
    if( $match ){
      my $list = &Split($macro);
      my $fop = shift @$list;
      my $result = $fop;
      if( $op =~ s/\-(z|s|d|f|e|t)/$1/i ){
        if( $op eq lc $op || ! defined $Destination ){
          $fop = &Relative($ReferenceFileName,$fop);
          }else{
          $fop = &Relative($Destination,$fop);
          }
        $op = lc $op;
        if( $op eq 'z' ){
          if( -z $fop ){ return '1' }else{ return '0' }
          }
        if( $op eq 's' ){
          if( -s $fop eq '' ){ return '0' }else{ return -s $fop }
          }
        if( $op eq 'd' ){
          if( -d $fop ){ return 1 }else{ return 0 }
          }
        if( $op eq 'f' ){
          if( -f $fop ){ return 1 }else{ return 0 }
          }
        if( $op eq 'e' ){
          if( -e $fop ){ return 1 }else{ return 0 }
          }
        if( $op eq 't' ){
          my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
              $atime,$mtime,$ctime,$blksize,$blocks) = stat($fop);
          return $mtime;
          }
        }
      if( $#$list == -1 && $op eq '-' ){
        $result = -1 * $fop;
        return $result;
        }
      if( $#$list == -1 && $op eq '+' ){
        $result = +1 * $fop;
        return $result;
        }
      if( $op eq 'not' ){
        $result = $fop ? 0 : 1;
        return $result if $#$list == -1 || $fop ;
        }
      return 1 if $op eq 'or' && $fop;
      return 0 if $op eq 'and' && !$fop;
      if( $#$list == -1 ){
        &Error("Operational macro $op has less than two arguments:",$$input);
        }
      for( @$list ){
           if( $op eq '+'  ){  $result += $_ }
        elsif( $op eq '-'  ){  $result -= $_ }
        elsif( $op eq '*'  ){  $result *= $_ }
        elsif( $op eq '/'  ){  $result /= $_ }
        elsif( $op eq '='  ){  $result = 1; return 0 unless $fop == $_ }
        elsif( $op eq '!=' ){  $result = 1; return 0 unless $fop != $_ }
        elsif( $op eq '<'  ){  $result = 1; return 0 unless $fop < $_ }
        elsif( $op eq '>'  ){  $result = 1; return 0 unless $fop > $_ }
        elsif( $op eq '<=' ){  $result = 1; return 0 unless $fop <= $_ }
        elsif( $op eq '>=' ){  $result = 1; return 0 unless $fop >= $_ }
        elsif( $op eq 'eq' ){  $result = 1; return 0 unless $fop eq $_ }
        elsif( $op eq 'ne' ){  $result = 1; return 0 unless $fop ne $_ }
        elsif( $op eq 'lt' ){  $result = 1; return 0 unless $fop lt $_ }
        elsif( $op eq 'gt' ){  $result = 1; return 0 unless $fop gt $_ }
        elsif( $op eq 'le' ){  $result = 1; return 0 unless $fop le $_ }
        elsif( $op eq 'ge' ){  $result = 1; return 0 unless $fop ge $_ }
        elsif( $op eq 'and'){  $result = 1; return 0 unless $_ }
        elsif( $op eq 'not'){  $result = 1; return 0 if $_ }
        elsif( $op eq 'or' ){  $result = 0; return 1 if $_ }
        }
      $result = &DoInput(\$result,$ReferenceFileName,$level+1);
      return $$result;
      }
    if( $$input =~ /^define\s*(?:(\?)\s*|\s+)(\w+)?((?:\:\:\w+)*)((?:.|\n)*?)=((?:.|\n)*)$/ ){
      my $condition = $1;
      my $base = $2;
      my $macro = $3;
      my $parameter = $4;
      my $value = $5;
      $base = $BaseModule unless $base;
      $macro = $base . $macro;
      &DefineMacro($macro,$parameter,$value) unless $condition && defined $Macro{$macro};
      return '';
      }
    if( $$input =~ /^undef\s+(\w+)\s*$/ ){
      delete $Macro{$1};
      delete $MacArg{$1};
      return '';
      }
    if( $$input =~ /^INC\s+(.*)$/ ){
      my $IncludeDirectory = $1;
      $IncludeDirectory =~ s/\s*$//;
      $IncludeDirectory = &Relative($ReferenceFileName,$IncludeDirectory);
      push @INC,$IncludeDirectory;
      return '';
      }
    if( $$input =~ /^restore\s+(\w+)\s*$/ ){
      my $name = $1;
      if( defined( $MacroStack{$name} ) ){
        $MacArg{$name} = pop @{$MacroStack{$name}};
        $Macro{$name}  = pop @{$MacroStack{$name}};
        }else{
        delete $Macro{$1};
        delete $MacArg{$1};
        }
      return '';
      }
    if( $$input =~ /^include\s+pre\s+\"?(.*?)\"?$/ ){
      my $file = &Relative($ReferenceFileName,$1);
      unless( open(F,"<$file") ){
        &Error("File $file can not be read.",$file);
        exit;
        }
      my $o_irs = $/; undef $/;
      my $f = <F>;
      close F;
      $/ = $o_irs;
      $f =~ s/\</&lt;/g;
      $f =~ s/\>/&gt;/g;
      return $f;
      }
    if( $$input =~ /^include\s+verbatim\s+\"?(.*?)\"?$/ ){
      my $file = &Relative($ReferenceFileName,$1);
      unless( open(F,"<$file") ){
        &Error("File $file cann ot be read.",$file);
        exit;
        }
      my $o_irs = $/; undef $/;
      my $f = <F>;
      close F;
      $/ = $o_irs;
      return $f;
      }
    if( $$input =~ /^include\s+macros?\s+\"?(.*?)\"?$/ ){
      my $file = &Relative($ReferenceFileName,$1);
      &DoFile($file);
      return '';
      }
    if( $$input =~ /^include\s+\"?(.*?)\"?$/ ){
      my $file = &Relative($ReferenceFileName,$1);
      my $output = &DoFile($file);
      return $$output;
      }
    if( $$input =~ /^(?:\[|\{)\s*$/ ){
      return $macroOpen;
      }
    if( $$input =~ /^(?:\]|\})\s*$/ ){
      return $macroClose;
      }
    return &Error("Bad macro.",$$input);
    }elsif( $$input =~ /^(\$(?:\$|\_|\w)+)$/ ){#loop macroes e.g.: {$File$name}
    return $Macro{$1} if $WeAreInLoop;
    return "$macroOpen$$input$macroClose";
    }else{
    unless( $$input =~ /^(\w+(?:\:\:\w+)*)/ ){
      &Error("Bad format macro:","$macroOpen$$input$macroClose");
      return undef;
      }
    my $name = $1;
    my $args = substr($$input,length($name));
    my $argn = $#{$MacArg{$name}};
    &Warning("Macro needs no argument:","$macroOpen$$input$macroClose")
         if( (!defined($argn) || $argn == -1) && $args !~ /^\s*$/ );
    my $argv = defined($argn) && $argn > -1 ? &Split( $args , $argn+1 ) : [] ;
    my $result = $Macro{$name};
    if( ! defined $result ){
      return &Error("Macro is not defined!",$name) if $ReportNotDefinedMacro;
      return '';
      }
    if( $MacArg{$name} ){# if there are arguments
      my $resarr = [  { 'frag'=> $result , 'resolv'=> 1 } ];
      for $sear ( @{$MacArg{$name}} ){
        my $repla = shift @{$argv};
        my $nresarr = [];
        for $fragment ( @$resarr ){
          if( $fragment->{'resolv'} ){
            my $item = $fragment->{'frag'};
            while( $item && $item =~ m/(.*?)$sear(.*)/s ){
              push @$nresarr, { 'frag'=> $1, 'resolv'=> 1 } if $1;
              push @$nresarr, { 'frag'=> $repla, 'resolv'=> 0 } if $repla ne '';
              $item = $2;
              }
            push @$nresarr, { 'frag'=> $item, 'resolv'=> 1 } if $item;
            }else{
            push @$nresarr , $fragment;
            }
          }
        $resarr = $nresarr;
        }
      $result = '';
      for $fragment ( @$resarr ){
        $result .= $fragment->{'frag'};
        }
      }
    return $result if $verbatim;
    $result = &DoInput(\$result,$ReferenceFileName,$level+1);
    return $$result;
    }
  }
sub DefineMacro {
  my $name = shift;
  my $args = shift;
  my $value= shift;
  if( defined( $Macro{$name} ) ){
    $MacroStack{$name} = [] unless defined $MacroStack{$name};
    push @{$MacroStack{$name}},$Macro{$name};
    push @{$MacroStack{$name}},$MacArg{$name};
    }
  if( length($args) > 0 ){              # there are arguments
    my $argv = &Split($args);           # create formal parameter list
    for( @{$argv} ){ $_ = quotemeta $_ }# make each of them matchable
    $MacArg{$name} = $argv;             # store it
    }else{ $MacArg{$name} = undef }     # but let it be undef if there are no parameters
  $Macro{$name} = $value;               # store the value of the macro
  $value = "$name(" . ( length($args) > 0 ? join(',',@{$argv}):'') . ")=$value";
  &Trace('D',\$value);
  }
sub Split {
  my $string = shift;
  my $limit = shift;
  $limit = -1 unless defined($limit);
  my $sep = substr($string,0,1); # the first character
  $string = substr($string,1);   # the rest
  if( $sep =~ /^\s$/ && $sep ne "\n" ){
    $sep = '\s+';
    $string =~ s/^\s*//; # chop off leading spaces if space is the separator
    }else{ $sep = quotemeta $sep }
  my @list = split($sep,$string,$limit);
  return \@list;
  }
sub CharPair {
  my $ch = shift;
  if( $ch eq '(' ){ $ch = ')' }
  elsif( $ch eq ')' ){ $ch = '(' }
  elsif( $ch eq '[' ){ $ch = ']' }
  elsif( $ch eq ']' ){ $ch = '[' }
  elsif( $ch eq '{' ){ $ch = '}' }
  elsif( $ch eq '}' ){ $ch = '{' }
  elsif( $ch eq '<' ){ $ch = '>' }
  elsif( $ch eq '>' ){ $ch = '<' }
  return quotemeta $ch;
  }
sub Trace {
  return unless $TraceFile;
  my $type = shift; # one character type: L lines, M macro
  my $lines = shift;
  my $level = shift;
  my $file = $FILE[$#FILE];
  my $line = sprintf("%03d",$LINE{$file});
  my $mo = $macroOpen;
  $level = '-' unless defined $level;
  if( $LastFileNameDisplayedOnTraceOutput ne $file ){
    print TRACE "$line:F:$level: $file:\n";
    $LastFileNameDisplayedOnTraceOutput = $file;
    }
  for( split(/\n/,$$lines ) ){
    if( $type eq 'M' ){
      print TRACE "\n" unless $mo;
      print TRACE "$line:$type:$level: $mo$_";
      $mo = '';
      }
    elsif( $type =~ /L|D/ ){
      print TRACE "$line:$type:$level: $_\n";
      }
    $line++ unless $level && $level ne '-';
    }
  print TRACE "$macroClose\n" if $type eq 'M';
  }
sub Warning {
  return if $SupressWarnings;
  goto &Error;
  }
sub Error {
  my $message = shift;
  my $input = shift;
  my ($pac,$fil,$lin) = caller;
  my $MaxParLength = 20;
  $input = substr($input,0,$MaxParLength) . ' ...' if length($input) > $MaxParLength;
  $input =~ s/\n/\\n/g;
  $message .= "\n";
  $message .= "    Parameter: $input\n" if $input;
  if( $#FILE > -1 ){
    $message .= '    in file ' . $FILE[$#FILE] .' at line ' . $LINE{$FILE[$#FILE]} . "\n";
    }
  $message .= "    source=>$fil , package=>$pac , line=>$lin\n";
  print STDERR $message;
  print TRACE $message if $TraceFile;
  return '' unless $OutputError;
  return "\n*** ERROR ***\n$message*************";
  }
sub Relative {
  my $ReferenceFileName = shift; # the file name with path that is used as reference
  my $RelativeFileName = shift;  # relative file name: relative to the reference file name
  return $RelativeFileName if $RelativeFileName =~ /^\// || # starts with /
                              $RelativeFileName =~ /^\~/ || #             ~/
                              $RelativeFileName =~ /^\\/ || #             \
                              $RelativeFileName =~ /^\w\:/; #             c:
  $RelativeFileName =~ s#^\./##;# allow user to write ./
  if( $ReferenceFileName =~ m{/[^/]+$} ){#if it includes the path
    $ReferenceFileName =~ s{/[^/]+$}{};  #then we now take the file name off
    $ReferenceFileName .= '/';           #but leave the final /
    }else{#if this is only a plain file name taking it off leaves nothing
    $ReferenceFileName = '';
    }
  $RelativeFileName = $ReferenceFileName . $RelativeFileName;
  $RelativeFileName =~ s{//}{/}g;
  my @dlist = split( /\// , $RelativeFileName );
  my @d = ();
  while( $#dlist > -1 ){
    if( $#dlist == 0 ){
      push @d,$dlist[0];
      last;
      }
    if( $dlist[0] ne '..' && $dlist[1] eq '..' ){
      shift @dlist; shift @dlist;
      }else{ push @d , shift @dlist; }
    }
  $RelativeFileName = join('/',@d);
  return $RelativeFileName; #and now this is not relative anymore
  }
sub PredefineMacro {
  $WeAreInLoop = 0;
  @LoopMacroStack = ();
  &DefineMacro('version','',$VERSION);
  &DefineMacro('reference','',
"This page was created using <a href=\"http://peter.verhas.com/progs/perl/jamal\">jamal</A> v$VERSION");
  &DefineMacro('timeNow','',$timeNow);
  $MonthNames = [
                   'January',
                   'February',
                   'March',
                   'April',
                   'May',
                   'June',
                   'July',
                   'August',
                   'September',
                   'October',
                   'November',
                   'December'
                ];
  $DayNames = [
              'Monday',
              'Tuesday',
              'Wednesday',
              'Thursday',
              'Friday',
              'Saturday',
              'Sunday'
              ];
  $AM = 'am'; $PM = 'pm';
  $TimeFormat = 'hh:mm:ss';
  $DateFormat = 'MONTH DD, YEAR.';
  }
sub _convertTimeDate {
  my $time = shift;
  my $format = shift;
  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($time);
  my $YEAR = 1900 + $year;
  $mon++;
  my $am = $hour < 12 ? $AM : $PM;
  $format =~ s{HH}{$hour}g;
  $hour = '0' . $hour if $hour < 10;
  $format =~ s{0H}{$hour}g;
  $hour -= 12 if $hour > 12;
  $hour =~ s{^0}{}; # some perl version (version 5.005_02 built for sun4-solaris)
  $format =~ s{hh}{$hour}g;
  $hour = '0' . $hour if $hour < 10;
  $format =~ s{0h}{$hour}g;
  $format =~ s{am}{$am}g;
  $format =~ s{pm}{$am}g;
  $format =~ s{mm}{$min}g;
  $min = '0' . $min if $min < 10;
  $format =~ s{0m}{$min}g;
  $format =~ s{ss}{$sec}g;
  $sec = '0' . $sec if $sec < 10;
  $format =~ s{0s}{$sec}g;
  $format =~ s{YEAR}{$YEAR}g;
  $format =~ s{YY}{$year}g;
  $format =~ s{MM}{$mon}g;
  $mon = '0' . $mon if $mon < 10;
  $format =~ s{0M}{$mon}g;
  $mon = $MonthNames->[$mon-1];
  $format =~ s{MONTH}{$mon}g;
  $format =~ s{DD}{$mday}g;
  $mday = '0' . $mday if $mday < 10;
  $format =~ s{0D}{$mday}g;
  $wday = 7 unless $wday;
  $format =~ s{WD}{$wday}g;
  $wday = $DayNames->[$wday-1];
  $format =~ s{DAY}{$wday}g;
  return $format;
  }
sub ConvertDate {
  &_convertTimeDate($_[0],$DateFormat);
  }
sub ConvertTime {
  &_convertTimeDate($_[0],$TimeFormat);
  }
sub CNL { return $_[0] =~ tr/\n/\n/ }
sub HtmlParameters {
  my $file = shift;
  open(F,"<$file");
  my $o_irs = $/; undef $/;
  $file = <F>;
  close F;
  $/ = $o_irs;
  $file =~ m{<title>(.*?)</title>}i;
  my $title = $1;
  return ($title);
  }
sub help {
  print <<END;
jamal html preprocessor V$VERSION
Usage:
.
jamal [-options] input [output]
.
Options:
-? or -h               help
-m file                macro definition file
-D                     macro define
-I                     j-SEX directory
-0                     suppress output
-d                     put error message into result
-t file                trace file
.
Your default extension directories are:
END
  for( @INC ){
    print "$_\n";
    }
  }
sub maked {
  my $directory = shift;
  my $root;
  $directory =~ s{\\}{/}g; #make the file name UNIX compliant under Windows NT
  my(@d) = split(/\//,$directory);
  pop @d; #pop off the file name
  if( $d[0] =~ s/^(\w:)// ){
    shift @d if $d[0] eq '';
    unshift @d , $1;
    }
  if( $#d == -1 ){ return; }#this is the root directory
  if( $d[0] =~ /^\w:$/ ){#drive letter under Windows
    $root = shift @d;
    }elsif( $directory =~ /^\//){
    $root = '/';
    }else{
    $root = '';
    }
  for( @d ){
    $root .= '/' if $root;           # add a separator if there is something to separate
    $root .= $_;                     # take the next subdirectory
    -d $root || mkdir $root,$umask;  # it exists or create the directory
    }
  return 1; # we are done, and fine
  }
package jamal;
sub DefineMacro {
  my @cal = caller;
  my $caller = substr( $cal[0],7);
  &main::DefineMacro("$caller" . '::' . $_[0] , $_[1], $_[2] );
  }
sub Split {
  goto &main::Split;
  }
sub Open  { $main::macroOpen  }
sub Close { $main::macroClose }
sub version {
  $VersionWasCalled = 1;
  my $minV = shift;
  my $maxV = shift;
  my @cal = caller;
  my $caller = substr( $cal[0],7);
  $main::minV{$caller} = $minV if defined $minV;
  $main::maxV{$caller} = $maxV if defined $maxV;
  return $main::Module{$caller};  
  }
sub verbatim {
  my $value = shift;
  $value = 1 unless defined $vlaue;
  $main::ExtensionVerbatim = $value;
  }
sub input {
  return &main::Relative($main::InputFileName,$_[0]);
  }
sub output {
  return &main::Relative($main::OutputFileName,$_[0]) if $main::OutputFileName;
  return &main::Relative($main::InputFileName,$_[0]);
  }
sub require{
  $RequireWasCalled = 1;
  my $rversion = shift;
  my $caller = substr( $cal[0],7);
  if( $rversion > $main::VERSION ){
    &main::Error("Module $caller requires jamal V$rversion and I am only $main::VERSION",undef);
    exit;
    }
  $main::ModRequire{$caller} = $rversion;
  }
sub Warning {
  return if $main::SupressWarnings;
  goto &Error;
  }
sub Error {
  my $message = shift;
  my $input = shift;
  my ($pac,$fil,$lin) = caller;
  my $MaxParLength = 20;
  $input = substr($input,0,$MaxParLength) . ' ...' if length($input) > $MaxParLength;
  print STDERR "$message\n";
  print STDERR "    Parameter: $input\n" if $input;
  print STDERR "    in file $fil at line $lin\n";
  }
__END__