package XXV::OUTPUT::Html;

use strict;

#use Template;
use vars qw($AUTOLOAD);
use Locale::gettext;
use Tools;
use XXV::OUTPUT::HTML::WAIT;
use File::Path;
use Pod::Html;
use HTML::TextToHTML;

$SIG{CHLD} = 'IGNORE';

# ------------------
sub AUTOLOAD {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $data = shift || {};
    my $params = shift || 0;

    my $name = (split('::', $AUTOLOAD))[-1];
    return  if($name eq 'DESTROY');

    my $output = $obj->parseTemplate($name, $data, $params);

    $obj->out( $output );

    $obj->{call} = '';
}


# ------------------
sub new {
# ------------------
	my($class, %attr) = @_;
	my $self = {};
	bless($self, $class);

    $self->{handle} = $attr{'-handle'}
        || return error('No handle defined!');

    $self->{paths} = $attr{'-paths'}
        || return error('No Paths defined!');

    $self->{dbh} = $attr{'-dbh'}
        || return error('No DBH defined!');

    $self->{htmdir} = $attr{'-htmdir'}
        || return error('No htmdir given!');

    $self->{cgi} = $attr{'-cgi'}
        || return error('No TemplateDir given!');

    $self->{mime} = $attr{'-mime'}
        || return error('No Mimehash given!');

    $self->{browser} = $attr{'-browser'}
        || return error('No Mimehash given!');

    $self->{start} = $attr{'-start'}
        || return error('No StartPage given!');

    $self->{TYP} = 'HTML';

    # create Template object
    $self->{tt} = Template->new(
      START_TAG    => '\<\?\%',		    # Tagstyle
      END_TAG      => '\%\?\>',		    # Tagstyle
      INCLUDE_PATH => $self->{htmdir},  # or list ref
      INTERPOLATE  => 1,                # expand "$var" in plain text
      PRE_CHOMP    => 1,                # cleanup whitespace
      EVAL_PERL    => 1,                # evaluate Perl code blocks
    );

    eval "use Compress::Zlib";
    $self->{Zlib} = ($@ ? 0 : 1);


    # create TextToHTML object
    $self->{txt2html} = HTML::TextToHTML->new(
        preformat_whitespace_min => 4,
    );

	return $self;
}

