* Move files to trunk

4 files changed, 1007 insertions, 0 deletions

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;