# probits template processing
# copyright 2001-2025 by knud.werner@probits.de

package Templates;
use Exporter;
use warnings;
use strict;

my @ISA = qw(Exporter);
my @EXPORT = ( );

# public interface

push @EXPORT, qw(setGlobal);
push @EXPORT, qw(getGlobal);
push @EXPORT, qw(addDir);
push @EXPORT, qw(setDebug);
push @EXPORT, qw(clrDebug);
push @EXPORT, qw(printTemplate);
push @EXPORT, qw(getArg);
push @EXPORT, qw(haveArg);

# module variables and containers

my $templates_debug = 0;
my %globals = ( );
my @templateDirs = ( '.' );
my %allTemplates = ( );

# set and get global values

sub setGlobal {

  my ($name,$val) = @_;
  $globals{$name} = $val;
}

sub getGlobal {

  my ($name) = @_;
  die "gloabl $name not found" unless exists $globals{$name};
  my $val = $globals{$name};
  return $val;
}

# add directory to template search path

sub addDir {

  my ($dir) = @_;
  push @templateDirs, $dir;
}

# set and clear debug state

sub setDebug {

  $templates_debug = 1;
}

sub clrDebug {

  $templates_debug = 0;
}

# check for and get arguments 

sub haveArg {

  my ($hash,$name) = @_;
  my $val = (exists $hash->{$name}) ? 1 : 0;
  return $val;
}

sub getArg {

  my ($hash,$name) = @_;
  die "Unknown argument $name" unless haveArg($hash,$name);
  my $val = $hash->{$name};
  return $val;
}

# print template

sub printTemplate {

  if ($templates_debug > 0) {
    my $hash = $_[1];
    my $args = '';
    foreach my $key (keys %$hash) {
      my $val = $hash->{$key};
      $args .= "$key=$val:";
    }
    $args =~ s/:$//;
    print STDERR "Print template $_[0] with $args\n";
  }
  my $code = '$ref = ' . getTemplate($_[0]);
  if ($templates_debug > 0) {
    print STDERR "Code is:\n$code";
  }
  my $ref;
  eval $code;
  die "Can't eval $code : $@" if $@;
  my $text = &{$ref}($_[1]);
  return $text;
}

# internal methods

sub readTemplateFile {

  my ($file) = @_;
  my $list = [ ];
  open my $in, "<$file" or die "Can't open $file : $!";
  while (my $line = <$in>) {
    push @$list,$line;
  }
  close $in;
  # poor man's basename
  $file =~ s/.*\/(.*?)/$1/;
  # strip suffix
  $file =~ s/\.tpl//;
  $allTemplates{$file} = $list;
}

# create code of subroutine from template text

sub processTemplate {

  my ($name) = @_;
  my $lines = $allTemplates{$name};
  my $code = <<EOF;
sub {
  my (\$args) = \@_;
  my \$result = '';
EOF
  my $flag = 0;
  foreach my $line (@$lines) {
    # skip comments
    next if $line =~ m/^!\s*#/;
    if (substr($line,0,1) eq '!') {
      if ($flag == 1) {
        $code .= "EOF\n";
      }
      $code .= ' ' . substr($line,1);
      $flag = 0;
      next;
    }
    if ($flag == 0) {
      $code .= "\$result .= <<EOF;\n";
    }
    $flag = 1;
    $code .= $line;
  }
  if ($flag == 1) {
    $code .= "EOF\n";
  }
  $code .= <<EOF;
  return \$result;
}
EOF
  return $code;
}

# find template file by name

sub findTemplate {

  my ($name) = @_;
  $name .= ".tpl";
  my $find_cmd = $ENV{USR_CMD_FIND} || 'find';
  foreach my $path (@templateDirs) {
    my $cmd = "$find_cmd $path -name '$name'";
    my @files = `$cmd`;
    if (scalar @files == 1) {
      my $file = $files[0];
      chomp $file;
      return $file;
    }
  }
  die "Can't find template $name";
}

# get subroutine code for template from cache or file

sub getTemplate {

  my ($name) = @_; 
  if (not exists $allTemplates{$name}) {
    my $file = findTemplate($name); 
    readTemplateFile($file);
  }
  my $code = processTemplate($name);
  return $code;
}

1;