# ------------------
sub entities
# ------------------
{
    my $s = shift;

    $s =~ s/&/&amp;/g;
    $s =~ s/>/&gt;/g;
    $s =~ s/</&lt;/g;
    $s =~ s/\"/&quot;/g;
    $s =~ s/([^a-zA-Z0-9&%;:,\.\!\?\(\)\' ])/sprintf("&#x%02x;",ord($1))/eg;

    return $s;
}

# ------------------
sub parseTemplate {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $name = shift || return error ('No Name!' );
    my $data = shift || return error ('No Data!' );
    my $params = shift || {};

    my $output;
    unless(defined $obj->{header}) {
        $output .= $obj->parseTemplateFile("start", $data, $params);
        $obj->{sendfooter} = 1;
    }
    $output .= $obj->parseTemplateFile($name, $data, $params,((exists $obj->{call}) ? $obj->{call} : 'nothing'));
    return $output;
}

# ------------------
sub footer {
# ------------------
    my $obj = shift || return error ('No Object!' );
    if(defined $obj->{sendfooter}) {
        $obj->out( $obj->parseTemplateFile("footer", {}, {}));
    }
}

# ------------------
sub index {
# ------------------
    my $obj = shift || return error ('No Object!' );
    $obj->{nopack} = 1;
    $obj->{call} = 'index';
    $obj->out( $obj->parseTemplateFile("index", {}, {}, $obj->{call}));
}


# ------------------
sub parseTemplateFile {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $name = shift || return error ('No Name!' );
    my $data = shift || return error ('No Data!' );
    my $params = shift || return error ('No params!' );
    my $call = shift || 'nothing';

    my $t = $obj->{tt};
    my $u = main::getModule('USER');

    # you can use two templates, first is a user defined template
    # and second the standart template
    # i.e. call the htmlhelp command the htmlhelp.tmpl
    # SpecialTemplate:  ./htmlRoot/usage.tmpl
    # StandartTemplate: ./htmlRoot/widgets/menu.tmpl
    my $widget_first  = sprintf('%s.tmpl', $call);
    my $widget_second = sprintf('widgets/%s.tmpl', $name);
    my $widget = (-e sprintf('%s/%s', $obj->{htmdir}, $widget_first) ? $widget_first : $widget_second);
    my $user = ($u->{active} eq 'y' ? $obj->{USER}->{Name} : "nobody" );
    my $output;
    my $vars = {
        cgi     => $obj->{cgi},
        call    => $name,
        data    => $data,
        type    => ref $data,
        info    => $obj->browser,
        param   => $params,
        pid     => $$,
        debug   => 1,
        user    => $user,
        allow   => sub{
            my($cmdobj, $cmdname, $se, $err) = $u->checkCommand($obj, $_[0],"1");
            return $cmdobj;
        },
    	basedir => $obj->{htmdir},
    	start   => $obj->{start},
        entities => sub{ return entities($_[0]) },
        # translate string, usage : gettext(foo,truncate) or gettext(foo)
        # value for truncate are optional
        gettext => sub{
            my $t = gettext($_[0]);
            $t = substr($t,0,$_[1]) . "..."
                if(defined $_[1] && length($t)>$_[1]);
            return entities($t);
        },
        version => sub{ return main::getVersion },
        url     => sub{ $_[0]  =~ s/([^a-z0-9A-Z])/sprintf('%%%X', ord($1))/seg; return $_[0] ; },
        loadfile    => sub{ return load_file(@_) },
        writefile   => sub{
            my $filename = shift || return error('No Filename to write');
            my $data = shift || return error('Nothing data to write');

            my $dir = $u->userTmp($user);

            # absolut Path to file
            my $file = sprintf('%s/%s', $dir, $filename);
            # absolut Path to file
            if(save_file($file, $data)) {
                # return the relative Path
                return sprintf('tempimages/%s', $filename);
            }
        },
    };

    $t->process($widget, $vars, \$output)
          or return error($t->error());

    return $output;
}

# ------------------
sub out {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $text = shift || 'no Text for Output';
    my $type = shift || 'text/html';
    my %args = @_;

    unless(defined $obj->{header}) {
        # HTTP Header
        $obj->{output_header} = $obj->header($type, \%args);
    }
    $obj->{sendbytes}+= length($text);

    $obj->{output} .= $text,"\r\n";
}

# ------------------
sub printout {
# ------------------
    my $obj = shift  || return error ('No Object!' );
    my $nopack = shift || $obj->{nopack} || 0;

    my $content = $obj->{output};

    $content = Compress::Zlib::memGzip($content)
        if(! $nopack and $obj->{Zlib} and $obj->{browser}->{accept_gzip});

    $obj->{handle}->print($obj->{output_header}, $content);
    undef $obj->{output};
    undef $obj->{output_header};
    undef $obj->{nopack};
}


# ------------------
sub header {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $typ = shift || return error ('No Type!' );
    my $arg = shift || {};

    $arg->{'Content-encoding'} = 'gzip'
        if($obj->{browser}->{accept_gzip} && ((!defined $obj->{nopack}) || $obj->{nopack} == 0) );

    $obj->{header} = 1;
    return $obj->{cgi}->header(
        -type   =>  $typ,
        -status  => "200 OK",
        %{$arg},
    );
}

# ------------------
sub headerNoAuth {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $typ = shift || 'text/html';

    $obj->{header} = 1;
    return $obj->{cgi}->header(
        -type    => $typ,
        -status  => "401 Authorization Required\nWWW-Authenticate: Basic realm=\"xxvd\""
    );
}

# ------------------
sub status404 {
# ------------------
    my $obj = shift  || return error ('No Object!' );
    my $file = shift || return error ('No File!' );
    my $why = shift || return error ('No File!' );

    warn("I can't read file $file");

    $file =~ s/$obj->{htmdir}//g; # Don't post html root, avoid spy out
    $obj->{nopack} = 1;
    $obj->{header} = 1;
    my $data = $obj->{cgi}->header(
        -type   =>  'text/html',
        -status  => "404 File not found",
    );
    $data .= $obj->{cgi}->start_html(gettext("ERROR"));
    $data .= $obj->{cgi}->h2(gettext("ERROR"));
    $data .= $obj->{cgi}->strong(sprintf(gettext("can't open file '%s' : %s"),$file,$why));
    $data .= $obj->{cgi}->end_html;
    $data .= "\r\n";
    $obj->{handle}->print( $data );
}

# ------------------
sub question {
# ------------------
    my $obj         = shift || return error ('No Object!' );
    my $titel       = shift || 'undef';
    my $questions   = shift || return error ('No Data!' );
    my $erg         = shift || 0;

    my $q = $obj->{cgi};
    my $quest;

    # Check Data
    if(ref $erg eq 'HASH' and ref $questions eq 'ARRAY' and exists $erg->{action}) {
        my $error;
        @$quest = @$questions;
        while (my ($name, $data) = splice(@$quest, 0, 2)) {
            # Required value ...
            $error = $data->{req}
                if($data->{req} and not $erg->{$name});

            # Check Callback
            if(exists $data->{check} and ref $data->{check} eq 'CODE' and not $error) {
                ($erg->{$name}, $error) = $data->{check}($erg->{$name}, $data, $erg);
            }

            # Check on directory
            if($data->{typ} eq 'dir' and $data->{required} and not -d $erg->{$name}) {
                ($erg->{$name}, $error) = (undef, sprintf(gettext("Directory '%s' is doesn't exist!"), $erg->{$name}));
            }

            # Check on file
            if($data->{typ} eq 'file' and $data->{required} and not -e $erg->{$name}) {
                ($erg->{$name}, $error) = (undef, sprintf(gettext("File '%s' is doesn't exist!"), $erg->{$name}));
            }

            # Check on password (is not set the take the old password)
            if($data->{typ} eq 'password' and not $erg->{$name}) {
                $erg->{$name} = $data->{def};
            }

            if($error) {
                $obj->err(sprintf(gettext("ERROR in %s: %s"),$name, $error));
                last;
            }
        }
        unless($error) {
            delete $erg->{action};
            return $erg;
        }
    }

    $obj->formStart($titel);
    if(ref $questions eq 'ARRAY') {
        my $q = $obj->{cgi};
        @$quest = @$questions;
        while (my ($name, $data) = splice(@$quest, 0, 2)) {
            my $type = delete $data->{typ};
            my $params = delete $data->{param};
            $data->{msg} =~ s/\n/<br>/sig if($data->{msg});
            $data->{NAME} = '__'.$name;
            $type ||= 'string';
            $obj->$type($data, $params);
        }
    } else {
        my $type = delete $questions->{typ};
        $questions->{NAME} = '__'.$type;
        $type ||= 'string';
        $obj->$type($questions);
    }
    $obj->formEnd;
    return undef;
}

# ------------------
sub wait {
# ------------------
    my $obj = shift  || return error ('No Object!' );
    my $msg = shift  || gettext("Please wait ...");
    my $min = shift  || 0;
    my $max = shift  || 0;
    my $screen = shift  || 0;

    $obj->{nopack} = 1;
    $obj->{header} = 1;
    my $waiter =  XXV::OUTPUT::HTML::WAIT->new(
        -cgi => $obj->{cgi},
        -handle => $obj->{handle},
        -callback => sub{
            my ($min, $max, $cur, $steps, $nextmessage) = @_;
            my $out = $obj->parseTemplate(
                'wait',
                {
                    msg     => $nextmessage || $msg,
                    minimum => $min,
                    current => $cur,
                    maximum => $max,
                    steps   => $steps
                },
            );
            return $out;
        },
    );

    if($max) {
        $waiter->min($min);     # Min Value for process Bar
        $waiter->max($max);     # Max Value for process Bar
        $waiter->screen($screen); # Every call of next will redraw the process bar

    }
    return $waiter;
}

# ------------------
sub image {
# ------------------
    my $obj = shift  || return error ('No Object!' );
    my $file = shift || return error ('No File!' );
    my $typ = shift  || $obj->{mime}->{lc((split('\.', $file))[-1])}
        or return error("No Type in Mimehash or File: $file");

    $obj->{nopack} = 1
        if($typ =~ /image\//);

    my $data = load_file($file)
        or return $obj->status404($file,$!);

    $obj->out($data, $typ);
}

# ------------------
sub datei {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $file = shift || return error ('No File!' );

    my $data = load_file($file)
        or return $obj->status404($file,$!);

    $obj->out($data, 'text/html');
}

# ------------------
sub pod {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $modname = shift || return error ('No Modname!' );

    my $u = main::getModule('USER');
    my $user = ($u->{active} eq 'y' ? $obj->{USER}->{Name} : "nobody");

    my $podfile = sprintf('%s/%s.pod', $obj->{paths}->{DOCPATH}, $modname);
    my $htmlfile = sprintf('%s/xxv_pod.html', $u->userTmp($user));

    my $pod = pod2html("--infile=$podfile", "--outfile=$htmlfile" );
    my $html = `cat $htmlfile`;
    $html = $1 if($html =~ /\<body.*?\>(.+?)\<\/body\>/si);
    $obj->link({
        text => gettext("Back to configuration screen"),
        url => $obj->{browser}->{Referer},
    });
    $obj->message($html);
}

# ------------------
sub txtfile {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $filename = shift || return error ('No TxtFile to diplay!' );

    my $u = main::getModule('USER');
    my $user = ($u->{active} eq 'y' ? $obj->{USER}->{Name} : "nobody");

    my $txtfile = sprintf('%s/%s.txt', $obj->{paths}->{HTMLDIR}, $filename);
    my $htmlfile = sprintf('%s/xxv_txt.html', $u->userTmp($user));

    $obj->{txt2html}->txt2html(infile=>[$txtfile],
                     outfile=>$htmlfile,
                     title=> $filename,
                     mail=>1,
    );
    my $html = `cat $htmlfile`;
    $html = $1 if($html =~ /\<body.*?\>(.+?)\<\/body\>/si);
    $obj->message($html, {tags => {first => "<h1>File: $filename.txt</h1>"}});
}

# ------------------
sub login {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $message = shift || '';

    $obj->{nopack} = 1;

    unless(defined $obj->{header}) {
        # HTTP Header
        $obj->{handle}->print(
            $obj->headerNoAuth()
        );
    }
    my $data = $obj->{cgi}->start_html(gettext("ERROR"));
    $data .= $obj->{cgi}->h2(gettext("ERROR"));
    $data .= $obj->{cgi}->strong($message);
    $data .= $obj->{cgi}->end_html;
    $data .= "\r\n";
    $obj->{handle}->print( $data );
}


# ------------------
sub typ {
# ------------------
    my $obj = shift || return error ('No Object!' );
    return $obj->{TYP};
}

# ------------------
sub setCall {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $name = shift || return error ('No Name!' );

    $obj->{call} = $name;
    return $obj->{call};
}

# ------------------
sub browser {
# ------------------
    my $obj = shift || return error ('No Object!' );
    return $obj->{browser};
}

# Special Version from Message (with error handling)
# ------------------
sub msg {
# ------------------
    my $obj = shift  || return error ('No Object!' );
    my $data = shift || 0;
    my $err = shift  || 0;

    unless($err) {
        $obj->message($data);
    } else {
        $obj->err($data || $err);
        return undef;
    }
}


1;
