* Move files to trunk

11 files changed, 3587 insertions, 0 deletions

diff --git a/lib/XXV/OUTPUT/Ajax.pm b/lib/XXV/OUTPUT/Ajax.pm
new file mode 100644
index 0000000..0151b5f
--- /dev/null
+++ b/lib/XXV/OUTPUT/Ajax.pm
@@ -0,0 +1,231 @@
+package XXV::OUTPUT::Ajax;
+
+use strict;
+
+#use Template;
+use vars qw($AUTOLOAD);
+use Locale::gettext;
+use Tools;
+
+$SIG{CHLD} = 'IGNORE';
+
+# This module method must exist for XXV
+# ------------------
+sub module {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $args = {
+        Name => 'Ajax',
+        Prereq => {
+            'XML::Simple' => 'Easy API to maintain XML (esp config files)',
+            'JSON' => 'Parse and convert to JSON (JavaScript Object Notation)',
+        },
+        Description => gettext('This receive and send Ajax messages.'),
+        Version => '0.01',
+        Date => '27.10.2004',
+        Author => 'xpix',
+    };
+    return $args;
+}
+
+# ------------------
+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');
+
+    $obj->{nopack} = 1;
+    $obj->out( $data, $params, $name );
+
+    $obj->{call} = '';
+}
+
+# ------------------
+sub new {
+# ------------------
+	my($class, %attr) = @_;
+	my $self = {};
+	bless($self, $class);
+
+	# who am I
+    $self->{MOD} = $self->module;
+
+    # Try to use the Requirments
+    map {
+        eval "use $_";
+        return panic("\nCan not load Module: $_\nPlease install this module on your System:\nperl -MCPAN -e 'install $_'") if($@);
+    } keys %{$self->{MOD}->{Prereq}};
+
+    $self->{handle} = $attr{'-handle'}
+        || return error('No handle defined!');
+
+    $self->{cgi} = $attr{'-cgi'}
+        || return error('No TemplateDir given!');
+
+    $self->{browser} = $attr{'-browser'}
+        || return error('No Mimehash given!');
+
+    $self->{xml} = XML::Simple->new()
+        || return error('XML failed!');
+
+    $self->{outtype} = $attr{'-output'}
+        || return error('No output type given!');
+
+		$self->{types} = {
+			'xml' => 'application/xml',
+			'json' => 'text/html',
+			'html' => 'text/html',
+			'javascript' => 'text/javascript',
+		};
+
+		# New JSON Object if required
+		if($self->{outtype} eq 'json') {
+			$self->{json} = JSON->new()
+				unless(ref $self->{json});
+		}	
+
+    $self->{TYP} = 'AJAX';
+
+    $self->{CMDSTAT} = undef;
+
+	return $self;
+}
+
+# ------------------
+sub out {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || 0;
+    my $para = shift || 0;
+    my $name = shift || 'noName';
+    my $type = shift || $obj->{types}->{$obj->{outtype}} || 'text/plain';
+    my %args = @_;
+
+    $obj->{nopack} = 1;
+    unless(defined $obj->{header}) {
+        # HTTP Header
+        $obj->{output_header} = $obj->header($type, \%args);
+    }
+
+    $obj->{sendbytes}+= length($data);
+	
+		if($obj->{outtype} eq 'json') {
+	    $obj->{output}->{data} = $data;
+		} else {
+	    $obj->{output}->{DATA} = $data;
+	    $obj->{output}->{$name}->{data} = $data;
+	    $obj->{output}->{$name}->{params} = $para
+	        if($para);
+		}
+}
+
+# ------------------
+sub printout {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $nopack = shift || $obj->{nopack} || 0;
+
+
+    my $content .= ($obj->{outtype} eq 'xml' 
+    								? $obj->{xml}->XMLout($obj->{output}) 
+    								: 
+    									( $obj->{outtype} eq 'json' 
+	    									? $obj->{json}->objToJson ($obj->{output}, {pretty => 1, indent => 2})
+	    									: $obj->{output}->{DATA})
+									);
+		# Kompress
+    $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) );
+
+    $arg->{'Cache-Control'} = 'no-cache, must-revalidate' if(!defined $arg->{'Cache-Control'});
+    $arg->{'Pragma'} = 'no-cache' if(!defined $arg->{'Pragma'});
+
+    $obj->{header} = 200;
+    return $obj->{cgi}->header(
+        -type   =>  $typ,
+        -status  => "200 OK",
+        -expires => "now",
+        %{$arg},
+    );
+}
+
+# ------------------
+sub headerNoAuth {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $typ = shift || 'text/html';
+
+    $obj->{header} = 401;
+    return $obj->{cgi}->header(
+        -type    => $typ,
+        -status  => "401 Authorization Required\nWWW-Authenticate: Basic realm=\"xxvd\""
+    );
+}
+
+# ------------------
+sub msg {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || 0;
+    my $err  = shift || 0;
+
+
+    my $msg;
+    if(! $err and $data) {
+        $msg = $data;
+    } else {
+        $msg = sprintf('ERROR:%s (%s)', $data);
+    }
+
+    $obj->out( $msg, 0, 'msg' );
+
+    $obj->{call} = '';
+}
+
+# ------------------
+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};
+}
+
+1;
diff --git a/lib/XXV/OUTPUT/Console.pm b/lib/XXV/OUTPUT/Console.pm
new file mode 100644
index 0000000..b1b6d80
--- /dev/null
+++ b/lib/XXV/OUTPUT/Console.pm
@@ -0,0 +1,741 @@
+package XXV::OUTPUT::Console;
+
+BEGIN{
+    $ENV{PERL_RL} = 'Perl'
+};
+
+use Locale::gettext;
+use Term::ReadLine;
+
+use strict;
+
+use Tools;
+use Pod::Text;
+use vars qw($AUTOLOAD);
+
+# This module method must exist for XXV
+# ------------------
+sub module {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $args = {
+        Name => 'Telnet',
+        Prereq => {
+            'XML::Simple' => 'Easy API to maintain XML (esp config files)',
+            'Text::ASCIITable' => 'Create a nice formatted table using ASCII characters.',
+            'Term::ReadLine::Perl' => 'a quick implementation of the minimal interface to Readline',
+        },
+        Description => gettext('This receive and send ASCII messages'),
+        Version => '0.01',
+        Date => '27.10.2004',
+        Author => 'xpix',
+    };
+    return $args;
+}
+
+# ------------------
+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');
+
+    $obj->message(gettext("Sorry, but this command is not available in this Interface!"));
+}
+
+# ------------------
+sub new {
+# ------------------
+	my($class, %attr) = @_;
+	my $self = {};
+	bless($self, $class);
+
+	# who am I
+    $self->{MOD} = $self->module;
+
+    # Try to use the Requirments
+    map {
+        eval "use $_";
+        return panic("\nCan not load Module: $_\nPlease install this module on your System:\nperl -MCPAN -e 'install $_'") if($@);
+    } keys %{$self->{MOD}->{Prereq}};
+
+    $self->{handle} = $attr{'-handle'}
+        || return error('No handle defined!');
+
+    $self->{dbh} = $attr{'-dbh'}
+        || return error('No DBH defined!');
+
+    $self->{paths} = $attr{'-paths'}
+        || return error('No Paths given!');
+
+    $self->{term} = Term::ReadLine->new('xxv', $self->{handle}, $self->{handle})
+        || return error('No Term given!');
+
+    $self->{TYP} = 'CONSOLE';
+
+    $self->{maxwidth} = 20;
+
+    $self->{TableDefaults} = {
+        allowANSI   => 1,
+        allowHTML   => 1,
+        drawRowLine => 1,
+        reportErrors=> 1,
+        cb_count    => sub{ $self->_myallowansi_cb(@_) },
+    };
+
+	return $self;
+}
+
+# ------------------
+sub printout {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $data = shift || return error ('No Data to display');
+
+    $data =~ s/[^\r]\n/\r\n/sig;
+
+    my $h = $obj->{handle};
+    print $h $data."\r\n";
+}
+
+# ------------------
+sub message {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data to display');
+
+    my $t = Text::ASCIITable->new();
+    $t->setOptions( $obj->{TableDefaults} );
+
+    $t->setCols(gettext('Message'));
+    if(ref $data eq 'ARRAY') {
+        map { $t->addRow($_) } @$data;
+    } else {
+        $t->addRow($data);
+    }
+    $obj->printout($t->draw());
+}
+
+# ------------------
+sub push {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data to display');
+
+    $obj->printout($data);
+}
+# ------------------
+sub msg {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $data = shift || return error ('No Data to display');
+    my $err = shift || return $obj->message($data);
+
+    $obj->err($data) if($err);
+}
+
+# ------------------
+sub err {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data to display');
+
+    my $t = Text::ASCIITable->new;
+    $t->setOptions( $obj->{TableDefaults} );
+
+    $t->setCols(gettext('ERROR'));
+    if(ref $data eq 'ARRAY') {
+        map { $t->addRow($_) } @$data;
+    } else {
+        $t->addRow($data);
+    }
+    $obj->printout($t->draw());
+}
+
+# ------------------
+sub menu {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data to display');
+
+    my $t = Text::ASCIITable->new;
+    $t->setOptions( $obj->{TableDefaults} );
+    $t->setCols(gettext('Module'),
+                gettext('Short cut'),
+                gettext('Name'),
+                gettext('Description'));
+
+    foreach my $line (@$data) {
+        if(ref $line eq 'ARRAY') {
+            $t->addRow(@$line);
+        } else {
+            $obj->printout($line);
+        }
+    }
+
+    $obj->printout($t->draw());
+}
+
+# ------------------
+sub littlemenu {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data to display');
+
+    my $text = $data->{title}."\n";
+    $text .= gettext("Please use command and one of the following sectors:\n");
+    $text .= join(', ', sort keys %{$data->{links}});
+
+    $obj->message($text);
+}
+
+# ------------------
+sub login {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data to display');
+
+    my $questions = [
+        'Name' => {
+            typ     => 'string',
+            msg     => gettext("Username?"),
+        },
+        'Password' => {
+            typ     => 'string',
+            msg     => gettext("Password?"),
+        },
+    ];
+
+    my $answer = $obj->question($data."\r\n", $questions);
+    return $answer;
+}
+
+
+# ------------------
+sub table {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data to display');
+    my $param = shift || {};
+    my $noPrint = shift || 0;
+
+    my $out = '';
+    my $UserMaxWidth = (delete $param->{maxwidth} || $obj->{maxwidth});
+
+    my $fields = (ref $data eq 'ARRAY') ?
+            shift @$data :
+        [
+            gettext('Name'),
+            gettext('Value')
+        ];
+
+    my $t = Text::ASCIITable->new;
+    $t->setOptions( $obj->{TableDefaults} );
+    $t->setOptions($param) if($param);
+
+    my ($displayFields, $displayData) = $obj->_parseData($fields, $data);
+    $t->setCols(@$displayFields);
+    map { $t->setColWidth($_, $UserMaxWidth) } @$displayFields;
+
+    if(ref $displayData eq 'ARRAY') {
+        foreach my $line (@$displayData) {
+            if(ref $line eq 'ARRAY') {
+                $t->addRow(@$line);
+            } else {
+                $out .= $line;
+            }
+        }
+    } else {
+        foreach my $name (sort keys %$data) {
+            my $dspl = '';
+            if(ref $data->{$name} eq 'HASH') {
+                foreach (sort keys %{$data->{$name}}) {
+                    if(ref $data->{$name}->{$_}) {
+                        $dspl .= $obj->table($data->{$name}->{$_}, $param, 'noPrint');
+                    } else {
+                        $dspl .= sprintf("%s: %s\n", $_, $data->{$name}->{$_});
+                    }
+                }
+            } else {
+                $dspl = $data->{$name};
+            }
+            $t->addRow($name, $dspl);
+        }
+    }
+
+    $out .= $t->draw();
+
+    unless($noPrint) {
+        $obj->printout($out);
+    } else {
+        return $out;
+    }
+}
+
+# ------------------
+sub question {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $title = shift || 0;
+    my $questions = shift || return error ('No Data!' );
+    my $erg = shift || {};
+
+    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}));
+            }
+
+            if($error) {
+                $obj->err(sprintf(gettext("Error at field '%s' (%s) : %s"), $data->{msg}, $name, $error));
+                last;
+            }
+        }
+        unless($error) {
+            delete $erg->{action};
+            return $erg;
+        }
+    }
+
+    $obj->printout("$title\n") if($title);
+    if(ref $questions eq 'ARRAY') {
+        while (my ($name, $data) = splice(@$questions, 0, 2)) {
+            my $type = delete $data->{typ};
+            $type ||= 'string';
+            $erg->{$name} = $obj->$type($data);
+        }
+    } else {
+        my $type = delete $questions->{typ};
+        $type ||= 'string';
+        $erg = $obj->$type($questions);
+    }
+    return $erg;
+}
+
+# ------------------
+sub list {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data!' );
+    my $t = $obj->{term};
+    my $error;
+    my $def;
+
+    if(defined $data->{def}) {
+    if(ref $data->{def} eq 'CODE') {
+	$def = $data->{def}();
+    } elsif(ref $data->{def} eq 'ARRAY') {
+	$def = join(', ', @{$data->{def}});
+    } else {
+	$def = $data->{def};
+    }}
+
+    my $message = (defined $def) ? sprintf('%s [%s]: ', $data->{msg}, $def) : $data->{msg}.': ';
+
+    while (defined (my $answer = $t->readline($message))) {
+        $answer =~ s/[\r|\n]//sig;
+
+        # Default value ...
+        $answer = $data->{def}
+            if(defined $data->{def} and not $answer);
+
+        # List ...
+        $error = sprintf(gettext("\nPlease use one of this list items:\n %s"), join(",\n", @{$data->{choices}}))
+            unless(grep($_ eq $answer, @{$data->{choices}}));
+
+        # Required value ...
+        $error = $data->{req}
+            if($data->{req} and not $answer);
+
+        # Check Callback ...
+        ($answer, $error) = $data->{check}($answer)
+            if(defined $data->{check} and ref $data->{check} eq 'CODE');
+
+        # Display Error Message ....
+        if($error) {
+            $message = (defined $data->{def}) ? sprintf('%s [%s]', $error, $def) : $error.': ';
+            undef $error;
+        } else {
+            return $answer;
+        }
+    }
+}
+
+
+# ------------------
+sub string {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data!' );
+    my $t = $obj->{term};
+    my $error;
+
+    my $def;
+    if(defined $data->{def}) {
+    if(ref $data->{def} eq 'CODE') {
+	$def = $data->{def}();
+    } else {
+	$def = $data->{def};
+    }}
+
+    my $message = (defined $def) ? sprintf('%s [%s]: ', $data->{msg}, $def) : $data->{msg}.': ';
+    while (defined (my $answer = $t->readline($message))) {
+        $answer =~ s/[\r|\n]//sig;
+        # Default value ...
+        $answer = $def
+            if($def and not $answer);
+
+        # Required value ...
+        $error = $data->{req}
+            if($data->{req} and not $answer);
+
+        # Check Callback ...
+        ($answer, $error) = $data->{check}($answer)
+            if(defined $data->{check} and ref $data->{check} eq 'CODE');
+
+        # Display Error Message ....
+        if($error) {
+            $message = ($def) ? sprintf('%s [%s]', $error, $def) : $error.': ';
+            undef $error;
+        } else {
+            return $answer;
+        }
+    }
+}
+
+# ------------------
+sub file {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    return $obj->string(@_);
+}
+
+# ------------------
+sub dir {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    return $obj->string(@_);
+}
+
+# ------------------
+sub password {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    return $obj->string(@_);
+}
+
+# ------------------
+sub date {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    return $obj->string(@_);
+}
+
+# ------------------
+sub integer {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data!' );
+    my $t = $obj->{term};
+    my $error;
+
+    my $message = (defined $data->{def} ) ? sprintf('%s [%s]: ', $data->{msg}, $data->{def}) : $data->{msg}.': ';
+    while (defined (my $answer = $t->readline($message))) {
+        $answer =~ s/[\r|\n]//sig;
+
+        # Default value ...
+        $answer = $data->{def}
+            if($data->{def} and ! $answer);
+
+        # Interger?
+        $error = sprintf(gettext("'%s' is not an integer!"),$answer)
+            if($answer and not int($answer));
+
+        # Required?
+        $error = $data->{req}
+            if(defined $data->{req} and not $answer);
+
+        # Check Callback
+        ($answer, $error) = $data->{check}($answer)
+            if(defined $data->{check} and ref $data->{check} eq 'CODE');
+
+        if($error) {
+            $message = (defined $data->{def}) ? sprintf('%s [%s]', $error, $data->{def}) : $error.': ';
+            undef $error;
+        } else {
+            return $answer;
+        }
+    }
+}
+
+# ------------------
+sub confirm {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data!' );
+    my $t = $obj->{term};
+    my $error;
+
+    my $message = (defined $data->{def} ) ? sprintf('%s [%s]: ', $data->{msg}, $data->{def}) : $data->{msg}.': ';
+    while (defined (my $answer = $t->readline($message))) {
+        $answer =~ s/[\r|\n]//sig;
+
+        # Default value ...
+        $answer = $data->{def}
+            if($data->{def} and ! $answer);
+
+        # Only yes or no ...
+        $error = gettext("Please answer with 'y'es or 'n'o: ")
+            if($answer !~ /^[y|n]$/);
+
+        # Required value ...
+        $error = $data->{req}
+            if($data->{req} and not $answer);
+
+        # Check Callback ...
+        ($answer, $error) = $data->{check}($answer)
+            if(defined $data->{check} and ref $data->{check} eq 'CODE');
+
+        # Display Error Message ....
+        if($error) {
+            $message = (defined $data->{def}) ? sprintf('%s [%s]', $error, $data->{def}) : $error.': ';
+            undef $error;
+        } else {
+            return $answer;
+        }
+    }
+}
+
+# ------------------
+sub hidden {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data!' );
+
+    return error('No <def> in hidden Variable!')
+        unless(defined $data->{def});
+    return $data->{def};
+}
+
+# ------------------
+sub image {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data to display');
+
+    return $obj->message(gettext("Sorry, but i cannot display an image on this Interface."));
+}
+
+# ------------------
+sub checkbox {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data!' );
+    my $t = $obj->{term};
+    my $error;
+
+    my $message = (defined $data->{def}) ? sprintf('%s [%s]: ', $data->{msg}, join(', ', @{$data->{def}})) : $data->{msg}.': ';
+    while (defined (my $answer = $t->readline($message))) {
+        $answer =~ s/[\r|\n]//sig;
+        # Default value ...
+        $answer = $data->{def}
+            if(defined $data->{def} and not $answer);
+
+        # Required value ...
+        $error = $data->{req}
+            if($data->{req} and not $answer);
+
+        # Check Callback ...
+        ($answer, $error) = $data->{check}($answer, $data)
+            if(defined $data->{check} and ref $data->{check} eq 'CODE');
+
+        # Display Error Message ....
+        if($error) {
+            $message = (defined $data->{def}) ? sprintf('%s [%s]', $error, join(', ', @{$data->{def}})) : $error.': ';
+            undef $error;
+        } else {
+            return $answer;
+        }
+    }
+}
+
+# ------------------
+sub radio {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $data = shift || return error ('No Data!' );
+    my $t = $obj->{term};
+    my $error;
+
+    my $message = (defined $data->{def}) ? sprintf('%s [%s]: ', $data->{msg}, $data->{def}) : $data->{msg}.': ';
+    while (defined (my $answer = $t->readline($message))) {
+        $answer =~ s/[\r|\n]//sig;
+        # Default value ...
+        $answer = $data->{def}
+            if(defined $data->{def} and not $answer);
+
+        # Required value ...
+        $error = $data->{req}
+            if($data->{req} and not $answer);
+
+        # only one of all ...
+        $error = sprintf(gettext("You can only use one of this items: %s"), join(',', @{$data->{choices}}))
+            unless(grep( $answer eq $_, @{$data->{choices}}));
+
+
+        # Check Callback ...
+        ($answer, $error) = $data->{check}($answer, $data)
+            if(defined $data->{check} and ref $data->{check} eq 'CODE');
+
+        # Display Error Message ....
+        if($error) {
+            $message = (defined $data->{def}) ? sprintf('%s [%s]', $error, $data->{def}) : $error.': ';
+            undef $error;
+        } else {
+            return $answer;
+        }
+    }
+}
+
+# ------------------
+sub pod {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $modname = uc(shift) || return error ('No Modname!' );
+    $modname = ucfirst($modname) if($modname eq 'GENERAL');
+
+    my $podfile = sprintf('%s/%s.pod', $obj->{paths}->{PODPATH}, $modname);
+    return $obj->err(gettext('Module %s not found!'), $modname)
+        unless(-r $podfile);
+    my $tmpdir = main::getModule('USER')->userTmp;
+    my $outfile = sprintf('%s/%s_%d.pod', $tmpdir, $modname, time);
+
+    my $parser = Pod::Text->new (sentence => 0, width => 78);
+
+    # Read POD from file.pod and write to file.txt.
+    $parser->parse_from_file (
+        $podfile,
+        $outfile
+    );
+    return error('Problem to convert pod2txt')
+        unless(-r $outfile);
+    my $txt = load_file($outfile);
+
+    $obj->message($txt);
+}
+
+# ------------------
+sub txtfile {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $filename = shift || return error ('No TxtFile to diplay!' );
+    my $param = shift || {};
+
+    my $txtfile = sprintf('%s/%s.txt', $obj->{paths}->{DOCPATH}, $filename);
+    my $gzfile  = sprintf('%s/%s.txt.gz', $obj->{paths}->{DOCPATH}, $filename);
+
+    $txtfile = main::getModule('HTTPD')->unzip($gzfile)
+        if(! -r $txtfile and -e $gzfile and -r $gzfile);
+
+    my $txt = load_file($txtfile);
+    return $obj->message($txt, {tags => {first => "File: $filename.txt"}});
+}
+
+# ------------------
+sub remote {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+
+    my $text = qq!
+.-----------------------.
+| 1     | 2     | 3     |
+|-----------------------|
+| 4     | 5     | 6     |
+|-----------------------|
+| 7     | 8     | 9     |
+|-----------------------|
+| Menu  | 0     | Back  |
+|-----------------------|
+|       | Up    |       |
+|-----------------------|
+| Left  | Ok    | Right |
+|-----------------------|
+|       | Down  | Blue  |
+|-----------------------|
+| Red   | Green | Yellow|
+|-----------------------|
+| Vol:+/-   | Chan: <>  |
+|-----------------------|
+| <<        | >>        |
+|-----------------------|
+!;
+    $obj->printout($text);
+}
+
+# ------------------
+sub _myallowansi_cb {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    $_      = shift;
+    s/\33\[(\d+(;\d+)?)?[musfwhojBCDHRJK]//g;
+    return length($_);
+}
+
+# ------------------
+sub _parseData {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $fields  = shift || return error ('No Fields!' );
+    my $data    = shift || return error ('No Data!' );
+
+    my $displayFields = [];
+    @$displayFields = grep(!/^__/, @$fields);
+
+    if(ref $data eq 'ARRAY') {
+        foreach my $d (@$data) {
+            my $c = -1; my @newData;
+            foreach my $r (@$d) {
+                $c++;
+                CORE::push(@newData, $r)
+                    if($fields->[$c] !~ /^__/);
+            }
+            @$d = @newData;
+        }
+        return ($displayFields, $data);
+    } else {
+        return ($fields, $data);
+    }
+}
+
+
+# ------------------
+sub typ {
+# ------------------
+    my $obj = shift || return error ('No Object!');
+    return $obj->{TYP};
+}
+
+1;
diff --git a/lib/XXV/OUTPUT/Dump.pm b/lib/XXV/OUTPUT/Dump.pm
new file mode 100644
index 0000000..02ea847
--- /dev/null
+++ b/lib/XXV/OUTPUT/Dump.pm
@@ -0,0 +1,62 @@
+package XXV::OUTPUT::Dump;
+
+use strict;
+
+use vars qw($AUTOLOAD);
+use Tools;
+
+# This module method must exist for XXV
+# ------------------
+sub module {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $args = {
+        Name => 'Dump',
+        Prereq => {
+        },
+        Description => gettext('This receive and send Dump messages.'),
+        Version => '0.01',
+        Date => '27.10.2004',
+        Author => 'xpix',
+    };
+    return $args;
+}
+# ------------------
+sub AUTOLOAD {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+
+    return if($AUTOLOAD =~ /DESTROY$/);
+dumper(\@_);
+    return @_;
+}
+
+# ------------------
+sub new {
+# ------------------
+	my($class, %attr) = @_;
+	my $self = {};
+	bless($self, $class);
+
+	# who am I
+    $self->{MOD} = $self->module;
+
+    # Try to use the Requirments
+    map {
+        eval "use $_";
+        return panic("\nCan not load Module: $_\nPlease install this module on your System:\nperl -MCPAN -e 'install $_'") if($@);
+    } keys %{$self->{MOD}->{Prereq}};
+
+    $self->{TYP} = 'INTERFACE';
+
+	return $self;
+}
+
+# ------------------
+sub typ {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    return $obj->{TYP};
+}
+
+1;
diff --git a/lib/XXV/OUTPUT/HTML/PUSH.pm b/lib/XXV/OUTPUT/HTML/PUSH.pm
new file mode 100644
index 0000000..7c7d7df
--- /dev/null
+++ b/lib/XXV/OUTPUT/HTML/PUSH.pm
@@ -0,0 +1,95 @@
+package XXV::OUTPUT::HTML::PUSH;
+
+use strict;
+
+use Tools;
+
+$| = 1;
+
+=head1 NAME
+
+XXV::OUTPUT::HTML::PUSH - A Push for http system
+
+=head1 SYNOPSIS
+
+    use XXV::OUTPUT::HTML::PUSH;
+
+    my $pusher =  XXV::OUTPUT::HTML::PUSH->new(
+        -cgi => $obj->{cgi},        # The CGI Object from Lincoln Stein
+        -handle => $obj->{handle},  # The handle to printout the http Stuff
+    );
+
+    $pusher->start();       # Start the Push Process
+
+    while($c > 10) {
+        $pusher->print($c++);  # Print out the message
+    }
+
+    $pusher->stop();        # Stop the Push
+
+
+=cut
+
+# ------------------
+sub new {
+# ------------------
+	my($class, %attr) = @_;
+	my $self = {};
+	bless($self, $class);
+
+    $self->{handle} = $attr{'-handle'}
+        || return error('No handle defined!');
+
+    $self->{cgi} = $attr{'-cgi'}
+        || return error('No CGI Object defined!');
+
+	return $self;
+}
+
+# ------------------
+sub start {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $out = shift ||  0;
+    $obj->{handle}->print($obj->{cgi}->multipart_init(-boundary=>'----here we go!'));
+    $obj->print($out) if($out);
+}
+
+# ------------------
+sub print {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $msg = shift  || return;
+    my $type = shift || 'text/html';
+
+    $obj->{handle}->print($obj->{cgi}->multipart_start(-type=>$type));
+    $obj->{handle}->print($msg."\n");
+    $obj->{handle}->print($obj->{cgi}->multipart_end);
+}
+
+# ------------------
+sub follow_print {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $msg = shift  || return;
+    my $type = shift || 'text/html';
+
+    unless($obj->{header}) {
+        $obj->{handle}->print($obj->{cgi}->multipart_start(-type=>$type));
+        $obj->{header} = 1;
+    }
+    $obj->{handle}->print($msg."\n");
+}
+
+# ------------------
+sub stop {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    $obj->{handle}->print($obj->{cgi}->multipart_end);
+    $obj->{handle}->print($obj->{cgi}->header(
+        -type   =>  'text/html',
+        -status  => "200 OK",
+    ));
+}
+
+1;
diff --git a/lib/XXV/OUTPUT/HTML/WAIT.pm b/lib/XXV/OUTPUT/HTML/WAIT.pm
new file mode 100644
index 0000000..8ebd430
--- /dev/null
+++ b/lib/XXV/OUTPUT/HTML/WAIT.pm
@@ -0,0 +1,169 @@
+package XXV::OUTPUT::HTML::WAIT;
+
+use strict;
+
+use Tools;
+use XXV::OUTPUT::HTML::PUSH;
+
+=head1 NAME
+
+XXV::OUTPUT::HTML::WAIT - A Processbar for XXV system
+
+=head1 SYNOPSIS
+
+    use XXV::OUTPUT::HTML::WAIT;
+
+    my $waiter =  XXV::OUTPUT::HTML::WAIT->new(
+        -cgi => $obj->{cgi},        # The CGI Object from Lincoln Stein
+        -handle => $obj->{handle},  # The handle to printout the http Stuff
+        -callback => sub{           # Callback for html output.
+                                    # In this case parse the html template wait.tmpl
+            my ($min, $max, $cur, $steps) = @_;
+            my $out = $obj->parseTemplate(
+                'wait',
+                {
+                    msg     => $msg,
+                    minimum => $min,
+                    current => $cur,
+                    maximum => $max,
+                    steps   => $steps
+                },
+            );
+            return $out;
+        },
+    );
+
+    $waiter->min(0);        # Min Value for process Bar
+    $waiter->max(10);       # Max Value for process Bar
+    $waiter->screen('yes'); # Every call of next will redraw the process bar
+
+    while($c > 10) {
+        $waiter->next($c++);  # Next Event with current value
+    }
+    $waiter->end;
+
+=cut
+
+# ------------------
+sub new {
+# ------------------
+	my($class, %attr) = @_;
+	my $self = {};
+	bless($self, $class);
+
+    $self->{handle} = $attr{'-handle'}
+        || return error('No handle defined!');
+
+    $self->{cgi} = $attr{'-cgi'}
+        || return error('No CGI Object defined!');
+
+    $self->{callback} = $attr{'-callback'}
+        || return error('No Callback to print out!');
+
+    $self->{steps} = $attr{'-steps'} || 10;
+
+    $self->{pusher} =  XXV::OUTPUT::HTML::PUSH->new(
+        -cgi => $self->{cgi},        # The CGI Object from Lincoln Stein
+        -handle => $self->{handle},  # The handle to printout the http Stuff
+    );
+
+    $self->init();
+
+	return $self;
+}
+
+# ------------------
+sub init {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+
+    $obj->{STEP} = 0;
+    $obj->{pusher}->start();
+    undef $obj->{FirstRefresh};
+}
+
+# ------------------
+sub next {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $cur = shift  || $obj->{MAX};
+    my $end = shift  || 0;
+    my $msg = shift  || 0;
+
+
+    # Don't show really every step, even is screen defined,
+    # avoid high traffic and long duration of waiter progress
+    my $t = time;
+    return
+        if(defined $obj->{SCREEN} && $obj->{SCREEN} eq 'no'
+            && $end == 0 
+            && $obj->{LastRefreshTime} && $obj->{LastRefreshTime} > ($t - 1));
+
+    # remember time from from first call
+    $obj->{FirstRefresh} = $t 
+      if(not $obj->{FirstRefresh});
+
+    # calc end time of execution
+    my $rest = $end ? 0 : $obj->{MAX} - $cur;
+    my $deltaT = $t - $obj->{FirstRefresh};
+    my $etaT = ($cur > 0) ? ($deltaT / $cur * $rest) : 0;
+    # Format end time of execution from seconds to human readable format
+    my $eta = sprintf("%02d:%02d:%02d",$etaT / 3600 % 24 ,($etaT / 60) % 60, $etaT % 60 );
+
+    $obj->{LastRefreshTime} = $t;
+
+
+    # 2.2 = 22 / 10
+    my $step = $obj->{MAX} / $obj->{steps};
+    $obj->{STEP} += $step;
+
+    if ($end or $cur > $obj->{MAX}) {
+        $obj->{pusher}->stop();
+        my $out = $obj->{endcallback}($obj->{MIN}, $obj->{MAX}, $cur, $obj->{steps}, $msg, $eta)
+            if(ref $obj->{endcallback} eq 'CODE');
+    } else {
+        my $out = $obj->{callback}($obj->{MIN}, $obj->{MAX}, $cur, $obj->{steps}, $msg, $eta);
+        $obj->{pusher}->print($out);
+    }
+}
+
+# ------------------
+sub end {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $msg = shift  || 0;
+
+    return $obj->next(undef, $obj->{MAX}, 1, $msg);
+}
+
+
+# ------------------
+sub endcallback {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    $obj->{endcallback} = shift || return $obj->{endcallback};
+}
+
+# ------------------
+sub max {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    $obj->{MAX} = shift || return $obj->{MAX};
+}
+
+# ------------------
+sub min {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    $obj->{MIN} = shift || return $obj->{MIN};
+}
+
+# ------------------
+sub screen {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    $obj->{SCREEN} = shift || return $obj->{SCREEN};
+}
+
+
+1;
diff --git a/lib/XXV/OUTPUT/Html.pm b/lib/XXV/OUTPUT/Html.pm
new file mode 100644
index 0000000..72251ba
--- /dev/null
+++ b/lib/XXV/OUTPUT/Html.pm
@@ -0,0 +1,851 @@
+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 File::Basename;
+use Pod::Html;
+use Fcntl;
+#use Thread;
+
+$SIG{CHLD} = 'IGNORE';
+
+# This module method must exist for XXV
+# ------------------
+sub module {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $args = {
+        Name => 'Html',
+        Prereq => {
+            'HTML::TextToHTML' => 'convert plain text file to HTML. ',
+        },
+        Description => gettext('This receive and send HTML messages.'),
+        Version => '0.92',
+        Date => '2007-01-21',
+        Author => 'xpix',
+    };
+    return $args;
+}
+
+# ------------------
+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);
+
+	# who am I
+    $self->{MOD} = $self->module;
+
+    # Try to use the Requirments
+    map {
+        eval "use $_";
+        return panic("\nCan not load Module: $_\nPlease install this module on your System:\nperl -MCPAN -e 'install $_'") if($@);
+    } keys %{$self->{MOD}->{Prereq}};
+
+    $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->{htmdef} = $attr{'-htmdef'}
+        || return error('No htmdef 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->{debug} = $attr{'-debug'}
+        || 0;
+
+    $self->{TYP} = 'HTML';
+
+    # Forward name of Server for CGI::server_software
+    $ENV{'SERVER_SOFTWARE'} = sprintf("xxvd %s",main::getVersion());
+    $ENV{'SERVER_PROTOCOL'} = 'HTTP/1.1';
+
+    # create Template object
+    $self->{tt} = Template->new(
+      START_TAG    => '\<\?\%',		    # Tagstyle
+      END_TAG      => '\%\?\>',		    # Tagstyle
+      INCLUDE_PATH => [$self->{htmdir},$self->{htmdef}] ,  # 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,
+    );
+
+    &bench('CLEAR');
+
+	return $self;
+}
+
+# ------------------
+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);
+    }
+    $output .= $obj->parseTemplateFile($name, $data, $params,((exists $obj->{call}) ? $obj->{call} : 'nothing'));
+    return $output;
+}
+
+# ------------------
+sub index {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    $obj->{nopack} = 1;
+    $obj->{call} = 'index';
+    my $params = {};
+    $params->{start} = $obj->{start};
+    $obj->out( $obj->parseTemplateFile("index", {}, $params, $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';
+
+    $obj->parseData($data)
+        if($name ne 'start' && $name ne 'footer'  
+        && !$obj->{dontparsedData} );
+
+    my $t = $obj->{tt};
+    my $u = main::getModule('USER');
+
+    # you can use two templates, first is a user defined template
+    # and second the standard template
+    # i.e. call the htmlhelp command the htmlhelp.tmpl
+    # SpecialTemplate:  ./htmlRoot/usage.tmpl
+    # StandardTemplate: ./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} ? $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   => $obj->{debug},
+        user    => $user,
+        # query the current locale
+        locale  => main::getGeneralConfig->{Language},
+        allow   => sub{
+            my($cmdobj, $cmdname, $se, $err) = $u->checkCommand($obj, $_[0],"1");
+            return $cmdobj;
+        },
+
+        # Deaktiviert da durch parseData alle Daten
+        # komplett mit entities behandelt wurden
+        entities => sub{ return $_[0] },
+
+        # Remove entities from parameters
+        reentities => sub{ return reentities($_[0]) },
+
+        # Escape strings for javascript
+        escape => sub{ 
+              my $s = shift; # string
+              $s =~ s/\r//g;
+              $s =~ s/\n//g;
+              $s =~ s/&quot;/\\&quot;/g;
+              $s =~ s/\'/\\\'/g;
+              return $s;
+        },
+
+        # truncate string with entities
+        chop => sub{
+        	my $s = shift; # string
+        	my $c = shift; # count
+        	my $l = shift || 0; # lines
+
+        	if ( $c > 3 ) {
+            $s = reentities($s);
+            if($l)
+            {
+                my @text = split ('\r\n', $s);
+                if(scalar @text > 1)
+                {
+                  my @lines;
+                  foreach my $line (@text)
+                  {
+                    if ( length( $line ) > $c ) {
+                			$line = substr( $line, 0, ( $c - 3 ) ) . '...';
+                		}
+                    --$l;
+                    last if($l < 0);
+                    push(@lines,$line);
+                  }
+                  $s = join("\r\n",@lines);
+                } else {
+                    if ( length( $s ) > ($c * $l) ) {
+                			$s = substr( $s, 0, ( ($c * $l) - 3 ) ) . '...';
+                		}
+                }
+            } 
+            elsif ( length( $s ) > $c ) {
+        			$s = substr( $s, 0, ( $c - 3 ) ) . '...';
+        		}
+          	return entities($s);
+        	} else {
+          	return $s ? '...' : '';
+          }
+        },
+        url     => sub{
+            	my $s = shift; # string
+              $s = reentities($s);
+              $s  =~ s/([^a-z0-9A-Z])/sprintf('%%%X', ord($1))/seg;
+              return $s;
+        },
+
+        # 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 },
+        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;
+
+            # absolut Path to file
+            my $file = sprintf('%s/%s', $dir, $filename);
+            # absolut Path to file
+            if(save_file($file, $data)) {
+                # return the relative Path
+                my ($relpath) = $file =~ '/(.+?/.+?)$';
+                return sprintf('tempimages/%s', $filename);
+            }
+        },
+        fmttime => sub{ return fmttime(@_) },
+        bench => \&bench,
+        llog => sub{
+            my $lines = shift || 10;
+            my $lmod = main::getModule('LOGREAD');
+            return $lmod->tail($obj->{paths}->{LOGFILE}, $lines);
+        },
+        getModule => sub{
+            return main::getModule(shift);
+        },
+    };
+
+    $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->{output} .= $text,"\r\n"
+      if($text);
+}
+
+# ------------------
+sub printout {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $nopack = shift || $obj->{nopack} || 0;
+
+    if($obj->{output} && $obj->{handle}) {
+      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);
+      $obj->{sendbytes}+= length($obj->{output_header});
+      $obj->{sendbytes}+= length($content);
+      $obj->{handle}->close();
+    }
+    undef $obj->{output};
+    undef $obj->{output_header};
+    undef $obj->{nopack};
+    undef $obj->{hasentities};
+    undef $obj->{dontparsedData};
+}
+
+# ------------------
+sub getType {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $typ = shift  || 'text/html';
+
+    my $typefile = sprintf('%s/%s', $obj->{htmdir}, 'GENERICTYP');
+    if(-e $typefile and -r $typefile) {
+        $typ = load_file($typefile);
+        $typ =~ s/[\r|\n]//sig;
+    }
+    return $typ;
+}
+
+# ------------------
+sub header {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $typ = $obj->getType(shift) || return error ('No Type!' );
+    my $arg = shift || {};
+
+    $arg->{'Content-encoding'} = 'gzip'
+        if($obj->{browser}->{accept_gzip} && ((!defined $obj->{nopack}) || $obj->{nopack} == 0) );
+
+    if(defined $obj->{nocache} && $obj->{nocache}) {
+      $arg->{'Cache-Control'} = 'no-cache, must-revalidate' if(!defined $arg->{'Cache-Control'});
+      $arg->{'Pragma'} = 'no-cache' if(!defined $arg->{'Pragma'});
+    }
+
+    $obj->{header} = 200;
+    return $obj->{cgi}->header(
+        -type   =>  $typ,
+        -status  => "200 OK",
+        -expires => ($typ =~ 'text/html' || (defined $obj->{nocache} && $obj->{nocache})) ? "now" : "+7d",
+        %{$arg},
+    );
+}
+
+# ------------------
+sub statusmsg {
+# ------------------
+    my $obj = shift  || return error ('No Object!');
+    my $state = shift || return error ('No Status!');
+    my $msg = shift;
+    my $title = shift;
+
+    unless(defined $obj->{header}) {
+        $obj->{nopack} = 1;
+
+        my $s = {
+            200 => '200 OK',
+            204 => '204 No Response',
+            301 => '301 Moved Permanently',
+            302 => '302 Found',
+            303 => '303 See Other',
+            304 => '304 Not Modified',
+            307 => '307 Temporary Redirect',
+            400 => '400 Bad Request',
+            401 => '401 Unauthorized',
+            403 => '403 Forbidden',
+            403 => '404 Not Found',
+            405 => '405 Not Allowed',
+            408 => '408 Request Timed Out',
+            500 => '500 Internal Server Error',
+            503 => '503 Service Unavailable',
+            504 => '504 Gateway Timed Out',
+        };
+        my $status = $s->{200};
+        $status = $s->{$state}
+            if(exists $s->{$state});
+
+        my $arg = {};
+        $arg->{'WWW-Authenticate'} = "Basic realm=\"xxvd\""
+            if($state == 401);
+
+        $arg->{'expires'} = "now"
+            if($state != 304);
+
+        $obj->{header} = $state;
+        $obj->{output_header} = $obj->{cgi}->header(
+            -type   =>  'text/html',
+            -status  => $status,
+            %{$arg},
+        );
+    }
+    if($msg && $title) {
+        $obj->{output} = $obj->{cgi}->start_html(-title => $title)
+                       . $obj->{cgi}->h1($title)
+                       . $obj->{cgi}->p($msg)
+                       . $obj->{cgi}->end_html();
+    } else {
+        $obj->{output} = '\r\n';
+    }   
+}
+
+# ------------------
+# Send HTTP Status 401 (Authorization Required)
+sub login {
+# ------------------
+    my $obj = shift || return error ('No Object!');
+    my $msg = shift || '';
+
+    $obj->statusmsg(401,$msg,gettext("Authorization required"));
+}
+
+# ------------------
+# Send HTTP Status 403 (Access Forbidden)
+sub status403 {
+# ------------------
+    my $obj = shift  || return error ('No Object!');
+    my $msg = shift  || '';
+
+    $obj->statusmsg(403,$msg,gettext("Forbidden"));
+}
+
+
+# ------------------
+# Send HTTP Status 404 (File not found)
+sub status404 {
+# ------------------
+    my $obj = shift  || return error ('No Object!');
+    my $file = shift || return error ('No File!');
+    my $why = shift || "";
+
+    $file =~ s/$obj->{htmdir}\///g; # Don't post html root, avoid spy out
+
+    $obj->statusmsg(404,sprintf(gettext("Can't open file '%s' : %s"),$file,$why),
+                    gettext("Not found"));
+}
+
+# ------------------
+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)) {
+
+            $data->{typ} = 'string'
+              unless($data->{typ});
+
+            # 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 at field '%s' (%s) : %s"), $data->{msg}, $name, $error));
+                last;
+            }
+        }
+        unless($error) {
+            delete $erg->{action};
+            return $erg;
+        }
+    }
+
+    $obj->formStart($titel);
+    if(ref $questions eq 'ARRAY') {
+        my $q = $obj->{cgi};
+        @$quest = @$questions;
+        my $c=0;
+        while (my ($name, $data) = splice(@$quest, 0, 2)) {
+            my $type = delete $data->{typ};
+            my $params = delete $data->{param};
+            $params->{count} = $c++;
+            $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;
+
+    my $http_useragent = $obj->{browser}->{http_useragent};
+    if(grep(/Mozilla/i,$http_useragent) == 0  # Only Mozilla compatible browser support server push
+      || grep(/MSIE/i,$http_useragent) > 0 # Stopp her for Browser e.g. Internet Explorer
+      || grep(/Opera/i,$http_useragent) > 0 # Stopp her for Browser e.g. Opera
+      || grep(/KHTML/i,$http_useragent) > 0) # like Safari,Konqueror
+    {
+        lg sprintf('Sorry, only Mozilla compatible browser support server push, this browser was identify by "%s"',
+            $http_useragent );
+        return 0;
+    }
+    $obj->{nopack} = 1;
+    $obj->{header} = 200;
+    my $waiter =  XXV::OUTPUT::HTML::WAIT->new(
+        -cgi => $obj->{cgi},
+        -handle => $obj->{handle},
+        -callback => sub{
+            my ($min, $max, $cur, $steps, $nextmessage, $eta) = @_;
+            my $out = $obj->parseTemplate(
+                'wait',
+                {
+                    msg     => $nextmessage || $msg,
+                    minimum => $min,
+                    current => $cur,
+                    maximum => $max,
+                    steps   => $steps,
+                    eta     => $eta
+                },
+            );
+            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
+
+    }
+    $waiter->next(1);
+
+    return $waiter;
+}
+
+# ------------------
+sub datei {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $file = shift || return error ('No File!');
+    my $typ = shift;
+
+    my %args = ();
+
+    return $obj->status404($file,$!)
+      if(!-r $file);
+
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+       	             $atime,$mtime,$ctime,$blksize,$blocks) = stat $file;
+    return $obj->status404($file,$!)
+      if(!$blocks);
+
+    # header only if caching
+    $args{'ETag'} = sprintf('%x-%x-%x',$ino, $size, $mtime);
+    return $obj->statusmsg(304)
+        if($obj->{browser}->{'Match'}
+            && $args{'ETag'} eq $obj->{browser}->{'Match'});
+        
+    $typ = $obj->{mime}->{lc((split('\.', $file))[-1])}
+      if(!$typ);
+    $typ = "application/octet-stream"
+      if(!$typ);
+
+    $obj->{nopack} = 1
+        if($typ =~ /image\// || $typ =~ /video\//);
+
+    my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
+    my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;
+    my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($mtime);
+    $args{'Last-Modified'} = sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
+                   $WDAY[$wday],$mday,$MON[$mon],$year + 1900,$hour,$min,$sec);
+    $args{'attachment'} = basename($file);
+    $args{'Content-Length'} = $size
+        if($obj->{nopack});
+
+    if($size > (32768 * 16)) { ## Only files bigger then 512k
+
+      lg sprintf("stream file : '%s' (%s)",$file,convert($size));
+
+      $obj->{nopack} = 1;
+      my $handle = $obj->{handle};
+
+      my $child = fork(); 
+      if ($child < 0) {
+        error("Can't create process for streaming : " . $!);
+        return $obj->status404($file,$!);
+      }
+      elsif ($child > 0) {
+        $obj->{sendbytes} += $size;
+      }
+      elsif ($child == 0) {
+
+        eval 
+        { 
+          local $SIG{'__DIE__'};
+
+          my $hdr = $obj->header($typ, \%args);
+
+          my $r = 0;
+          if(sysopen( FH, $file, O_RDONLY|O_BINARY )) {  
+            $handle->print($hdr);
+
+            my $bytes;
+            my $data;
+            do {
+              $bytes = sysread( FH, $data, 4096 );
+              if($bytes) {
+                $r = $handle->send($data);
+              }
+            } while $r && $bytes > 0;
+            close(FH);
+          } else {
+            error sprintf("I can't open file '%s' : %s", $file,$!);
+          }
+          $handle->close();
+        };
+        error($@) if $@;
+        exit 0;
+      }
+
+      undef $obj->{handle};
+      undef $obj->{output};
+    } else {
+
+        my $data = load_file($file)
+            or return $obj->status404($file,$!);
+        # send data
+        $obj->out($data, $typ, %args );
+    }
+}
+
+# ------------------
+sub image {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $file = shift || return error ('No File!');
+    my $typ = shift;
+    return $obj->datei($file,$typ);
+}
+
+# ------------------
+sub pod {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $modname = uc(shift) || return error ('No Modname!' );
+    $modname = ucfirst($modname) if($modname eq 'GENERAL');
+
+    my $podfile = sprintf('%s/%s.pod', $obj->{paths}->{PODPATH}, $modname);
+    return $obj->err(gettext('Module %s not found!'), $modname)
+        unless(-r $podfile);
+
+    my $u = main::getModule('USER');
+    my $tmpdir = $u->userTmp;
+    my $outfile = sprintf('%s/%s_%d.pod', $tmpdir, $modname, time);
+
+    pod2html(
+        "--cachedir=$tmpdir",
+        "--infile=$podfile",
+        "--outfile=$outfile",
+    );
+    return error('Problem to convert pod2html')
+        unless(-r $outfile);
+
+    my $html = load_file($outfile);
+    $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 display!' );
+    my $param = shift || {};
+
+    my $txtfile = sprintf('%s/%s.txt', $obj->{paths}->{DOCPATH}, $filename);
+    my $gzfile  = sprintf('%s/%s.txt.gz', $obj->{paths}->{DOCPATH}, $filename);
+
+    $txtfile = main::getModule('HTTPD')->unzip($gzfile)
+        if(! -r $txtfile and -r $gzfile);
+
+    my $topic = gettext("File");
+
+    if($param->{'format'} eq 'txt') {
+        my $txt = load_file($txtfile);
+        return $obj->message($txt, {tags => {first => "$topic: $filename.txt"}});
+    }
+
+    my $u = main::getModule('USER');
+    my $htmlfile = sprintf('%s/temp_txt.html', $u->userTmp);
+
+    $obj->{txt2html}->txt2html(
+                     infile=>[$txtfile],
+                     outfile=>$htmlfile,
+                     title=> $filename,
+                     mail=>1,
+    );
+    my $html = load_file($htmlfile);
+    $html = $1 if($html =~ /\<body.*?\>(.+?)\<\/body\>/si);
+    $obj->message($html, {tags => {first => "<h1>$topic: $filename.txt</h1>"}});
+}
+
+# ------------------
+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;
+    }
+}
+
+# ------------------
+sub parseData {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $dta = shift  || return '';
+
+    if(ref $dta eq 'HASH') {
+        foreach my $name (keys %$dta) {
+            if(ref $dta->{$name}) {
+                $obj->parseData($dta->{$name});
+            } else {
+                $dta->{$name} = reentities($dta->{$name}) if($obj->{hasentities});
+                $dta->{$name} = entities($dta->{$name});
+            }
+        }
+    } elsif (ref $dta eq 'ARRAY') {
+        foreach (@$dta) {
+            if(ref $_) {
+                $obj->parseData($_);
+            } else {
+                $_ = reentities($_) if($obj->{hasentities});
+                $_ = entities($_);
+            }
+        }
+    }
+    $obj->{hasentities} = 1;
+    return $dta;
+}
+
+
+1;
diff --git a/lib/XXV/OUTPUT/NEWS/JABBER.pm b/lib/XXV/OUTPUT/NEWS/JABBER.pm
new file mode 100644
index 0000000..119f4c5
--- /dev/null
+++ b/lib/XXV/OUTPUT/NEWS/JABBER.pm
@@ -0,0 +1,296 @@
+package XXV::OUTPUT::NEWS::JABBER;
+use strict;
+
+use Tools;
+use POSIX qw(locale_h);
+use Locale::gettext;
+
+# News Modules have only three methods
+# init - for intervall or others
+# send - send the informations
+# read - read the news and parse it
+
+# This module method must exist for XXV
+# ------------------
+sub module {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $args = {
+        Name => 'NEWS::JABBER',
+        Prereq => {
+            'Net::XMPP' => 'Jabber protocol for connect and send',
+        },
+        Description => gettext(qq|
+This NEWS module generate a Jabber messages for your jabber client.
+If come a Message from xxv with a lever >= as Preferences::level then
+will this module send this Message to your jabber account
+(Preferences::receiveUser).
+
+The Problem xxv need a extra jabber account to allow to send messages in
+the jabber network. This is very simple:
+
+=over 4
+
+=item 1 Start your jabber client, may the exodus (http://exodus.jabberstudio.org/)
+
+=item 2 Create a new Profile with the name 'xxv'
+
+=item 3 In the next window input following things:
+
+    - Jabber Id: newsxxv\@jabber.org (in Example!)
+    - Password:  lalala (in Example!)
+    - save Password:  yes
+    - new Account?:   yes
+
+=back
+
+Thats all!
+
+If you want, you can test the connection to send a testmessage with
+the following url in the Webinterface:
+
+    http://vdr:8080/?cmd=request&data=jabber
+
+or Telnet Interface:
+
+    XXV> request jabber
+
+Then you must receive a message in your running jabber client.
+
+|),
+        Version => '0.01',
+        Date => '31.09.2005',
+        Author => 'xpix',
+        Preferences => {
+            active => {
+                description => gettext('Activate this service'),
+                default     => 'n',
+                type        => 'confirm',
+                required    => gettext('This is required!'),
+                check       => sub {
+                    my $value = shift;
+                    my $erg = $obj->init
+                        or return error('Problem to initialize news module')
+                            if($value eq 'y' and not exists $obj->{JCON});
+                    return $value;
+                },
+            },
+            level => {
+                description => gettext('Minimum level of the messages which can be displayed (1 ... 100)'),
+                default     => 1,
+                type        => 'integer',
+                required    => gettext('This is required!'),
+                check       => sub {
+                    my $value = int(shift) || 0;
+                    unless($value >= 1 and $value <= 100) {
+                        return undef, 'Sorry, but the value must be between 1 and 100';
+                    }
+                    return $value;
+                },
+            },
+            receiveUser => {
+                description => gettext('User to advise (as Jabberaccount to@jabber.server.org)'),
+                default     => '',
+                type        => 'string',
+                required    => gettext('This is required!'),
+            },
+            user => {
+                description => gettext('Jabberaccount to send message (from@jabber.server.org)'),
+                default     => '',
+                type        => 'string',
+                required    => gettext('This is required!'),
+            },
+            passwd => {
+                description => gettext('Password from Jabberaccount'),
+                default     => '',
+                type        => 'password',
+                required    => gettext('This is required!'),
+                check       => sub{
+                    my $value = shift || return;
+
+                    return $value unless(ref $value eq 'ARRAY');
+
+                    # If no password given the take the old password as default
+                    if($value->[0] and $value->[0] ne $value->[1]) {
+                        return undef, gettext("Field with 1st and 2nd password must be equal to confirm!");
+                    } else {
+                        return $value->[0];
+                    }
+                },
+            },
+        },
+    };
+    return $args;
+}
+
+# ------------------
+sub new {
+# ------------------
+	my($class, %attr) = @_;
+	my $self = {};
+	bless($self, $class);
+
+    # paths
+    $self->{paths} = delete $attr{'-paths'};
+
+    # host
+    $self->{host} = delete $attr{'-host'};
+
+	# who am I
+    $self->{MOD} = $self->module;
+
+    # all configvalues to $self without parents (important for ConfigModule)
+    map {
+        $self->{$_} = $attr{'-config'}->{$self->{MOD}->{Name}}->{$_} || $self->{MOD}->{Preferences}->{$_}->{default}
+    } keys %{$self->{MOD}->{Preferences}};
+
+    # Try to use the Requirments
+    map {
+        eval "use $_";
+        return panic("\nCan not load Module: $_\nPlease install this module on your System:\nperl -MCPAN -e 'install $_'") if($@);
+    } keys %{$self->{MOD}->{Prereq}};
+
+    $self->{TYP} = 'text/plain';
+
+    # Initiat after load modules ...
+    main::after(sub{
+        # The Initprocess
+        my $erg = $self->init
+            or return error('Problem to initialize news module');
+    }, "NEWS::JABBER: Start initiate the Jabber module ...")
+        if($self->{active} eq 'y');
+
+	return $self;
+}
+
+# ------------------
+sub init {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $url = sprintf("http://%s:%s/", $obj->{host}, main::getModule('HTTPD')->{Port});
+
+    1;
+}
+
+# ------------------
+sub jconnect {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+
+    my $jcon = Net::XMPP::Client->new(
+        debuglevel  =>  0,
+    ) || return error('Problem to create an Jabber Client');
+
+    my ($user, $server) = split('\@', $obj->{user});
+
+    debug ("Connecting to jabber server: %s ...", $server);
+
+    my @res = $jcon->Connect(
+        hostname    =>  $server,
+    );
+    return
+        unless($obj->xmpp_check_result("Connect",\@res,$jcon));
+
+    debug ("Authentificat with User:%s ...", $user);
+
+    @res = $jcon->AuthSend(
+      'hostname'=>$server,
+	  'username'=>$user,
+	  'password'=>$obj->{passwd},
+	  'resource'=>'xxv'
+    );
+
+    return $jcon
+        if($obj->xmpp_check_result("Login",\@res,$jcon));
+}
+
+# ------------------
+sub jdisconnect {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $cnx = shift  || 0;
+
+    $cnx->Disconnect()
+        if(ref $cnx);
+
+    1;
+}
+
+
+# ------------------
+sub send {
+# ------------------
+    my $obj     = shift || return error ('No Object!' );
+    my $vars    = shift || return error ('No Vars!' );
+
+    return undef, lg('This function is deactivated!')
+        if($obj->{active} ne 'y');
+
+    my $cnx     = $obj->jconnect()
+        || return error ('No connected JabberClient!' );
+
+    $cnx->MessageSend(
+        'to'     => $obj->{receiveUser},
+        'subject'=> $vars->{Title},
+        'body'   => ($vars->{Text} || $vars->{Url}),
+    );
+
+    $cnx = $obj->jdisconnect($cnx);
+
+    1;
+}
+
+# ------------------
+sub read {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $vars = shift || return error ('No News!' );
+
+    return $obj->send($vars);
+
+    1;
+}
+
+# ------------------
+sub req {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+
+    return gettext('The Module NEWS::JABBER is not active!')
+        if($obj->{active} ne 'y');
+
+    my $vars = {
+        AddDate => time,
+        Title   => 'This is a testmessage for NEWS::JABBER ...',
+        Text    => "abcdefghijklmnopqrstuvwxyz\nABCDEFGHIJKLMNOPQRSTUVWXYZ\n0123456789\näüöÄÜÖ!@#$%^&*()_+=-':;<>?/\n",
+        Level   => 100,
+    };
+
+    if($obj->send($vars)) {
+        return sprintf('Message is send to %s at %s', $obj->{receiveUser}, datum($vars->{AddDate}, 'voll'));
+    } else {
+        return sprintf('Upps, problem send Message to %s at %s', $obj->{receiveUser}, datum($vars->{AddDate}, 'voll'));
+    }
+}
+
+# ------------------
+sub xmpp_check_result {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my ($txt,$res,$cnx)=@_;
+
+    return error("Error '$txt': result undefined")
+	    unless($res);
+
+    # result can be true or 'ok'
+    if ((@$res == 1 && $$res[0]) || $$res[0] eq 'ok') {
+	    return debug "%s: %s", $txt, $$res[0];
+    # otherwise, there is some error
+    } else {
+	    my $errmsg = $cnx->GetErrorCode() || '?';
+        $cnx->Disconnect();
+	    return error("Error %s: %s [%s]", $txt, join (': ',@$res), $errmsg);
+    }
+}
+
+1;
diff --git a/lib/XXV/OUTPUT/NEWS/MAIL.pm b/lib/XXV/OUTPUT/NEWS/MAIL.pm
new file mode 100644
index 0000000..5f91e05
--- /dev/null
+++ b/lib/XXV/OUTPUT/NEWS/MAIL.pm
@@ -0,0 +1,313 @@
+package XXV::OUTPUT::NEWS::MAIL;
+use strict;
+
+use Tools;
+use POSIX qw(locale_h);
+use Locale::gettext;
+
+# News Modules have only this methods
+# init - for intervall or others
+# send - send the informations
+# read - read the news and parse it
+# req  - read the actual news print this out
+
+# This module method must exist for XXV
+# ------------------
+sub module {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $args = {
+        Name => 'NEWS::MAIL',
+        Prereq => {
+            'Mail::SendEasy' => 'Simple platform independent mailer',
+        },
+        Description => gettext('This NEWS module generate mails for news.'),
+        Version => '0.01',
+        Date => '31.09.2005',
+        Author => 'xpix',
+        Preferences => {
+            active => {
+                description => gettext('Activate this service'),
+                default     => 'n',
+                type        => 'confirm',
+                required    => gettext('This is required!'),
+                check       => sub {
+                    my $value = shift;
+                    my $erg = $obj->init
+                        or return error('Problem to initialize news module')
+                            if($value eq 'y' and not exists $obj->{INITE});
+                    return $value;
+                },
+            },
+            level => {
+                description => gettext('Minimum level of the messages which can be displayed (1 ... 100)'),
+                default     => 1,
+                type        => 'integer',
+                required    => gettext('This is required!'),
+                check       => sub {
+                    my $value = int(shift) || 0;
+                    unless($value >= 1 and $value <= 100) {
+                        return undef, 'Sorry, but the value must be between 1 and 100';
+                    }
+                    return $value;
+                },
+            },
+            interval => {
+                description => gettext('Time in hours to send the next mail'),
+                default     => 12,
+                type        => 'integer',
+                required    => gettext('This is required!'),
+                check       => sub {
+                    my $value = int(shift) || 0;
+                    if($value and ref $obj->{INTERVAL}) {
+                        my $newinterval = $value*3600;
+                        $obj->{INTERVAL}->interval($newinterval);
+                    }
+                    return $value;
+                },
+            },
+            address => {
+                description => gettext('One or more mail addresses for sending the news'),
+                default     => 'unknown@example.com, everybody@example.com',
+                type        => 'string',
+                required    => gettext('This is required!'),
+            },
+            from_address => {
+                description => gettext('Mail address to senders describe.'),
+                default     => 'xxv@vdr.de',
+                type        => 'string',
+            },
+            smtp => {
+                description => gettext('Hostname from SMTP mail server'),
+                default     => main::getModule('STATUS')->name,
+                type        => 'host',
+                required    => gettext('This is required!'),
+            },
+            susr => {
+                description => gettext('Username for mail server access'),
+                default     => 'xxv',
+                type        => 'string',
+            },
+            spwd => {
+                description => gettext('Password for mail server access'),
+                default     => 'xxv',
+                type        => 'password',
+                check       => sub{
+                    my $value = shift || return;
+
+                    return $value unless(ref $value eq 'ARRAY');
+
+                    # If no password given the take the old password as default
+                    if($value->[0] and $value->[0] ne $value->[1]) {
+                        return undef, gettext("Field with 1st and 2nd password must be equal to confirm!");
+                    } else {
+                        return $value->[0];
+                    }
+                },
+            },
+        },
+    };
+    return $args;
+}
+
+# ------------------
+sub new {
+# ------------------
+	my($class, %attr) = @_;
+	my $self = {};
+	bless($self, $class);
+
+    # paths
+    $self->{paths} = delete $attr{'-paths'};
+
+    # host
+    $self->{host} = delete $attr{'-host'};
+
+	# who am I
+    $self->{MOD} = $self->module;
+
+    # all configvalues to $self without parents (important for ConfigModule)
+    map {
+        $self->{$_} = $attr{'-config'}->{$self->{MOD}->{Name}}->{$_} || $self->{MOD}->{Preferences}->{$_}->{default}
+    } keys %{$self->{MOD}->{Preferences}};
+
+    # Try to use the Requirments
+    map {
+        eval "use $_";
+        return panic("\nCan not load Module: $_\nPlease install this module on your System:\nperl -MCPAN -e 'install $_'") if($@);
+    } keys %{$self->{MOD}->{Prereq}};
+
+    # create Template object
+    $self->{tt} = Template->new(
+      START_TAG    => '\<\?\%',		    # Tagstyle
+      END_TAG      => '\%\?\>',		    # Tagstyle
+      INTERPOLATE  => 1,                # expand "$var" in plain text
+      PRE_CHOMP    => 1,                # cleanup whitespace
+      EVAL_PERL    => 1,                # evaluate Perl code blocks
+      ABSOLUTE     => 1,
+    );
+
+    my @tmplfiles = glob(
+        sprintf('%s/%s_*.tmpl',
+            $self->{paths}->{NEWSTMPL},
+            lc((split('::', $self->{MOD}->{Name}))[-1])
+        )
+    );
+    for (@tmplfiles) {
+        my ($order, $typ) = $_ =~ /_(\d+)_(\S+)\.tmpl$/si;
+        $self->{TEMPLATES}->{$typ} = $_;
+    }
+
+    # The Initprocess
+    my $erg = $self->init
+        or return error('Problem to initialize news module')
+            if($self->{active} eq 'y');
+
+    $self->{TYP} = 'text/plain';
+
+	return $self;
+}
+
+# ------------------
+sub init {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    $obj->{INITE} = 1;
+
+    $obj->{LastReportTime} = time;
+
+    # Interval to send the next mail
+    $obj->{INTERVAL} = Event->timer(
+        interval => $obj->{interval}*3600,
+        prio => 6,  # -1 very hard ... 6 very low
+        cb => sub{
+            $obj->send();
+        },
+    );
+
+    $obj->{COUNT} = 1;
+
+    1;
+}
+
+# ------------------
+sub send {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+
+    return error('This function is deactivated!')
+        if($obj->{active} ne 'y');
+
+    ++$obj->{COUNT};
+
+    my $content = $obj->req();
+
+    my $smod = main::getModule('STATUS');
+    my @addresses = split(/\s*,\s*/, $obj->{address});
+
+    # Send mail
+    my $status = Mail::SendEasy::send(
+        smtp => $obj->{smtp},
+        user => $obj->{susr},
+        pass => $obj->{spwd},
+        from    => $obj->{from_address},
+        from_title => 'XXV MailNewsAgent',
+        to      => shift @addresses ,
+        cc      => join(',', @addresses),
+        subject => "News from your XXV System!" ,
+        msg     => $content,
+        msgid   => $obj->{COUNT},
+    ) || return error('Problem to send Mail: %s', $Mail::SendEasy::ER);
+
+    $obj->{LastReportTime} = time;
+
+    lg sprintf('News Mail with nr. %d successfully send at %s', $obj->{COUNT}, scalar localtime);
+    $obj->{NEWSLETTER} = undef;
+    1;
+}
+
+# ------------------
+sub parseHeader {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $output = '';
+
+    my $vars = {
+        msgnr => $obj->{COUNT},
+        date  => datum(time, 'voll'),
+        anzahl=> $obj->{NEWSCOUNT},
+    };
+
+    my $template = $obj->{TEMPLATES}->{'header'};
+    $obj->{tt}->process($template, $vars, \$output)
+          or return error($obj->{tt}->error());
+
+    return $output;
+}
+
+# ------------------
+sub parseFooter {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $output = '';
+
+
+    my $vars = {
+        usage => main::getModule('RECORDS')->{CapacityMessage},
+        uptime  => main::getModule('STATUS')->uptime,
+        lastreport => datum($obj->{LastReportTime}, 'voll'),
+    };
+
+    my $template = $obj->{TEMPLATES}->{'footer'};
+    $obj->{tt}->process($template, $vars, \$output)
+          or return error($obj->{tt}->error());
+
+    return $output;
+}
+
+
+# ------------------
+sub read {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $vars = shift || return error ('No News!' );
+
+    my $output = '';
+    $vars->{count} = ++$obj->{NEWSCOUNT};
+    $vars->{host}  = $obj->{host};
+    $vars->{port}  = main::getModule('HTTPD')->{Port};
+
+    my $template = $obj->{TEMPLATES}->{'content'};
+    $obj->{tt}->process($template, $vars, \$output)
+          or return error($obj->{tt}->error());
+
+    $obj->{NEWSLETTER} .= $output;
+
+    return $output;
+}
+
+# ------------------
+sub req {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $test = shift  || 0;
+
+    return gettext('The Module NEWS::Mail is not active!')
+        if($obj->{active} ne 'y');
+
+    my $content = '';
+    if($test) {
+        $obj->send;
+        $content .= gettext('A mail with the following content is send to your Mailaccount!');
+        $content .= "\n\n";
+    }
+
+    $content .= $obj->parseHeader();
+    $content .= $obj->{NEWSLETTER};
+    $content .= $obj->parseFooter();
+
+    return $content;
+}
+
+
+1;
diff --git a/lib/XXV/OUTPUT/NEWS/RSS.pm b/lib/XXV/OUTPUT/NEWS/RSS.pm
new file mode 100644
index 0000000..82cdbd4
--- /dev/null
+++ b/lib/XXV/OUTPUT/NEWS/RSS.pm
@@ -0,0 +1,233 @@
+package XXV::OUTPUT::NEWS::RSS;
+use strict;
+
+use Tools;
+use POSIX qw(locale_h);
+use Locale::gettext;
+
+# News Modules have only three methods
+# init - for intervall or others
+# send - send the informations
+# read - read the news and parse it
+
+# This module method must exist for XXV
+# ------------------
+sub module {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $args = {
+        Name => 'NEWS::RSS',
+        Prereq => {
+            'XML::RSS' => 'SMTP Protocol module to connect and send emails',
+        },
+        Description => gettext('This NEWS module generate an RSS Newsfeed for your rss reader.'),
+        Version => '0.01',
+        Date => '31.09.2005',
+        Author => 'xpix',
+        Preferences => {
+            active => {
+                description => gettext('Activate this service'),
+                default     => 'y',
+                type        => 'confirm',
+                required    => gettext('This is required!'),
+                check       => sub {
+                    my $value = shift;
+                    my $erg = $obj->init
+                        or return error('Problem to initialize news module')
+                            if($value eq 'y' and not exists $obj->{INITE});
+                    return $value;
+                },
+            },
+            level => {
+                description => gettext('Minimum level of the messages which can be displayed (1 ... 100)'),
+                default     => 1,
+                type        => 'integer',
+                required    => gettext('This is required!'),
+                check       => sub {
+                    my $value = int(shift) || 0;
+                    unless($value >= 1 and $value <= 100) {
+                        return undef, 'Sorry, but the value must be between 1 and 100';
+                    }
+                    return $value;
+                },
+            },
+        },
+    };
+    return $args;
+}
+
+# ------------------
+sub new {
+# ------------------
+	my($class, %attr) = @_;
+	my $self = {};
+	bless($self, $class);
+
+    # paths
+    $self->{paths} = delete $attr{'-paths'};
+
+    # host
+    $self->{host} = delete $attr{'-host'};
+
+	# who am I
+    $self->{MOD} = $self->module;
+
+    # all configvalues to $self without parents (important for ConfigModule)
+    map {
+        $self->{$_} = $attr{'-config'}->{$self->{MOD}->{Name}}->{$_} || $self->{MOD}->{Preferences}->{$_}->{default}
+    } keys %{$self->{MOD}->{Preferences}};
+
+    # Try to use the Requirments
+    map {
+        eval "use $_";
+        return panic("\nCan not load Module: $_\nPlease install this module on your System:\nperl -MCPAN -e 'install $_'") if($@);
+    } keys %{$self->{MOD}->{Prereq}};
+
+    $self->{TYP} = 'application/xhtml+xml';
+
+    # Initiat after load modules ...
+    main::after(sub{
+        # The Initprocess
+        my $erg = $self->init
+            or return error('Problem to initialize News Module');
+    }, "NEWS::RSS: Start initiate the RSS Feed ...")
+        if($self->{active} eq 'y');
+
+
+
+	return $self;
+}
+
+# ------------------
+sub init {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    $obj->{INITE} = 1;
+
+    1;
+}
+
+# ------------------
+sub createRSS {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $ver  = shift || 1;
+    my $account = sprintf("%s@%s", $ENV{USER}, main::getModule('STATUS')->name);
+    my $url = sprintf("http://%s:%s/", $obj->{host}, main::getModule('HTTPD')->{Port});
+
+    my $rss;
+    if($ver == 1) {
+        $rss = XML::RSS->new(
+            version => '1.0',
+        ) || return error('Problem to create an RSS Object');
+
+
+        $rss->channel(
+            title        => gettext("XXV RSS 1.0"),
+            'link'         => $url,
+            description  => gettext("Important messages from your vdr/xxv"),
+            dc => {
+                date       => datum(time,'int'),
+                subject    => gettext("XXV Messages"),
+                creator    => $account,
+                language   => setlocale(POSIX::LC_MESSAGES),
+            },
+            syn => {
+                updatePeriod     => "hourly",
+                updateFrequency  => "1",
+                updateBase       => datum(time, 'int'),
+            },
+        );
+
+    } elsif($ver == 2) {
+        my $lastbuild = (exists $obj->{lastBuildDate} ? $obj->{lastBuildDate} : time);
+
+        $rss = XML::RSS->new(
+            version => '2.0',
+        ) || return error('Problem to create an RSS Object');
+
+        $rss->channel(
+            title          => gettext("XXV RSS 2.0"),
+            'link'         => $url,
+            description    => gettext("Important messages from your vdr/xxv"),
+            language       => setlocale(POSIX::LC_MESSAGES),
+            pubDate        => datum(time, 'rss'),
+            lastBuildDate  => datum($lastbuild, 'rss'),
+            managingEditor => $account,
+        );
+    }
+    $obj->{lastBuildDate} = time;
+
+    return $rss;
+}
+
+
+# ------------------
+sub send {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $vars = shift || return error ('No Vars!' );
+
+    ++$obj->{COUNT};
+
+    push(@{$obj->{STACK}}, [
+        entities($vars->{Title}),
+        entities($vars->{Url}),
+        entities($vars->{Text}),
+        datum($vars->{AddDate},'int'),
+        $vars->{LevelName},
+    ]);
+
+    lg sprintf('News RSS with nr. %d successfully send at %s', $obj->{COUNT}, scalar localtime);
+    1;
+}
+
+# ------------------
+sub read {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $vars = shift || return error ('No News!' );
+
+    return undef, lg('This function is deactivated!')
+        if($obj->{active} ne 'y');
+
+
+    $vars->{count} = ++$obj->{NEWSCOUNT};
+    $vars->{host}  = $obj->{host};
+    $vars->{port}  = main::getModule('HTTPD')->{Port};
+
+    $obj->send($vars);
+
+    return 1;
+}
+
+# ------------------
+sub req {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $params = shift || {};
+
+    return gettext('The Module NEWS::RSS is not active!')
+        if($obj->{active} ne 'y');
+
+    my $rss = $obj->createRSS($params->{version})
+        || return error('Problem to create a RSS Object!');
+
+    foreach my $entry (@{$obj->{STACK}}) {
+        my ($title, $link, $descr, $adddate, $level) = @{$entry};
+        $rss->add_item(
+            title       => $title,
+            link        => $link,
+            description => $descr,
+    		dc => {
+    				date    => $adddate,
+     				subject => $level
+            },
+        );
+    }
+
+    return $rss->as_string;
+}
+
+
+1;
diff --git a/lib/XXV/OUTPUT/NEWS/VDR.pm b/lib/XXV/OUTPUT/NEWS/VDR.pm
new file mode 100644
index 0000000..9f56793
--- /dev/null
+++ b/lib/XXV/OUTPUT/NEWS/VDR.pm
@@ -0,0 +1,165 @@
+package XXV::OUTPUT::NEWS::VDR;
+use strict;
+
+use Tools;
+use POSIX qw(locale_h);
+use Locale::gettext;
+
+# News Modules have only three methods
+# init - for intervall or others
+# send - send the informations
+# read - read the news and parse it
+
+# This module method must exist for XXV
+# ------------------
+sub module {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $args = {
+        Name => 'NEWS::VDR',
+        Description => gettext('This NEWS module generate a messages for vdr interface.'),
+        Version => '0.01',
+        Date => '31.09.2005',
+        Author => 'xpix',
+        Preferences => {
+            active => {
+                description => gettext('Activate this service'),
+                default     => 'n',
+                type        => 'confirm',
+                required    => gettext('This is required!'),
+                check       => sub {
+                    my $value = shift;
+                    my $erg = $obj->init
+                        or return error('Problem to initialize news module')
+                            if($value eq 'y' and not exists $obj->{INITE});
+                    return $value;
+                },
+            },
+            level => {
+                description => gettext('Minimum level of the messages which can be displayed (1 ... 100)'),
+                default     => 1,
+                type        => 'integer',
+                required    => gettext('This is required!'),
+                check       => sub {
+                    my $value = int(shift) || 0;
+                    unless($value >= 1 and $value <= 100) {
+                        return undef, 'Sorry, but the value must be between 1 and 100';
+                    }
+                    return $value;
+                },
+            },
+        },
+    };
+    return $args;
+}
+
+# ------------------
+sub new {
+# ------------------
+	my($class, %attr) = @_;
+	my $self = {};
+	bless($self, $class);
+
+    # paths
+    $self->{paths} = delete $attr{'-paths'};
+
+    # host
+    $self->{host} = delete $attr{'-host'};
+
+	# who am I
+    $self->{MOD} = $self->module;
+
+    # all configvalues to $self without parents (important for ConfigModule)
+    map {
+        $self->{$_} = $attr{'-config'}->{$self->{MOD}->{Name}}->{$_} || $self->{MOD}->{Preferences}->{$_}->{default}
+    } keys %{$self->{MOD}->{Preferences}};
+
+    # Try to use the Requirments
+    map {
+        eval "use $_";
+        return panic("\nCan not load Module: $_\nPlease install this module on your System:\nperl -MCPAN -e 'install $_'") if($@);
+    } keys %{$self->{MOD}->{Prereq}};
+
+    $self->{TYP} = 'text/plain';
+
+    # Initiat after load modules ...
+    main::after(sub{
+        # The Initprocess
+        my $erg = $self->init
+            or return error('Problem to initialize news module');
+    }, "NEWS::VDR: Start initiate the News vdr module ...")
+        if($self->{active} eq 'y');
+
+	return $self;
+}
+
+# ------------------
+sub init {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $url = sprintf("http://%s:%s/", $obj->{host}, main::getModule('HTTPD')->{Port});
+    $obj->{INITE} = 1;
+
+    $obj->{SVDRP} = main::getModule('SVDRP');
+
+    1;
+}
+
+# ------------------
+sub send {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $vars = shift || return error ('No Vars!' );
+
+    return undef, lg('This function is deactivated!')
+        if($obj->{active} ne 'y');
+
+    return undef, lg('Title is not set!')
+        unless($vars->{Title});
+
+
+    my $cmd = sprintf('MESG %s', $vars->{Title});
+
+    my $svdrp = $obj->{SVDRP} || return error ('No SVDRP!' );
+    $svdrp->command($cmd);
+
+    1;
+}
+
+# ------------------
+sub read {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $vars = shift || return error ('No News!' );
+
+    return $obj->send($vars);
+
+    1;
+}
+
+# ------------------
+sub req {
+# ------------------
+    my $obj = shift  || return error ('No Object!' );
+    my $test = shift  || 0;
+
+    return gettext('The Module NEWS::VDR is not active!')
+        if($obj->{active} ne 'y');
+
+    my $vars = {
+        AddDate => time,
+        Title   => 'This is only a Test for the xxv news vdr module!',
+        Text    => 'This is only a Test for the xxv news vdr module!',
+        Cmd     => 'request',
+        Id      => 'vdr',
+        Url     => sprintf("http://%s:%s/", $obj->{host}, main::getModule('HTTPD')->{Port}),
+        Level   => 'harmless',
+    };
+    $obj->read($vars);
+
+    return gettext('A message is send to your SVDRPServer!');
+
+}
+
+
+1;
diff --git a/lib/XXV/OUTPUT/Wml.pm b/lib/XXV/OUTPUT/Wml.pm
new file mode 100644
index 0000000..fc110c2
--- /dev/null
+++ b/lib/XXV/OUTPUT/Wml.pm
@@ -0,0 +1,431 @@
+package XXV::OUTPUT::Wml;
+
+use strict;
+
+use vars qw($AUTOLOAD);
+use Locale::gettext;
+use Tools;
+use File::Path;
+use Pod::Html;
+
+# This module method must exist for XXV
+# ------------------
+sub module {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $args = {
+        Name => 'Wml',
+        Prereq => {
+            'Template'  => 'Front-end module to the Template Toolkit ',
+        },
+        Description => gettext('This receive and send Wap messages.'),
+        Version => '0.01',
+        Date => '27.10.2004',
+        Author => 'xpix',
+    };
+    return $args;
+}
+
+# ------------------
+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);
+
+	# who am I
+    $self->{MOD} = $self->module;
+
+    # Try to use the Requirments
+    map {
+        eval "use $_";
+        return panic("\nCan not load Module: $_\nPlease install this module on your System:\nperl -MCPAN -e 'install $_'") if($@);
+    } keys %{$self->{MOD}->{Prereq}};
+
+    $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->{wmldir} = $attr{'-wmldir'}
+        || return error('No wmldir 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} = 'WML';
+
+    eval "use Template::Stash::XS";
+    $Template::Config::STASH = 'Template::Stash::XS' unless($@);
+
+    # create Template object
+    $self->{tt} = Template->new(
+      START_TAG    => '\<\?\%',		    # Tagstyle
+      END_TAG      => '\%\?\>',		    # Tagstyle
+      INCLUDE_PATH => $self->{wmldir},  # or list ref
+      INTERPOLATE  => 1,                # expand "$var" in plain text
+      PRE_CHOMP    => 1,                # cleanup whitespace
+      EVAL_PERL    => 1,                # evaluate Perl code blocks
+    );
+
+	return $self;
+}
+
+# ------------------
+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 $t = $obj->{tt};
+    my $u = main::getModule('USER');
+
+    # you can use two templates, first is a user defined template
+    # and second the standard template
+    # i.e. call the htmlhelp command the htmlhelp.tmpl
+    # SpecialTemplate:  ./wmlRoot/usage.tmpl
+    # StandardTemplate: ./wmlRoot/widgets/menu.tmpl
+    my $widget_first  = sprintf('%s.tmpl', (exists $obj->{call}) ? $obj->{call} : 'nothing');
+    my $widget_second = sprintf('widgets/%s.tmpl', $name);
+    my $widget = (-e sprintf('%s/%s', $obj->{wmldir}, $widget_first) ? $widget_first : $widget_second);
+    my $user = ($u->{active} eq 'y' && $obj->{USER}->{Name} ? $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 1 if($cmdobj);
+        },
+	    basedir => $obj->{wmldir},
+        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 },
+        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;
+
+            # absolut Path to file
+            my $file = sprintf('%s/%s', $dir, $filename);
+            # absolut Path to file
+            if(save_file($file, $data)) {
+                # return the relative Path
+                my ($relpath) = $file =~ '/(.+?/.+?)$';
+                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/vnd.wap.wml';
+    my %args = @_;
+
+    my $q = $obj->{cgi};
+    unless(defined $obj->{header}) {
+        # HTTP Header
+        $obj->{handle}->print(
+            $obj->header($type, \%args)
+        );
+    }
+
+    $obj->{handle}->print( $text,"\r\n" );
+}
+
+# ------------------
+sub header {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $typ = shift || return error ('No Type!' );
+    my $arg = shift || {};
+
+    $obj->{header} = 1;
+    return $obj->{cgi}->header(
+        -type   =>  $typ,
+        -status  => "200 OK",
+        -expires => ($typ =~ 'text/vnd.wap.wml' || (defined $obj->{nocache} && $obj->{nocache})) ? "now" : "+12h",
+        %{$arg},
+    );
+}
+
+# ------------------
+sub statusmsg {
+# ------------------
+    my $obj = shift  || return error ('No Object!');
+    my $msg = shift || return error ('No Msg!');
+    my $status = shift || return error ('No Status!');
+
+    unless(defined $obj->{header}) {
+        $obj->{nopack} = 1;
+        $obj->{header} = 1;
+        my $data = $obj->{cgi}->header(
+            -type   =>  'text/vnd.wap.wml',
+            -status  => $status,
+            -expires => "now",
+        );
+        $obj->out($data);
+    }
+
+    my @title = split ('\n', $status);
+    $obj->start(undef,{ title => $title[0] });
+    $obj->err($msg);
+    $obj->footer();
+}
+
+# ------------------
+# Send HTTP Status 401 (Authorization Required)
+sub login {
+# ------------------
+    my $obj = shift || return error ('No Object!');
+    my $msg = shift || '';
+
+    $obj->statusmsg($msg,"401 Authorization Required\nWWW-Authenticate: Basic realm=\"xxvd\"");
+}
+
+# ------------------
+# Send HTTP Status 403 (Access Forbidden)
+sub status403 {
+# ------------------
+    my $obj = shift  || return error ('No Object!');
+    my $msg = shift  || '';
+
+    $obj->statusmsg($msg,"403 Forbidden");
+}
+
+
+# ------------------
+# Send HTTP Status 404 (File not found)
+sub status404 {
+# ------------------
+    my $obj = shift  || return error ('No Object!');
+    my $file = shift || return error ('No File!');
+    my $why = shift || "";
+
+    warn("I can't read file $file");
+
+    $file =~ s/$obj->{wmldir}\///g; # Don't post wml root, avoid spy out
+
+    $obj->statusmsg(sprintf(gettext("Can't open file '%s' : %s"),$file,$why),"404 File not found");
+}
+
+# ------------------
+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);
+            }
+
+            # 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}));
+            }
+
+            if($error) {
+                $obj->err(sprintf(gettext("Error at field '%s' (%s) : %s"), $data->{msg}, $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};
+            $data->{msg} =~ s/\n/<br \/>/sig if($data->{msg});
+            $data->{NAME} = '__'.$name;
+            $type ||= 'string';
+            $obj->$type($data);
+        }
+    } else {
+        my $type = delete $questions->{typ};
+        $questions->{NAME} = '__'.$type;
+        $type ||= 'string';
+        $obj->$type($questions);
+    }
+    $obj->formEnd;
+    return undef;
+}
+
+# ------------------
+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");
+
+    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/vnd.wap.wml');
+}
+
+# ------------------
+sub pod {
+# ------------------
+    my $obj = shift || return error ('No Object!' );
+    my $modname = shift || return error ('No Modname!' );
+    $modname = ucfirst($modname) if($modname eq 'GENERAL');
+
+    my $podfile = sprintf('%s/%s.pod', $obj->{paths}->{PODPATH}, $modname);
+    my $tmpdir = main::getModule('USER')->userTmp;
+    my $outfile = sprintf('%s/%s_%d.pod', $tmpdir, $modname, time);
+
+    pod2html(
+        "--cachedir=$tmpdir",
+        "--infile=$podfile",
+        "--outfile=$outfile",
+    );
+    return error('Problem to convert pod2html')
+        unless(-r $outfile);
+
+    my $html = load_file($outfile);
+    $html = $1 if($html =~ /\<body.*?\>(.+?)\<\/body\>/si);
+    $obj->link({
+        text => gettext("Back to configuration screen"),
+        url => $obj->{browser}->{Referer},
+    });
+    $obj->message($html);
+}
+
+# ------------------
+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 || {};
+    my $err = shift;
+
+    unless($err) {
+        $obj->message($data);
+    } else {
+        $obj->err($data);
+    }
+}
+
+
+
+1;