#!/usr/bin/perl

# mhtml.pm - 0.0.3
# 199912200513
# See gpl.txt for copyright information

sub print_macros
{
  my(@m,$i,$j);
  @m = @_;

  for ($i=0;$i<$#m+1;$i++)
  {
    print "Macro name: $m[$i]{'name'}\n";
    for ($j=0;$j<$#{$m[$i]{'options'}}+1;$j++)
    {
      print "-  Option: \"", $m[$i]{'options'}[$j]{'name'}, "\"\t\tValue: ";
      if ($m[$i]{'options'}[$j]{'value'} eq "") {print "null";} else {print "$m[$i]{'options'}[$j]{'value'}";}
      print "\n";
    }
    print "---Open Code---\n$m[$i]{'open'}\n---------------\n";
    print "---Close Code---\n$m[$i]{'close'}\n----------------\n";
  }
}


sub get_closecode
{
  my($t,$close);
  $t = $_[0];

  $t =~ m/<closecode>(.*?)<\/closecode>/is;
  $close = $1;

  return $close
}

sub get_opencode
{
  my($t,$open);
  $t = $_[0];

  $t =~ m/<opencode>(.*?)<\/opencode>/is;
  $open = $1;

  return $open
}

sub get_options
{
  my($t,$op,$name,$value,%option,@option_list,$temp);

  $t = $_[0];

  while ($t =~ m/(<option.*?>.*?<\/option>)/igs)
  {
    $op = $1;
    $op =~ m/<option\ name\=\"(\w+)\">/is;
    $name = $1;
    $op =~ m/<option.*?>(.*?)<\/option>/is;
    $value = $1;
    $option{'name'} = $name;
    $option{'value'} = $value;
    push @option_list, {%option};
  }

  return @option_list;
}

sub get_name
{
  my($t);
  $t = $_[0];

  $t =~ m/<macro\ name\=\"(\w+)\">/is;

  return $1;
}

sub strip_macros
{
  my($m);
  $m = $_[0];

  while($m =~ m/(<macro.*?>.*?<\/macro>)\n*/is)
  {
    $m =~ s/(<macro.*?>.*?<\/macro>)\n*//is;
  }

  return $m;
}

sub get_macros
{
  my($m,$a,@macros,$name,@option_list,$opencode,$closecode,@box,%tempbox,$t,@l);
  $m = $_[0];

  while($m =~ m/(<macro file=\".*?\">.*?<\/macro>)/is)
  {
    $m =~ s/<macro file=\"(.*?)\">.*?<\/macro>//is;
    open(temp,"$1") or die "Can't open $1\n";
    while(<temp>) {$t .= $_;}
    @l = get_macros($t);
    push @box, @l;
  }

  while($m =~ m/(<macro name.*?>.*?<\/macro>)/is)
  {
    $m =~ s/(<macro name.*?>.*?<\/macro>)//is;
    push @macros, $1;
  }

  foreach $a (@macros)
  {
    $name = get_name($a);
    @option_list = get_options($a);
    $opencode = get_opencode($a);
    $closecode = get_closecode($a);
    $tbox{'name'} = $name;
    $tbox{'options'} = [ @option_list ];
    $tbox{'open'} = $opencode;
    $tbox{'close'} = $closecode;
    push @box, {%tbox};
  }

  return @box;
}

sub parse_paramaters
{
  my $p = $_[0];
  my (%l,$val,$name,$quo);

  while ($p =~ m/([\w]+)=("([^"\\]*(\\.[^"\\]*)*)"|([^\s>]+)|\s*)\s?/igs)
  {
    $name = $1;
    $val = $2;
    $quo = $3;
    if ($val =~ m/"/is)
    { $val = $quo;}
    $l{$name} = $val;
  }

  return %l;
}

sub expand_macros
{
  my(@m,$t,@p,$para,$incode,%ops,$tem,$rep,$n,$v,$out);
  my($string,$name);

  ($t, @m) = @_;

  for ($i=0;$i<$#m+1;$i++)
  {
    $name = $m[$i]{'name'};
    if($t =~ m/<$name([^\w>])*(([^\s>"]+"[^"\\]*(\\.[^"\\]*)*"|([^\s>]+)|\s*)+)>(.*?)<\/$name>/igs)
    {
      $para = $2;
      $incode = $6;
      %ops = parse_paramaters($para);
      $tem = $m[$i]{'open'};
      while ($tem =~ m/\[(.*?)\]/igs)
      {
        $out = "";
        $n = $1;
        $v = "";
        for ($j=0;$j<$#{$m[$i]{'options'}}+1;$j++)
        {
          if ($m[$i]{'options'}[$j]{'name'} eq $n)
          {
            if ($ops{$n} eq "") {$v = $m[$i]{'options'}[$j]{'value'};} else {$v = $ops{$n};}
          $tem =~ s/\[$n\]/$v/igs;
          $v = "";
          }
        }
      }
      $out = $tem . $incode;
      $tem = $m[$i]{'close'};
      while ($tem =~ m/\[(.*?)\]/igs)
      {
        $n = $1;
        $v = "";
        for ($j=0;$j<$#{$m[$i]{'options'}}+1;$j++)
        {
          if ($m[$i]{'options'}[$j]{'name'} eq $n)
          {
            if ($ops{$n} eq "") {$v = $m[$i]{'options'}[$j]{'value'};} else {$v = $ops{$n};}
          $tem =~ s/\[$n\]/$v/igs;
          $v = "";
          }
        }
      }
      $out .= $tem;
      $t =~ s/<$m[$i]{'name'}(.*?)>(.*?)<\/$m[$i]{'name'}>/$out/is;
    }
  }

  return $t;
}

sub evaluate_macros
{
  my($t,@m,$a);
  $t = $_[0];
  @m = get_macros($t);
  $t = strip_macros($t);
  $a = $t;
  $t = expand_macros($t,@m);
  while ($a ne $t)
  {
    $a = $t;
    $t = expand_macros($t,@m);
  }
  return $t;
}

1 # Why do we need this?

# End of mhtml.pm