###############
package main;
###############

BEGIN {
    print "Content-type: text/html\n\n";
    $0 =~ m~(.*)/[^/]+~ || $0 =~ m~(.*)\\[^\\]+~;
    unshift @INC, $1;
}

    use strict;
    use warnings;
    
    my $token = EasyTemplate->new();
    my @array = qw/Dieser Text besteht aus den Elementen eines Arrays/;
    
    # Loop
    $token->tpl_param(
        'TPL_TEST1',
        'Loop_test',
        { 'foo' => $_ }
    ) foreach @array;
        
    # Conditions
    foreach (@array) {
        $token->tpl_param(
            'TPL_TEST2',
            'If_test',
            { 'foo' => $_ }
        ) if $_ eq 'Elementen';
    }
    
    # Include 
    $token->tpl_param(
        'TPL_TEST3',
        'Include_test',
        {
            'foo' => foo(),
            'bar' => bar()
        }
    );
    
    $token->disp_template('test_file');

###############
sub foo {
###############
    return 'Rueckgabewert aus sub foo';
}

###############
sub bar {
###############
    return 'Rueckgabewert aus sub bar';
}

#-##############################################
# EasyTemplate.pm
# Date: 05/15/2004
# Version: eTPL-1.2.1
# Last update: 06/06/2004
#-#############################################
# Best code-viewing with 'Komodo' by ActiveState
# http://www.activestate.com
#-##############################################
# LICENSE-CONDITIONS:
#
# 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 2
# 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, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
#-#############################################
# 
# In accordance with the GPL, each copyright notice MUST remain intact.
#
# EasyTemplate Release Version 1.2.1 (06/06/2004)
# Copyright (C) 2004 Dieter Werner
# All rights reserved by the author.
#
#-#############################################
    package EasyTemplate;
    
#-#############################################
# Use-Section
#-#############################################
    use strict;
    use warnings;
    
#-#############################################
# Constructor
#-#############################################
sub new {
    my $invoc  = shift;
    my $attrib	= shift || undef;
    my $class 	= ref($invoc) || $invoc;
    my $self 	= {};

    bless($self, $class);
    return($self->init_template($attrib));
}

#-#############################################
# Define properties
#-#############################################
sub init_template {
    my $self 	= shift;
    my $attrib	= shift;
    local $_;
    
    $attrib
        ?   do {
                ($self->{'template'}->{$_} = $attrib->{$_})
                foreach (keys %$attrib)
            }
        :   ($self->{'template'} = {
            
                }
            );
    
    return $self;
}

#-#############################################
# Sub: Get parameters
#-#############################################
sub tpl_param {
    my ($self, $tag, $id, $param) = @_;

    (!defined $tag and defined $id) && $self->oops('Template-Tag not defined');
    (defined $tag and !defined $id) && $self->oops('Tag-Name not defined');
    
    ($tag, $id) = (
        'TPL_COMMON',
        'Common'
    ) unless defined $tag and defined $id;

    push @{$self->{'template'}->{'param'}->{$tag}->{$id}}, $param;
}

#-#############################################
# Sub: Read and prepare a template file
#-#############################################
sub disp_template {
    my ($self, $file) = @_;
    my ($tag, $id);
    
    local $_;
    local $/;
    
    open FILE, "./Template/$file.txt" or $self->oops('Template-File not found');
    $self->{'template'}->{'cont'} .= <FILE>;
    close FILE;
    
        foreach $tag (keys %{$self->{'template'}->{'param'}}) {
            while ($self->{'template'}->{'cont'} =~ /\<$tag\sName\=\"(\w+)\"\>(.*?)\<\/$tag\sName\=\"\w+\"\>/sg) {
                $self->{'template'}->{$tag}->{$1} = $2;
                $self->{'template'}->{'cont'}
                =~ s/\<$tag\sName\=\"($1)\"\>.*?\<\/$tag\sName\=\"$1\"\>/\<$tag\=\"$1\"\>/s;
            }
        }
    
    _replace_content($self);
}

#-#############################################
# Sub: Replace named contents and global variables
#-#############################################
sub _replace_content {
    my $self = shift;
    my ($tag, $id, $subst, $temp, $cache);
    local $_;
    
        foreach $tag (keys %{$self->{'template'}->{'param'}}) {
            $tag eq 'TPL_COMMON' && next;
            
                foreach $id (keys %{$self->{'template'}->{'param'}->{$tag}}) {
                    foreach $subst (@{$self->{'template'}->{'param'}->{$tag}->{$id}}) {
                        $temp = $self->{'template'}->{$tag}->{$id} || next;
                        
                        $temp =~ s/\<TPL_VAR\=\'$_\'\>/$subst->{$_}/sg
                        foreach (keys %$subst);
                        
                        $cache .= $temp;
                    }
                    
                    $self->{'template'}->{'cont'} =~ s/\<$tag\=\"$id\"\>/$cache/s;
                    undef $cache;
                }
        }
    
        foreach $subst (@{$self->{'template'}->{'param'}->{'TPL_COMMON'}->{'Common'}}) {	
            $self->{'template'}->{'cont'} =~ s/\<TPL_VAR\=\'$_\'\>/$subst->{$_}/sg
            foreach (keys %$subst);
        }
    
    _replace_txt($self);	
}

#-#############################################
# Sub: Replace text-content (Translated text)
#-#############################################
sub _replace_txt {
    my $self = shift;
    my $err_message = '<b>Text-Replacement is not available</b>';
    
    _wipe_template($self)
    unless exists $self->{'txt'} or exists $self->{'long_txt'};
    
    $self->{'template'}->{'cont'}
    =~ s/\<TXT\=\'(\w+.*?)\'\>/$self->{'txt'}->{$1} || $self->{'long_txt'}->{$1} || $err_message/esg;
    
    _wipe_template($self);
}

#-#############################################
# Sub: Delete unused stuff
#-#############################################
sub _wipe_template {
    my $self = shift;
    
    $self->{'template'}->{'cont'}	=~ s/\<TPL_.*?\/TPL_\w+\sName\=\"\w+\"\>\r*\n//sg;
    $self->{'template'}->{'cont'}	=~ s/\<TPL_\w+\=\"\w+\"\>\r*\n//sg;
    
    _print_template($self); 
}

#-#############################################
# Sub: Display the template
#-#############################################
sub _print_template {
    my $self = shift;
    
    print $self->{'template'}->{'cont'};
    delete $self->{'template'};
}

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