# emit.pl
#
# This code is Copyright 2002, 2003 Tony Lewis <tlewis@exelana.com>.
#
#   This program is free software: you can redistribute it and/or modify it
#   under the terms of the GNU General Public License as published by the Free
#   Software Foundation, either version 3 of the License, or (at your option)
#   any later version.
#
#   This program is distributed in the hope that it will be useful, but WITHOUT
#   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
#   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
#   more details.
#
#   You should have received a copy of the GNU General Public License along with
#   this program.  If not, see http://www.gnu.org/licenses/.
#

package emit;

#################################################################################################
# This module provides two entry points for processing an HTML template file.
#   emitHTML - prints the results on STDOUT
#   genHTML  - returns the results to the caller
#
# Calls to either routine must be wrapped in an eval (which allows locally defined variables to
# be referenced in the HTML template).
#
# Example calls:
#    eval(emitHTML("path/to/page.ht"),$flags);
#    my $content = eval(genHTML("path/to/page.ht"),$flags);
#
# $flags is an integer where flags are enabled by adding the following together:
#   1 - save generated file to path/to/debug/page.ht.out
#   2 - save debugging information to path/to/debug/page.ht.dbg
#   4 - embed debugging information in the generated HTML
#   8 - save internal state after completion
#
# The HTML template file may contain Perl variable references. It may also contain preprocessing
# directives to cause lines to be conditionally included (or not). Preprocessing directives begin
# in column one and start with a hash "#".
# The preprocessing directives are:
#   #if condition
#   #elsif condition
#   #else
#   #endif
#   #include path/to/file
#
# A "condition" may be any valid Perl expression. The argument to #include is the path to another
# HTML template file that is to be included into the output.
#  
# Note: Lines with only a hash or with a hash that is followed by either a space or another hash
# are comments.
#
#################################################################################################
sub main::emitHTML
{
  my $r = emitPass1(@_);
  $r .= "eval(emit::emitHTML2())";
  return $r;
}

sub emitHTML2
{
  return "print \"" .emitPass2(@_) ."\\n\";";
}

sub main::genHTML
{
  my $r = emitPass1(@_);
  $r .= "eval(emit::genHTML2())";
  return $r;
}

sub genHTML2
{
  return emitPass2();
}

