* Add simple proxy mode to relay live stream

* Add option to select method of live stream (playlist, redirect, proxy)
* CHANNELS: Dont delete all database entry at import, insert only changed data.
* CHANNELS: Better detect new channels.

3 files changed, 393 insertions, 127 deletions

diff --git a/lib/XXV/MODULES/CHANNELS.pm b/lib/XXV/MODULES/CHANNELS.pm
index 12af276..b1e7c1a 100644
--- a/lib/XXV/MODULES/CHANNELS.pm
+++ b/lib/XXV/MODULES/CHANNELS.pm
@@ -12,7 +12,7 @@ sub module {
     my $args = {
         Name => 'CHANNELS',
         Prereq => {
-            'Digest::MD5 qw(md5_hex)' => 'Perl interface to the MD5 Algorithm',
+#           'modul' => 'description',
         },
         Description => gettext('This module reads new channels and stores them in the database.'),
         Version => (split(/ /, '$Revision$'))[1],
@@ -120,10 +120,10 @@ sub status {
     my $console = shift;
     my $lastReportTime = shift || 0;
 
-    my $sql = "SELECT SQL_CACHE  count(*) from CHANNELS";
+    my $sql = "SELECT SQL_CACHE count(*) from CHANNELS";
     my $gesamt = $obj->{dbh}->selectrow_arrayref($sql)->[0];
 
-    $sql = "SELECT SQL_CACHE  count(*) from CHANNELGROUPS";
+    $sql = "SELECT SQL_CACHE count(*) from CHANNELGROUPS";
     my $groups = $obj->{dbh}->selectrow_arrayref($sql)->[0];
 
     return {
@@ -250,7 +250,7 @@ sub _init {
 }
 
 # ------------------
-sub insert {
+sub _prepare {
 # ------------------
     my $obj = shift || return error('No object defined!');
     my $data = shift || return;
@@ -314,18 +314,53 @@ sub insert {
     } else {
         $id = sprintf('%s-%u-%u-%u', $data->[3], $data->[10], ($data->[10] || $data->[11]) ? $data->[11] : $freqID, $data->[9]);
     }
-    unshift(@$data, $id);
 
-    # ChannelGroup
-    push(@$data, $grp);
-
-    # POS
-    push(@$data, $pos);
+    my $attr = {
+          Id => $id,
+          Name => $data->[0],
+          Frequency => $data->[1],
+          Parameters => $data->[2],
+          Source => $data->[3],
+          Srate => $data->[4],
+          VPID => $data->[5],
+          APID => $data->[6],
+          TPID => $data->[7],
+          CA => $data->[8],
+          SID => $data->[9],
+          NID => $data->[10],
+          TID => $data->[11],
+          RID => $data->[12],
+          GRP => $grp,
+          POS => $pos
+    };
+    return $attr;
+}
 
-    my $sth = $obj->{dbh}->prepare('REPLACE INTO CHANNELS VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)');
-    $sth->execute( @$data );
-    lg sprintf('Add new channel "%s" with id "%s".', $data->[1], $id);
-    return 1;
+# ------------------
+sub _replace {
+# ------------------
+    my $obj = shift || return error('No object defined!');
+    my $attr = shift || return error('No data defined!');
+
+    my $sth = $obj->{dbh}->prepare('REPLACE INTO CHANNELS(Id,Name,Frequency,Parameters,Source,Srate,VPID,APID,TPID,CA,SID,NID,TID,RID,GRP,POS) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)');
+    return $sth->execute(
+        $attr->{Id},
+        $attr->{Name},
+        $attr->{Frequency},
+        $attr->{Parameters},
+        $attr->{Source},
+        $attr->{Srate},
+        $attr->{VPID},
+        $attr->{APID},
+        $attr->{TPID},
+        $attr->{CA},
+        $attr->{SID},
+        $attr->{NID},
+        $attr->{TID},
+        $attr->{RID},
+        $attr->{GRP},
+        $attr->{POS}
+    );
 }
 
 # ------------------
@@ -335,7 +370,7 @@ sub insertGrp {
     my $pos = shift || return;
     my $name = shift || 0;
 
-    lg sprintf('Add new group of channels "%s".', $name);
+    lg sprintf('Update group of channels "%s" (%d).', $name, $pos);
     my $sth = $obj->{dbh}->prepare('REPLACE INTO CHANNELGROUPS SET Name=?, Id=?');
     $sth->execute($name, $pos)
         or return error sprintf("Couldn't execute query: %s.",$sth->errstr);
@@ -351,9 +386,9 @@ sub readData {
 
     # Read channels over SVDRP
     my $lstc = $obj->{svdrp}->command('lstc :groups');
-    my $vdata = [ grep(/^250/, @$lstc) ];
+    my $vdrData = [ grep(/^250/, @$lstc) ];
 
-    unless(scalar @$vdata) {
+    unless(scalar @$vdrData) {
         # Delete old Records
         $obj->{dbh}->do('DELETE FROM CHANNELS');
         $obj->{dbh}->do('DELETE FROM CHANNELGROUPS');
@@ -363,51 +398,120 @@ sub readData {
         return;
     }
 
-    my $md5sum = md5_hex(@$vdata);
-    # only if channels modified
-    return
-      if(! ref $console and defined $obj->{LastMD5Sum} and ($md5sum ne $obj->{LastMD5Sum}));
-    $obj->{LastMD5Sum} = $md5sum;
-
-    $obj->{dbh}->do('DELETE FROM CHANNELS');
-    $obj->{dbh}->do('DELETE FROM CHANNELGROUPS');
-
-    my $c = 0;
     my $nPos = 1;
     my $grp = 0;
     my $channelText;
     my $grpText;
-
-    foreach my $line (@{$vdata}) {
-
-        next if($line eq "");
-        if($line =~ /250[\-|\s]0\s/) { # Channels groups
-            ($nPos, $grpText)
-                = $line =~ /^250[\-|\s]0\s\:\@(\d+)\s(.+)/si;
+    my $newChannels;
+    my $changedData = 0;
+    my $updatedData = 0;
+    my $deleteData = 0;
+
+    my $sth = $obj->{dbh}->prepare('SELECT SQL_CACHE * from CHANNELS');
+    $sth->execute()
+      or return error sprintf("Couldn't execute query: %s.",$sth->errstr);
+    my $db_data = $sth->fetchall_hashref('Id');
+
+    my $gsth = $obj->{dbh}->prepare('SELECT SQL_CACHE * from CHANNELGROUPS');
+    $gsth->execute()
+      or return error sprintf("Couldn't execute query: %s.",$gsth->errstr);
+    my $grp_data = $gsth->fetchall_hashref('Id');
+
+    lg sprintf("Compare channels database with data from vdr : %d / %d", (scalar keys %$db_data) + (scalar keys %$grp_data) ,scalar @$vdrData);
+  
+    foreach my $line (@{$vdrData}) {
+
+      next if($line eq "");
+
+      if($line =~ /250[\-|\s]0\s/) { # Channels groups
+        ($nPos, $grpText) = $line =~ /^250[\-|\s]0\s\:\@(\d+)\s(.+)/si;
+        if(exists $grp_data->{$nPos}) {
+          if($grp_data->{$nPos}->{Name} ne $grpText) {
+            $grp = $obj->insertGrp($nPos, $grpText);
+          } else {
+            $grp = $nPos;
+          }
+          delete $grp_data->{$nPos};
+        } else {
             $grp = $obj->insertGrp($nPos, $grpText);
-         } else {
-            # Insert dummy group
-            $grp = $obj->insertGrp(1, gettext("Channels")) if(!$grp);
-
-            ($nPos, $channelText)
-                = $line =~ /^250[\-|\s](\d+)\s(.+)/si;
-            my @data = split(':', $channelText, 13);
-            $data[-1] = (split(':', $data[-1]))[0];
-
-            $c++ if(scalar @data > 4 && $obj->insert(\@data, $nPos++, $grp));
         }
+      } else {
+          # Insert first group
+          unless($grp) {
+            $grp = 1;
+            if(exists $grp_data->{$grp}) {
+              $grpText = gettext("Channels");
+              if($grp_data->{$nPos}->{Name} ne $grpText) {
+                $obj->insertGrp($grp, $grpText);
+              }
+              delete $grp_data->{$nPos};
+            } else {
+              $obj->insertGrp($grp, $grpText);
+            }
+          }
+
+          ($nPos, $channelText) = $line =~ /^250[\-|\s](\d+)\s(.+)/si;
+
+          my @data = split(':', $channelText, 13);
+          $data[-1] = (split(':', $data[-1]))[0];
+
+          if(scalar @data > 4) {
+            my $row = $obj->_prepare(\@data, $nPos++, $grp);
+            next unless($row);
+
+            my $id = $row->{Id};
+
+            # Exists in DB .. update
+            if(exists $db_data->{$id}) {
+              # Compare fields
+              foreach my $field (qw/Name Frequency Parameters Source Srate VPID APID TPID CA SID NID TID RID GRP POS/) {
+                next if(not exists $row->{$field} or not $row->{$field});
+                if((not exists $db_data->{$id}->{$field})
+                    or (not $db_data->{$id}->{$field})
+                    or ($db_data->{$id}->{$field} ne $row->{$field})) {
+                  lg sprintf('Update channel "%s" - %s.', $row->{Name}, $id);
+                  $obj->_replace($row);
+                  $updatedData++;
+                  last;
+                }
+              }
+
+              # delete updated rows from hash
+              delete $db_data->{$id};
+
+            } else {
+              # Not exists in DB .. insert
+              lg sprintf('Add new channel "%s" - %s.', $row->{Name}, $id);
+              $obj->_replace($row);
+              $changedData++;
+              # Remember new channels
+              $newChannels->{$id} = $row;
+            }
+          }
+      }
     }
 
-    # Cool we have new Channels!
-    my $LastChannel = $obj->_LastChannel;
-    if($obj->{LastChannel}->{POS} and $LastChannel->{POS} > $obj->{LastChannel}->{POS}) {
-        $obj->_brandNewChannels($obj->{LastChannel}->{POS});
+    # Delete unused entrys in DB 
+    if(scalar keys %$db_data > 0) {
+      my @todel = keys(%$db_data);
+      my $sql = sprintf('DELETE FROM CHANNELS WHERE Id IN (%s)', join(',' => ('?') x @todel)); 
+      my $sth = $obj->{dbh}->prepare($sql);
+      if(!$sth->execute(@todel)) {
+          error sprintf("Couldn't execute query: %s.",$sth->errstr);
+      }
+      $deleteData += scalar @todel;
     }
 
-    # Remember the maximum Channelposition
-    $obj->{LastChannel} = $obj->_LastChannel;
-
-    con_msg($console, sprintf(gettext("Write %d channels into database."), $c));
+    # Delete unused entrys in DB 
+    if(scalar keys %$grp_data > 0) {
+      my @todel = keys(%$grp_data);
+      my $sql = sprintf('DELETE FROM CHANNELGROUPS WHERE Id IN (%s)', join(',' => ('?') x @todel)); 
+      my $sth = $obj->{dbh}->prepare($sql);
+      if(!$sth->execute(@todel)) {
+          error sprintf("Couldn't execute query: %s.",$sth->errstr);
+      }
+      #$deleteData += scalar @todel;
+    }
 
     # sort list with CA numerical
     my %CA;
@@ -417,6 +521,10 @@ sub readData {
                                 } else {
                                     $a cmp $b } } keys %CA;
 
+    $obj->_brandNewChannels($newChannels) if($newChannels);
+
+    con_msg($console, sprintf(gettext("There are %d channels inserted, %d channels updated, %d channels deleted into database."), $changedData, $updatedData, $deleteData));
+
     return 1;
 }
 # ------------------
@@ -549,7 +657,7 @@ sub NameToChannel {
     my $obj = shift || return error('No object defined!');
     my $name = shift || return undef;
 
-    my $sth = $obj->{dbh}->prepare('SELECT SQL_CACHE  Id from CHANNELS where UPPER(Name) = UPPER( ? )');
+    my $sth = $obj->{dbh}->prepare('SELECT SQL_CACHE Id from CHANNELS where UPPER(Name) = UPPER( ? )');
     $sth->execute($name)
         or return error sprintf("Couldn't execute query: %s.",$sth->errstr);
     my $erg = $sth->fetchrow_hashref();
@@ -562,7 +670,7 @@ sub PosToName {
     my $obj = shift || return error('No object defined!');
     my $pos = shift || return undef;
 
-    my $sth = $obj->{dbh}->prepare('SELECT SQL_CACHE  Name from CHANNELS where POS = ?');
+    my $sth = $obj->{dbh}->prepare('SELECT SQL_CACHE Name from CHANNELS where POS = ?');
     $sth->execute($pos)
         or return error sprintf("Couldn't execute query: %s.",$sth->errstr);
     my $erg = $sth->fetchrow_hashref();
@@ -575,7 +683,7 @@ sub PosToChannel {
     my $obj = shift || return error('No object defined!');
     my $pos = shift || return undef;
 
-    my $sth = $obj->{dbh}->prepare('SELECT SQL_CACHE  Id from CHANNELS where POS = ?');
+    my $sth = $obj->{dbh}->prepare('SELECT SQL_CACHE Id from CHANNELS where POS = ?');
     $sth->execute($pos)
         or return error sprintf("Couldn't execute query: %s.",$sth->errstr);
     my $erg = $sth->fetchrow_hashref();
@@ -590,7 +698,7 @@ sub ChannelGroupsArray {
     my $where = shift || '';
     $where = sprintf('WHERE %s', $where) if($where);
 
-    my $sql = sprintf('SELECT SQL_CACHE  %s, Id from CHANNELGROUPS %s order by Id', $field, $where);
+    my $sql = sprintf('SELECT SQL_CACHE %s, Id from CHANNELGROUPS %s order by Id', $field, $where);
     my $erg = $obj->{dbh}->selectall_arrayref($sql);
     return $erg;
 }
@@ -603,7 +711,7 @@ sub ChannelArray {
     my $where = shift || '';
     $where = sprintf('WHERE %s', $where) if($where);
 
-    my $sql = sprintf('SELECT SQL_CACHE  %s, POS from CHANNELS %s order by POS', $field, $where);
+    my $sql = sprintf('SELECT SQL_CACHE %s, POS from CHANNELS %s order by POS', $field, $where);
     my $erg = $obj->{dbh}->selectall_arrayref($sql);
     return $erg;
 }
@@ -631,7 +739,7 @@ sub ChannelIDArray {
     my $where = shift || '';
     $where = sprintf('WHERE %s', $where) if($where);
 
-    my $sql = sprintf('SELECT SQL_CACHE  %s, Id from CHANNELS %s order by POS', $field, $where);
+    my $sql = sprintf('SELECT SQL_CACHE %s, Id from CHANNELS %s order by POS', $field, $where);
     my $erg = $obj->{dbh}->selectall_arrayref($sql);
     return $erg;
 }
@@ -644,7 +752,7 @@ sub ChannelHash {
     my $where = shift || '';
     $where = sprintf('WHERE %s', $where) if($where);
 
-    my $sql = sprintf('SELECT SQL_CACHE  * from CHANNELS %s', $where);
+    my $sql = sprintf('SELECT SQL_CACHE * from CHANNELS %s', $where);
     my $erg = $obj->{dbh}->selectall_hashref($sql, $field);
     return $erg;
 }
@@ -655,7 +763,7 @@ sub ChannelToName {
     my $obj = shift || return error('No object defined!');
     my $id = shift || return undef;
 
-    my $sth = $obj->{dbh}->prepare('SELECT SQL_CACHE  Name from CHANNELS where Id = ?');
+    my $sth = $obj->{dbh}->prepare('SELECT SQL_CACHE Name from CHANNELS where Id = ?');
     $sth->execute($id)
         or return error sprintf("Couldn't execute query: %s.",$sth->errstr);
     my $erg = $sth->fetchrow_hashref();
@@ -668,7 +776,7 @@ sub ChannelToPos {
     my $obj = shift || return error('No object defined!');
     my $id = shift || return undef;
 
-    my $sth = $obj->{dbh}->prepare('SELECT SQL_CACHE  POS from CHANNELS where Id = ?');
+    my $sth = $obj->{dbh}->prepare('SELECT SQL_CACHE POS from CHANNELS where Id = ?');
     $sth->execute($id)
         or return error sprintf("Couldn't execute query: %s.",$sth->errstr);
     my $erg = $sth->fetchrow_hashref();
@@ -712,15 +820,6 @@ sub getChannelType {
 }
 
 # ------------------
-sub _LastChannel {
-# ------------------
-    my $obj = shift || return error('No object defined!');
-    my $sql = sprintf('SELECT SQL_CACHE  * from CHANNELS order by POS desc limit 1');
-    my $erg = $obj->{dbh}->selectrow_hashref($sql);
-    return $erg;
-}
-
-# ------------------
 sub newChannel {
 # ------------------
     my $self         = shift || return error('No object defined!');
@@ -747,7 +846,7 @@ sub editChannel {
         $cid = $self->PosToChannel($cid)
             unless(index($cid, '-') > -1);
 
-        my $sth = $self->{dbh}->prepare('SELECT SQL_CACHE  POS, Name, Frequency, Parameters, Source, Srate, VPID, APID, TPID, CA, SID, NID, TID, RID from CHANNELS where Id = ?');
+        my $sth = $self->{dbh}->prepare('SELECT SQL_CACHE POS, Name, Frequency, Parameters, Source, Srate, VPID, APID, TPID, CA, SID, NID, TID, RID from CHANNELS where Id = ?');
             $sth->execute($cid)
             or return con_err($console, sprintf(gettext("Channel '%s' does not exist in the database!"),$cid));
         $defaultData = $sth->fetchrow_hashref();
@@ -1041,7 +1140,7 @@ sub deleteChannel {
 
     my @channels  = reverse sort{ $a <=> $b } split(/[^0-9]/, $channelid);
 
-    my $sql = sprintf('SELECT SQL_CACHE  Id,POS,Name from CHANNELS where POS in (%s)', join(',' => ('?') x @channels)); 
+    my $sql = sprintf('SELECT SQL_CACHE Id,POS,Name from CHANNELS where POS in (%s)', join(',' => ('?') x @channels)); 
     my $sth = $self->{dbh}->prepare($sql);
     $sth->execute(@channels)
         or return con_err($console, sprintf("Couldn't execute query: %s.",$sth->errstr));
@@ -1093,31 +1192,26 @@ sub deleteChannel {
 sub _brandNewChannels {
 # ------------------
     my $obj = shift  || return error('No object defined!');
-    my $oldmaximumpos = shift || return;
-
-    my $sql = 'SELECT SQL_CACHE  * from CHANNELS where POS > ?'; 
-    my $sth = $obj->{dbh}->prepare($sql);
-    $sth->execute($oldmaximumpos)
-        or return error sprintf("Couldn't execute query: %s.",$sth->errstr);
-    my $erg = $sth->fetchall_hashref('POS');
+    my $attr = shift || return;
 
-    my $text;
-    foreach my $chpos (sort {$erg->{$a} <=> $erg->{$b}} keys %$erg) {
-        my $c = $erg->{$chpos};
-        $text .= sprintf(gettext('New %s channel: %s on position: %d %s'),
+    my @lines;
+    foreach my $id (keys %$attr) {
+        my $c = $attr->{$id};
+        push(@lines, sprintf(gettext('New %s channel: %s on position: %d %s'),
             ($c->{VPID}
                 ? gettext('TV')
                 : gettext('Radio')),
             $c->{Name},
             $c->{POS},
-            (($c->{CA} && $c->{CA} > 5) ? gettext('(encrypted)') : ''),
-        );
+            (($c->{CA} && (!is_numeric($c->{CA}) || $c->{CA} > 16)) ? gettext('(encrypted)') : ''),
+        ));
+        last if(25 < scalar @lines );
     }
 
     my $rm = main::getModule('REPORT');
     $rm->news(
-        sprintf(gettext('Found %d new channels!'), scalar keys %$erg),
-        $text,
+        sprintf(gettext('Found %d new channels!'), scalar keys %$attr),
+        join('\r\n',@lines),
         'clist',
         undef,
         'veryinteresting',
diff --git a/lib/XXV/MODULES/STREAM.pm b/lib/XXV/MODULES/STREAM.pm
index c4deab0..3fdce55 100644
--- a/lib/XXV/MODULES/STREAM.pm
+++ b/lib/XXV/MODULES/STREAM.pm
@@ -13,7 +13,7 @@ $SIG{CHLD} = 'IGNORE';
 # ------------------
 sub module {
 # ------------------
-    my $obj = shift || return error('No object defined!');
+    my $self = shift || return error('No object defined!');
     my $args = {
         Name => 'STREAM',
         Prereq => {
@@ -32,17 +32,17 @@ sub module {
                 required    => gettext('This is required!'),
             },
             method => {
-                description => gettext('Typ of streaming'),
+                description => gettext('Typ of stream recordings'),
                 default     => 'http',
                 type        => 'list',
                 choices     => [
                     [ gettext('HTTP Streaming'),      'http' ],
-                    [ gettext('Remote SMB/NFS share'),'smb' ],
+                    [ gettext('Remote SMB/NFS share'),'smb' ]
                 ],
                 required    => gettext('This is required!'),
             },
             mimetyp => {
-                description => gettext('Used mime type to deliver video streams'),
+                description => gettext('Used mime type of delivered playlist video streams'),
                 default     => 'video/x-mpegurl',
                 type        => 'string',
             },
@@ -62,6 +62,17 @@ sub module {
                 ],
                 required    => gettext("This is required!"),
             },
+            LiveAccessMethod => {
+                description => gettext('Method of connect live-tv stream from recorder.'),
+                default     => 'playlist',
+                type        => 'list',
+                required    => gettext('This is required!'),
+                choices     => [
+                    [ gettext('Send playlist'),'playlist'],
+                    [ gettext('Redirect HTTP request'),'redirect'],
+                    [ gettext('Relay stream as proxy'), 'proxy']
+                ],
+            },
             streamtype => {
                 description => gettext('Used live stream type'),
                 type        => 'list',
@@ -108,14 +119,14 @@ sub module {
             playrecord => {
                 description => gettext("Stream a recordings."),
                 short       => 'pre',
-                callback    => sub{ $obj->playrecord(@_) },
+                callback    => sub{ $self->playrecord(@_) },
                 DenyClass   => 'stream',
                 binary      => 'nocache'
             },
             livestream => {
                 description => gettext("Stream a channel 'cid'. This required the streamdev plugin!"),
                 short       => 'lst',
-                callback    => sub{ $obj->livestream(@_) },
+                callback    => sub{ $self->livestream(@_) },
                 DenyClass   => 'stream',
                 binary      => 'nocache'
             },
@@ -166,7 +177,7 @@ sub new {
 # ------------------
 sub init {
 # ------------------
-    my $obj = shift || return error('No object defined!');
+    my $self = shift || return error('No object defined!');
 
     1;
 }
@@ -175,7 +186,7 @@ sub init {
 # ------------------
 sub livestream {
 # ------------------
-    my $obj = shift || return error('No object defined!');
+    my $self = shift || return error('No object defined!');
     my $watcher = shift || return error('No watcher defined!');
     my $console = shift || return error('No console defined!');
     my $channel = shift || return con_err($console,gettext("No channel defined for streaming!"));
@@ -189,48 +200,66 @@ sub livestream {
     my $ch = $cmod->ToCID($channel);
     return $console->err(sprintf(gettext("This channel '%s' does not exist!"),$channel))
       unless($ch);
+    my $title = $cmod->ChannelToName($ch);
 
-    if($obj->{widget} ne 'external' && (!$params || !(exists $params->{player}))) {
+    if($self->{widget} ne 'external' && (!$params || !(exists $params->{player}))) {
       my $data = sprintf("?cmd=livestream&__player=1&data=%s",$ch);
 
       my $param = {
-          title => $cmod->ChannelToName($ch),
-          widget => $obj->{widget},
-          width  => $obj->{width},
-          height => $obj->{height},
+          title => $title,
+          widget => $self->{widget},
+          width  => $self->{width},
+          height => $self->{height},
       };
       return $console->player($data, $param);
     }
 
-    my $cpos = $cmod->ChannelToPos($ch);
+    #my $cpos = $cmod->ChannelToPos($ch);
     debug sprintf('Live stream with channel "%s"%s',
-        $cmod->ChannelToName($ch),
+        $title,
         ( $console->{USER} && $console->{USER}->{Name} ? sprintf(' from user: %s', $console->{USER}->{Name}) : "" )
         );
 
     $console->{nopack} = 1;
+    my $liveport = 3000;
+    my $request = sprintf("/%s/%s", $self->{streamtype}, $ch);
+    my $url = sprintf("http://%s:%d%s",$self->{host},$liveport,$request);
+    if($self->{LiveAccessMethod} eq 'redirect') {
+      debug(sprintf("Redirect to %s",$url));
+      $console->statusmsg(301,$url); 
+      return;
+    } elsif($self->{LiveAccessMethod} eq 'playlist') {
+      debug(sprintf("Send playlist with %s",$url));
+      my $data;
+      $data = "#EXTM3U\r\n";
+      $data .= $url;
+      $data .= "\r\n";
 
-    my $data;
-    $data = "#EXTM3U\r\n";
-    $data .= sprintf("http://%s:3000/%s/%d", $obj->{host},$obj->{streamtype}, $cpos);
-    $data .= "\r\n";
-     
-    my $arg;
-    $arg->{'attachment'} = sprintf("livestream-%s.m3u", $ch);
-    $arg->{'Content-Length'} = length($data);
+      my $arg;
+      $arg->{'attachment'} = sprintf("livestream-%s.m3u", $ch);
+      $arg->{'Content-Length'} = length($data);
 
-    return $console->out($data, $obj->{mimetyp}, %{$arg} );
+      return $console->out($data, $self->{mimetyp}, %{$arg} );
+    } elsif($self->{LiveAccessMethod} eq 'proxy') {
+      $console->proxy($self->{host},$liveport,$request,$self->{mimetyp}); 
+      return;
+    } else {
+      $console->err(gettext('Unknown access method!')); 
+    }
 }
 
 # ------------------
 sub playrecord {
 # ------------------
-    my $obj = shift || return error('No object defined!');
+    my $self = shift || return error('No object defined!');
     my $watcher = shift || return error('No watcher defined!');
     my $console = shift || return error('No console defined!');
     my $recid   = shift || return $console->err(gettext("No recording defined for streaming!"));
     my $params  = shift;
 
+    return $console->err(gettext("Can't stream files!"))
+      unless($console->can('stream'));
+
     my $rmod = main::getModule('RECORDS');
     my $result = $rmod->IdToData($recid)
         or return $console->err(gettext(sprintf("Couldn't find recording: '%s'", $recid)));
@@ -241,15 +270,15 @@ sub playrecord {
       $start = &text2frame($params->{start});
     }
 
-    if($obj->{widget} ne 'external' && (!$params || !(exists $params->{player}))) {
+    if($self->{widget} ne 'external' && (!$params || !(exists $params->{player}))) {
       my $data = sprintf("?cmd=playrecord&__player=1&data=%s",$recid);
       $data .= sprintf("&__start=%d", $start) if($start);
 
       my $param = {
           title => $result->{title},
-          widget => $obj->{widget},
-          width  => $obj->{width},
-          height => $obj->{height},
+          widget => $self->{widget},
+          width  => $self->{width},
+          height => $self->{height},
       };
       $param->{title} .= '~' . $result->{subtitle} if($result->{subtitle});
 
@@ -276,17 +305,10 @@ sub playrecord {
         ( $console->{USER} && $console->{USER}->{Name} ? sprintf(' from user: %s', $console->{USER}->{Name}) : "" )
         );
 
-    if($obj->{method} eq 'http') {
-      return $console->err(gettext("Can't stream files!"))
-        unless($console->can('stream'));
-
-      return $console->stream(\@files, $obj->{mimetyp}, $offset);
-
+    if($self->{method} eq 'http') {
+      return $console->stream(\@files, $self->{mimetyp}, $offset);
     } else {
 
-      return $console->err(gettext("Can't stream files!"))
-        unless($console->can('datei'));
-
       my $videopath = $rmod->{videodir};
 
       my $data;
@@ -294,7 +316,7 @@ sub playrecord {
       foreach my $file (@files) {
         $file =~ s/^$videopath//si;
         $file =~ s/^[\/|\\]//si;
-        my $URL = sprintf("%s/%s\r\n", $obj->{netvideo}, $file);
+        my $URL = sprintf("%s/%s\r\n", $self->{netvideo}, $file);
         $URL =~s/\//\\/g
         if($URL =~ /^\\\\/sig              # Samba \\host/xxx/yyy => \\host\xxx\yyy
         || $URL =~ /^[a-z]\:[\/|\\]/sig);  # Samba x:/xxx/yyy => x:\xxx\yyy
@@ -307,7 +329,7 @@ sub playrecord {
       $arg->{'attachment'} = sprintf("%s.m3u", $recid);
       $arg->{'Content-Length'} = length($data);
 
-      return $console->out($data, $obj->{mimetyp}, %{$arg} );
+      return $console->out($data, $self->{mimetyp}, %{$arg} );
     }
 }
 
diff --git a/lib/XXV/OUTPUT/Html.pm b/lib/XXV/OUTPUT/Html.pm
index 254c26d..429ac4e 100644
--- a/lib/XXV/OUTPUT/Html.pm
+++ b/lib/XXV/OUTPUT/Html.pm
@@ -24,6 +24,9 @@ sub module {
 #           'Template'  => 'Front-end module to the Template Toolkit',
 #           'Compress::Zlib'  => 'Interface to zlib compression library',
             'HTML::TextToHTML' => 'convert plain text file to HTML. ',
+            'IO::Socket::INET'  => 'Object interface for AF_INET domain sockets',
+            'IO::Select'        => 'OO interface to the select system call',
+            'IO::Handle'        => 'Supply object methods for I/O handles'
         },
         Description => gettext('This receives and sends HTML messages.'),
         Version => (split(/ /, '$Revision$'))[1],
@@ -426,6 +429,10 @@ sub statusmsg {
             if(exists $s->{$state});
 
         my $arg = {};
+
+        $arg->{'Location'} = $msg
+            if($state == 301);
+
         $arg->{'WWW-Authenticate'} = "Basic realm=\"xxvd\""
             if($state == 401);
 
@@ -762,6 +769,149 @@ sub _stream {
     return 0;
 }
 
+sub proxy {
+    my $self = shift || return error('No object defined!');
+    my $streamdev_host = shift || return error('No host defined!');
+    my $streamdev_port = shift || return error('No port defined!');
+    my $request = shift || return error('No request defined!');
+    my $mimetyp = shift || return error('No mimetyp defined!');
+
+    if($self->{browser}->{Method} eq 'HEAD') {
+       # Fake response, don't bother streamdev recorder
+       $self->statusmsg(200,'','',$mimetyp);
+#      Call streamdev to query channel state with HTTP-Request HEAD
+#      if($self->_proxy($handle,$streamdev_host,$streamdev_port,"HEAD " . $request . "\r\n\r\n")) {
+#        undef $self->{handle};
+#        undef $self->{output};
+#      } else {
+#        $self->status404($channelid,$!);
+#      }
+      return;
+    }
+    # Start proxy
+    my $handle = $self->{handle};
+    my $child = fork(); 
+    if ($child < 0) {
+      error("Can't create proxy process for streaming : " . $!);
+      return $self->status404($request,$!);
+    }
+    elsif ($child > 0) {
+      debug("Create proxy process for streaming");
+      $self->{'sendbytes'} = 0;
+    }
+    elsif ($child == 0) {
+      $self->{dbh}->{InactiveDestroy} = 1;
+      eval { 
+        local $SIG{'__DIE__'};
+        lg(sprintf("Send request %s",$request));
+        unless($self->_proxy($handle,$streamdev_host,$streamdev_port,"GET " . $request . "\r\n\r\n")) {
+          $handle->close();
+        }
+      };
+
+      error($@) if $@;
+      exit 0;
+    }
+
+    undef $self->{handle};
+    undef $self->{output};
+}
+
+sub _proxy {
+    my $self = shift || return error('No object defined!');
+    my $handle = shift;
+    my $streamdev_host = shift;
+    my $streamdev_port = shift;
+    my $request = shift;
+
+    my $r;
+    my $bytes;
+    my $buf="";
+    my $bExit = 0;
+    my $tousage = 0;
+    my $fromusage = 0;
+    my $peer = 0;
+
+    binmode $handle;
+    lg(sprintf("Try to connect %s:%d",$streamdev_host,$streamdev_port));
+    my $streamdev = IO::Socket::INET->new (
+           PeerAddr => $streamdev_host,
+           PeerPort => $streamdev_port);
+    unless($streamdev) {
+      error(sprintf("Could'nt connect to %s:%d",$streamdev_host,$streamdev_port));
+      return 0;
+    }
+    binmode $streamdev;
+
+    $handle->blocking(0);
+    $streamdev->blocking(0);
+
+    my $select = new IO::Select();
+    $select->add($streamdev);
+    $select->add($handle);
+
+    autoflush $streamdev;
+    autoflush $handle;
+
+    # Send HTTP Request to get data from streamdev client
+    print $streamdev $request;
+
+    # Relay data from streamdev to calling host
+    while (my @ready = $select->can_read()) {
+      foreach my $fd (@ready) {
+        $peer = 1;
+        if ($fd == $handle) {
+          do {
+            $r = 0;
+            $bytes = sysread( $handle, $buf, 1500 );
+            if($bytes) {
+              $tousage += $bytes;  
+              $peer = $streamdev->peername;
+              $r = $streamdev->send($buf,0,$peer)
+                if($peer);
+              $tousage -= $r if($r);
+            }
+#           lg(sprintf("Read host bytes %d (%d)",$bytes,$r));
+          } while $r && $bytes > 0;
+          if (!$peer || $tousage < -100000 || $tousage > 100000) {
+            $bExit = 2; 
+          }
+        }
+        elsif ($fd == $streamdev) {
+          do {
+            $r = 0;
+            $bytes = sysread( $streamdev, $buf, 1500 );
+            if($bytes) {
+              $fromusage += $bytes;  
+              my $peer = $handle->peername;
+              $r = $handle->send($buf,0,$peer)
+                if($peer);
+              $fromusage -= $r if($r);
+              }
+          } while $r && $bytes > 0;
+          if ($fromusage < -100000 || $fromusage > 100000) {
+            $bExit = 1; 
+          }
+        } else {
+          $select->remove($fd);
+          $fd->close();
+          $bExit = 1;
+        }
+      }
+     if($bExit) {
+       lg(sprintf("EOF proxy send data %s:%d (%d)",$streamdev_host,$streamdev_port, $bExit));
+       last;
+     }
+    }
+    lg(sprintf("Exit proxy send data %s:%d",$streamdev_host,$streamdev_port)) unless($bExit);
+    $select->remove($streamdev);
+    $select->remove($handle);
+
+    $streamdev->close();
+    $handle->close();
+    return 1;
+}
+
 # ------------------
 sub image {
 # ------------------