########################################################################################################################
# Pass 1: process the template and determine what expressions need to be evaluated for pass 2
sub emitPass1
{
  my ($emitFName, $flags) = @_;
  local (*F, *O, *D);

  my @emit;
  %emit::info = ();
  %emit::cond = ();
  my $info = \%emit::info;

  $info->{fname} = $emitFName;
  $info->{flags} = $flags;
  $info->{error} = "";
  $info->{emit} = \@emit;
  $info->{pass} = 1;

  $info->{doOutput} = $flags % 2;
  $info->{doDebug} = ($flags >> 1) % 2;
  $info->{embedDebug} = ($flags >> 2) % 2;
  $info->{saveHashes} = ($flags >> 3) % 2;

  open F, $emitFName or emitError($info, "Unable to open HTML template: $emitFName\n$!");

  if ($flags)
  {
    my ($dir,$file) = $emitFName =~ m/(.*)\/([^\/]*)/;
    if ($info->{doOutput})
    {
      my $f = "$dir/debug/$file.out";
      open O, ">$f" or emitError($info, "Cannot open debugging file: $f\n$!");
      $info->{O} = *O;
    }
    if ($info->{doDebug})
    {
      my $f = "$dir/debug/$file.dbg";
      open D, ">$f" or emitError($info, "Cannot open debugging file: $f\n$!");
      $info->{D} = *D;
    }
  }
  return "" if $info->{error} ne "";

  my $emitIfDepth = 0;
  my $emitLineNum = 0;
  my @ifLines;
  my @ifState;

  my $cond = \%emit::cond;

  emitDebug($info,"*** Pass one over $info->{fname} ***\n") if $info->{doDebug};
  foreach my $line (<F>)
  {
    last if !defined($line);

    $emitLineNum++;
    chomp $line;

    emitDebug($info,"$emitLineNum: $line") if $info->{doDebug};
    next if length($line) == 0;

    # Ignore comments
    next if $line eq "#" || substr($line,0,2) eq "# " || substr($line,0,2) eq "##";

    if (substr($line,0,1) eq "#")
    {
      if ($line =~ m/^#(\S+)(.*)/)
      {
        $directive = $1;
        $args = $2;
        $args = $1 if $args =~ m/\s+(.*)/;
      } else {
        emitError($info,"Unknown directive: #$directive at line $emitLineNum\n");
        next;
      }

      # Discard any comments
      $n = 0;
      $in = "";
      while ($n < length($args)) {
        $c = substr($args,$n,1);
        last if ($c eq "#" and $in eq "");

        $n++;
        if ($c eq "\"" && $in eq "") { $in = $c; next }
        if ($c eq "'"  && $in eq "") { $in = $c; next }
        if ($c eq $in) { $in = ""; next }
      }
      $args = substr($args,0,$n);
      $args = $1 if $args =~ m/^(.*)\s+$/;

      if ($directive eq "if")
      {
        $emitIfDepth++;
        $ifLines[$emitIfDepth] = $emitLineNum;
        $ifState[$emitIfDepth] = 0;
        emitError($info,"Invalid directive: $line") if $args eq "";

        $cond->{"$args"} = 0;
        emitLine($info, "#if $args");

      } elsif ($directive eq "elsif" || $directive eq "elif") {
        emitError($info,"Mismatched #$directive at line $emitLineNum") if $emitIfDepth <= 0;
        emitError($info,"Invalid directive: $line") if $args eq "";

        $cond->{"$args"} = 0;
        emitLine($info, "#elsif $args");

      } elsif ($directive eq "else") {
        emitError($info,"Mismatched #else at line $emitLineNum") if $emitIfDepth <= 0;
        if ($ifState[$emitIfDepth] > 0)
        {
          emitError($info,"Too many #$directive directives at line $emitLineNum");
          emitError($info,"#if at line $ifLines[$emitIfDepth]");
        }
        emitError($info,"Invalid directive: $line") if $args ne "";
        emitLine($info,"#else");
        $ifState[$emitIfDepth] = 1;

      } elsif ($directive eq "endif") {
        emitError($info,"Invalid directive: $line") if $args ne "";
        emitLine($info,"#endif");

        $ifState[$emitIfDepth] = 2;
        $emitIfDepth--;
        emitError($info,"Mismatched #endif at line $emitLineNum") if $emitIfDepth < 0;

      } elsif ($directive eq "include") {
        local *INC;
        emitLine($info, "<!-- $line -->") if $info->{emitDebug};
        open INC, eval($args) or emitError($info,"Unable to include: ",eval($args)," at line $emitLineNum\n$!");
        processHTML(*INC, $info);
        close INC;
        emitLine($info, "<!-- End of $args -->") if $info->{emitDebug};

      } else {
        emitError($info,"Unknown directive: #$directive at line $emitLineNum");
      }
      next;
    }

    emitLine($info, $line);
  }

  if ($emitIfDepth > 0)
  {
    my $text = "Missing #endif\nLines: ";
    for ($i = 1; $i <= $emitIfDepth; $i++) { $text .= "$ifLines[$i] "; }
    $text .= "\n";
    emitError($info,$text);
  }

  close F;
  undef $info->{F};

  my $r = "";
  if ($info->{error} eq "")
  {
    my @ev;
    foreach $key (keys %emit::cond)
    {
      push @ev, "eval(\$emit::cond{'$key'} = ($key) ? 1 : 0)";
      $r .=  "\$emit::cond{'$key'} = 1 if $key;\n";
    }
    emitDebug($info, "\n*** Evaluate ***\n", join("\n", @ev), "\n***") if $info->{doDebug};
  } else {
    emitDebug($info, "\n*** Errors ***") if $info->{doDebug};
  }
  return $r;
}

########################################################################################################################
# Pass 2: emit the final HTML now that the conditional expressions have been evaluated
sub emitPass2
{
  my $info = \%emit::info;
  return errorPage($info) if $info->{error};

  my $cond = \%emit::cond;
  my @emit = @{$info->{emit}};

  my @newemit;
  $info->{emit} = \@newemit;

  $info->{pass} = 2;
  emitDebug($info, "*** Pass two over $info->{fname} ***\n");
  foreach my $key (sort keys %emit::info)
  {
    if (ref($emit::info{$key}) eq "ARRAY")
    {
      emitDebug($info,"\$info{\"$key\"} => Array with ".(1+$#{$emit::info{$key}})." elements");
    } else {
      emitDebug($info,"\$info{\"$key\"} => $emit::info{$key}") if defined($emit::info{$key});
    }
  }


  my $emitCode = "";
  my $emitIfDepth = 0;
  my @ifDone;
  my @ifState;
  my $emitting = 1;
  $ifState[0] = $emitting;
  foreach my $line (@emit)
  {
    if (substr($line,0,1) eq "#")
    {
      $arg = "";
      if ($line =~ m/^#(\S+)\s*(.*)/)
      {
        $directive = $1;
        $arg = $2 if defined($2);
      }

      if ($directive eq "if")
      {
        $ifState[$emitIfDepth] = $emitting;
        $emitIfDepth++;
        $emitting &= $cond->{"$arg"} if defined($cond->{"$arg"});
        $ifDone[$emitIfDepth] = $emitting;
        emitDebug($info, "#if $arg => ",$cond->{"$arg"}," [$emitting,$emitIfDepth]") if $info->{doDebug};
        emitLine($info, "<!-- #if ",emitEncode($arg)," -->") if $info->{embedDebug};
      } elsif ($directive eq "elsif") {
        $emitting = 0 if $ifDone[$emitIfDepth];
        $emitting = $cond->{"$arg"} if !$ifDone[$emitIfDepth];
        $emitting = 0 if $emitIfDepth > 0 && $ifState[$emitIfDepth-1] != 1;
        $ifDone[$emitIfDepth] |= $emitting;
        emitDebug($info, "#elsif $arg => ",$cond->{"$arg"}," [$emitting,$emitIfDepth]") if $info->{doDebug};
        emitLine($info, "<!-- #elsif ",emitEncode($arg)," -->") if $info->{embedDebug};
      } elsif ($directive eq "else") {
        $emitting = 1 - $ifDone[$emitIfDepth];
        $emitting = 0 if $emitIfDepth > 0 && $ifState[$emitIfDepth-1] != 1;
        $ifDone[$emitIfDepth] |= $emitting;
        emitDebug($info, "#else [$emitting,$emitIfDepth]") if $info->{doDebug};
        emitLine($info, "<!-- #else -->") if $info->{embedDebug};
      } elsif ($directive eq "endif") {
        $emitIfDepth--;
        $emitting = $ifState[$emitIfDepth];
        emitDebug($info, "#endif [$emitting,$emitIfDepth]") if $info->{doDebug};
        emitLine($info, "<!-- #endif -->") if $info->{embedDebug};
      }
      next;
    }

    emitLine($info, $line) if $emitting;
  }

  close D if defined($info->{D});
  close O if defined($info->{O});

  $emitCode = join("\\n", @{$info->{emit}});
  $emitCode =~ s/\"/\\\"/g;

  undef %emit::info unless $info->{saveHashes};
  undef %emit::cond unless $info->{saveHashes};
  return '"' . $emitCode . '"';
}

########################################################################################################################
sub emitLine
{
  my ($info,@text) = @_;

  my $toemit = $info->{emit};
  local *O = $info->{O} if defined($info->{O});
  local *D = $info->{D} if defined($info->{D});

  foreach my $line (emitFormatLines(@text))
  {
    print O "$line\n" if $info->{pass} == 2 && defined($info->{O});
    print D "Line: $line\n" if $info->{pass} == 2 && defined($info->{D});

    push(@$toemit, $line);
  }
}

sub emitDebug
{
  my ($info,@text) = @_;
  return if !defined($info->{D});

  local *D = $info->{D} if defined($info->{D});
  foreach my $line (emitFormatLines(@text))
  {
    print D "$line\n";
  }
}

sub emitError
{
  my ($info,@text) = @_;
  foreach my $line (emitFormatLines(@text))
  {
    $info->{error} .= "$line<br>\n";
  }
}

sub emitFormatLines
{
  my $text = "";
  foreach my $piece (@_)
  {
    $text .= $piece;
  }
  return split(/\n/, $text);
}

sub emitEncode
{
  my ($text) = @_;
  $text =~ s/\$/\\\$/g;
  $text =~ s/\@/\\\@/g;
  $text =~ s/\%/\\\%/g;
  return $text;
}

sub errorPage
{
  my ($info) = @_;

  my $bodyError = $info->{error};
  $bodyError =~ s/<br>\n/; /g;
  my $r = <<EndOfLines;
<HTML>
<HEAD>
<TITLE>Unable to process $info->{fname}</TITLE>
</HEAD>
<BODY>
<B>Unable to process $info->{fname}</B><P>
<FONT COLOR=RED>$info->{error}</FONT><p>
</BODY>
</HTML>
EndOfLines

  emitDebug($info, $r) if $info->{doDebug};
  $r =~ s/\"/\\\"/g;
  return '"' . $r . '"';
}

1;