Fernsehprogramm DOIF (aktuell und primetime | non blocking | minimaler traffic)

[MadMax-FHEM]

Ist wohl ein "generelles" Problem: https://forum.fhem.de/index.php/topic,131002.msg1252056.html#msg1252056

Gruß, Joachim

[Per]

Meine Güte, was für ein blöder Fehler, aus $_channelFilter wurde irgendwann mal $_channelFilter_channelFilter. Und dann filtert natürlich nichts mehr.
Jetzt halten sich die Readings in den gewünschten Grenzen.
Der zum Test geladene Code hat mit den bereits runtergeladenen Files gearbeitet, deshalb hat der auch nichts gefiltert.
Jetzt läuft ein Test mit automatisch erstelltem Filter und der scheint zu klappen. Zumindest beim Neustart. Wobei beim Erweitern des Filters nix passiert, wahrscheinlich weil das Alter der Datei kleiner 1 Tag ist. Also morgen um die gleiche Zeit ein Update.

Und falls alles nicht funktioniert, bekommt man wenigstens bequem die Liste zum Einfügen

Ist wohl ein "generelles" Problem: https://forum.fhem.de/index.php/topic,131002.msg1252056.html#msg1252056

Schau mal, wer den Thread eröffnet hat

Was mir aber beim rum spielen aufgefallen ist, ist das die Attribute nicht übernommen werden, wenn man die bei RAW Definition einfügt.

Könnte daran liegen, dass das UserAttr eine Gedenksekunde braucht, um angelegt zu werden. Versuch es mal ein zweites Mal, ob es dann klappt.

Wichtig: "Server" ist alphabetisch vor "userattr", da muss man beim row-Export drauf achten.

[MadMax-FHEM]

Schau mal, wer den Thread eröffnet hat

Ja, hatte ich dann auch bemerkt

Gruß, Joachim

[Per]

Wenn es morgen die rytecDE_Basic sauber aktualisiert, würde ich noch folgende Änderungen vorschlagen/einpflegen:
- deletereading $SELF (next|prime)_.* 200000
- Readings nach Channel_mode_XXX erstellen
- title -> 1title, stitle -> 2stitle, desc -> 3desc. Wegen der Lesbarkeit möchte mein innerer Monk das so

[mumpitzstuff]

Deletereading ist sehr ungünstig denke ich, weil dann erst alles verschwindet und alle Reading danach neu befüllt werden müssen. Bei langsamen Systemen dauert das eine Weile und dann ist die ReadingGroup erst leer und wird neu befüllt. Und sowas hier, würde dann gar nicht mehr funktionieren = ewig viele Events: attr doif_TEST event-on-change-reading .*
Mit der Reihenfolge der Attribute habe ich noch etwas rum gespielt, aber irgendwie greift das nicht, egal welche Reihenfolge ich bei den Attributen verwende. Änderungen in der uiTable werden mit RAW defintion nicht übernommen. Keine Ahnung warum. Ich muss damit vielleicht noch etwas auf dem Testsystem rum spielen. Übrigens wenn das Device neu angelegt wird, dann scheint noch alles übernommen zu werden. Anders sieht es aber bei Änderungen aus. Wenn ich quasi in einem Editor das exportierte RAW ändere und dann komplett neu einspielen will, dann wird immer nur ein Teil davon übernommen.

Folgende Dinge musste ich aktuell aber schon wieder zurück bauen:

$TR{0,($NUM_CHANNELS + 2)} = ...

Aktionen wie diese funktionieren bei mir nicht. Das Format wird einfach gar nicht mehr übernommen. Vielleicht muss ich da noch mal nachfragen, weshalb das so ist.

Wenn ich ein Regex in ein Attribut schreibe und das z.B. so aussieht: ^(?:DasErste\.|ZDF\.)
Dann fliegt das \. irgendwie später raus. Ich bin mir noch nicht ganz sicher was da passiert, vermute aber, dass das \ irgendwie raus fliegt und dann z.b. ZDF ud ZDFinfo durchgelassen werden, obwohl ich nur ZDF haben möchte.

PS: Kannst du mir bitte noch ein kleines Bild deiner Layoutänderungen zukommen lassen?

Meine aktuelle Fassung sieht deshalb wieder so aus:

Code Auswählen Erweitern

defmod doif_TEST DOIF subs\
{\
  use utf8;;\
  use Date::Parse;;\
  ## sudo apt-get install libxml-bare-perl\
  use XML::Bare 0.53 qw(forcearray);;\
  use Blocking;;\
  ##use Encode qw(encode_utf8 decode_utf8);;\
\
  ### CONFIG AREA ###\
  $_channelFilter = qr/^(?:DasErste\.|ZDF\.|Sat1\.|RTL2?\.|Pro(Sieben|SiebenMaxx)\.|DMax\.|Vox\.|KabelEins(?:Classic|Doku)?\.|ntv\.|Sixx\.|TLC\.|N24Doku\.|SonyEntertainmentTV\.|AandE\.|TNT(?:Serie|Film)\.|AnimalPlanet\.|History\.|Kinowelt\.|NatGeoHD\.|PLANET\.|Silverline\.|13thStreet\.|AXN\.|SciFi\.)/;;\
  ## telnet port must not be password protected (open)\
  ## this is used as fallback if telnet port cannot created automatically\
  $_telnetPort = 7072;;\
  ## can be used to adjust the program times (mostly not needed!)\
  $_timeAdjust = 0;;\
  $_path = '/opt/fhem';;\
  $_dataFile = $_path.'/rytecDE_Basic';;\
  $_server = AttrVal("$SELF", "server", "http://www.xmltvepg.nl");;\
  ## enable/disable unused channel filtering on filemerge (enabled = small file and less readings = faster)\
  $_filterChannels = 1;;\
  ## enable/disable updates based on starttimes (enabled = update channels only if needed = faster)\
  $_updateBasedOnStarttimes = 1;;\
  ## enable/disable use of Time::Piece (timepiece is faster but not installed on some systems)\
  $_timepiece = 0;;\
\
  ## internal variables\
  $_startTimes = ();;\
\
\
  sub filterText($)\
  {\
    my $text = shift;;\
\
    $text =~ s/[\x{0022}\x{0060}\x{003b}\x{0027}\"\`;;\'\r]//g;;\
    ##$text =~ s/[\"\`;;\'\r]//g;;\
    $text =~ s/[\n]/<br>/g;;\
\
    return $text;;\
  }\
\
  sub xmltv2epoch($)\
  {\
    my $t = shift;;\
\
    if ($_timepiece)\
    {\
      use Time::Piece;;\
\
      ## fast version\
      return Time::Piece->strptime($t, '%Y%m%d%H%M%S %z')->epoch;;\
    }\
    else\
    {\
      ## slow but compatible version\
      substr($t, 8, 0) = 'T';;\
\
      return str2time($t);;\
    }\
  }\
\
  sub FmtDateTime($)\
  {\
    my @t = localtime(shift);;\
    return sprintf("%04d-%02d-%02d %02d:%02d:%02d", $t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]);;\
  }\
\
  sub createTelnet($)\
  {\
    my $device = shift;;\
    my $telnet = undef;;\
\
    foreach my $d (sort keys %::defs) \
    {\
      next if ($d !~ /telnetForTvUpdateFn_\d+/);;\
      my $h = $::defs{$d};;\
      next if (!$h->{TYPE} || $h->{TYPE} ne 'telnet' || $h->{SNAME});;\
      next if (::AttrVal($d, 'allowfrom', '127.0.0.1') ne '127.0.0.1');;\
      next if ($h->{DEF} !~ /^\d+( global)?$/);;\
      next if ($h->{DEF} =~ /IPV6/);;\
\
      $telnet = $d;;\
      last;;\
    }    \
\
    if (!defined($telnet))\
    {\
      $telnet = 'telnetForTvUpdateFn_'.time();;\
      my $ret = ::CommandDefine(undef, "-temporary $telnet telnet 0");;\
\
      if (defined($ret))\
      {\
        ::Log3 $device, 1, $device.': Cannot create telnet port ('.$ret.')';;\
        return undef;;\
      }\
\
      $::attr{$telnet}{room} = 'hidden';;\
      $::attr{$telnet}{allowfrom} = '127.0.0.1';;\
    }\
\
    return $::defs{$telnet}{PORT};;\
  }\
\
  sub tvParse($$$)\
  {\
    my ($device, $mode, $port) = @_;;\
    my $obj;;\
    my $xml;;\
    my $lastChannel = '';;\
    my $reading = '';;\
    my $i = 999;;\
    my $n = 999;;\
    my $k = 0;;\
    my $primeTime = substr(FmtDateTime(time() + $_timeAdjust), 0, 11).'20:14:00';;\
    my $sendTelnet = '';;\
\
    $obj = XML::Bare->new(file => $_dataFile);;\
    $xml = $obj->parse();;\
\
    if (!$@)\
    {\
      my $old = time() + $_timeAdjust;;\
\
      foreach (@{forcearray($xml->{'tv'}{'programme'})})\
      {\
        my $stop = xmltv2epoch($_->{'stop'}{'value'});;\
\
        ## filter old stuff\
        if ($stop > $old)\
        {\
          if ($lastChannel ne $_->{'channel'}{'value'})\
          {\
            $lastChannel = $_->{'channel'}{'value'};;\
            $reading = $_->{'channel'}{'value'};;\
            $reading =~ s/[\.\s]//g;;\
            $reading =~ s/de$//;;\
            $n = 0;;\
\
            if ((0 == $_updateBasedOnStarttimes) || !exists($_startTimes{$reading}) || ($_startTimes{$reading} <= $old))\
            {\
              $i = 0;;\
\
              if (0 != $_updateBasedOnStarttimes)\
              {\
                $_startTimes{$reading} = $stop;;\
              }\
            }\
            else\
            {\
              ::Log3 $device, 4, $device.': '.$reading.' is blocked because actual program is not finished (start: '.$_startTimes{$reading}.', old: '.$old.').';;\
            }\
          }\
\
          if ($i < 3 && 'next' eq $mode)\
          {\
            my $fi = sprintf("%03d", $i);;\
            my $start = xmltv2epoch($_->{'start'}{'value'});;\
            my $readingName;;\
            my $readingValue;;\
\
            $readingName = 'next_'.$reading.'_'.$fi.'_bdate';;\
            $readingValue = substr(FmtDateTime($start), 0, 10);;\
            $sendTelnet .= ";;setreading $device $readingName $readingValue";;\
\
            $readingName = 'next_'.$reading.'_'.$fi.'_btime';;\
            $readingValue = substr(FmtDateTime($start), 11, 8);;\
            $sendTelnet .= ";;setreading $device $readingName $readingValue";;\
\
            $readingName = 'next_'.$reading.'_'.$fi.'_title';;\
            $readingValue = filterText(@{forcearray($_->{'title'})}[0]->{'value'});;\
            $sendTelnet .= ";;setreading $device $readingName $readingValue";;\
\
            $readingName = 'next_'.$reading.'_'.$fi.'_stitle';;\
            if (exists($_->{'sub-title'}{'value'}))\
            {\
              $readingValue = filterText($_->{'sub-title'}{'value'});;\
            }\
            else\
            {\
              $readingValue = 'na';;\
            }\
            $sendTelnet .= ";;setreading $device $readingName $readingValue";;\
\
            $readingName = 'next_'.$reading.'_'.$fi.'_desc';;\
            if (exists($_->{'desc'}{'value'}))\
            {\
              $readingValue = filterText($_->{'desc'}{'value'});;\
            }\
            else\
            {\
              $readingValue = 'na';;\
            }\
            $sendTelnet .= ";;setreading $device $readingName $readingValue";;\
\
            $k++;;\
            $i++;;\
          }\
\
          if ($n < 3 && 'prime' eq $mode)\
          {\
            my $start = xmltv2epoch($_->{'start'}{'value'});;\
            my $fmtStart = FmtDateTime($start);;\
            my $bdate = substr($fmtStart, 0, 10);;\
            my $btime = substr($fmtStart, 11, 8);;\
\
            if ($bdate.' '.$btime gt $primeTime)\
            {\
              my $fn = sprintf("%03d", $n);;\
              my $readingName;;\
              my $readingValue;;\
\
              $readingName = 'prime_'.$reading.'_'.$fn.'_bdate';;\
              $readingValue = substr(FmtDateTime($start), 0, 10);;\
              $sendTelnet .= ";;setreading $device $readingName $readingValue";;\
\
              $readingName = 'prime_'.$reading.'_'.$fn.'_btime';;\
              $readingValue = substr(FmtDateTime($start), 11, 8);;\
              $sendTelnet .= ";;setreading $device $readingName $readingValue";;\
\
              $readingName = 'prime_'.$reading.'_'.$fn.'_title';;\
              $readingValue = filterText(@{forcearray($_->{'title'})}[0]->{'value'});;\
              $sendTelnet .= ";;setreading $device $readingName $readingValue";;\
\
              $readingName = 'prime_'.$reading.'_'.$fn.'_stitle';;\
              if (exists($_->{'sub-title'}{'value'}))\
              {\
                $readingValue = filterText($_->{'sub-title'}{'value'});;\
              }\
              else\
              {\
                $readingValue = 'na';;\
              }\
              $sendTelnet .= ";;setreading $device $readingName $readingValue";;\
\
              $readingName = 'prime_'.$reading.'_'.$fn.'_desc';;\
              if (exists($_->{'desc'}{'value'}))\
              {\
                $readingValue = filterText($_->{'desc'}{'value'});;\
              }\
              else\
              {\
                $readingValue = 'na';;\
              }\
              $sendTelnet .= ";;setreading $device $readingName $readingValue";;\
\
              $k++;;\
              $n++;;\
            }\
          }\
\
          if ($k >= 10)\
          {\
            ##::Log3 $device, 5, $device.': '.encode_utf8($sendTelnet);;\
            \
            `perl /opt/fhem/fhem.pl $port "$sendTelnet"`;;\
            \
            $k = 0;;\
            $sendTelnet = '';;\
          }\
        }\
      }\
\
      if ('' ne $sendTelnet)\
      {\
        ##::Log3 $device, 5, $device.': '.encode_utf8($sendTelnet);;\
\
        `perl /opt/fhem/fhem.pl $port "$sendTelnet"`;;\
      }\
    }\
\
    return %{$_startTimes};;\
  }\
\
  sub tvMerge($;;$)\
  {\
    my ($dstName, $srcName) = @_;;\
    my $fh;;\
    my $dst;;\
    my $src;;\
    my $start = '';;\
    my $channels1 = '';;\
    my $channels1_flt = '';;\
    my $channels2 = '';;\
    my $channels2_flt = '';;\
    my $programms1 = '';;\
    my $programms1_flt = '';;\
    my $programms2 = '';;\
    my $programms2_flt = '';;\
    my $end = '';;\
    my $pos;;\
\
    open($fh, '<', $dstName) or die "Can't open file $!";;\
    read($fh, $dst, -s $fh);;\
    close($fh);;\
\
    if (defined($srcName))\
    {\
      open($fh, '<', $srcName) or die "Can't open file $!";;\
      read($fh, $src, -s $fh);;\
      close($fh);;\
    }\
\
    if (-1 != ($pos = index($dst, '<channel ')))\
    {\
      $start = substr($dst, 0, $pos);;\
    }\
\
    if (-1 != ($pos = rindex($dst, '</programme>')))\
    {\
      $end = substr($dst, $pos + 12);;\
    }\
\
    while ($dst =~ /(\s*<channel\s.*?id="(.*?)".*?<\/channel>)/sg)\
    {\
      if (0 != $_filterChannels)\
      {\
        $_ = $1;;\
\
        if ($2 =~ $_channelFilter)\
        {\
          $channels1_flt .= $_;;\
        }\
      }\
      else\
      {\
        $channels1 .= $1;;\
      }\
    }\
\
    while ($dst =~ /(\s*<programme\s.*?channel="(.*?)".*?<\/programme>)/sg)\
    {\
      if (0 != $_filterChannels)\
      {\
        $_ = $1;;\
\
        if ($2 =~ $_channelFilter)\
        {\
          $programms1_flt .= $_;;\
        }\
      }\
      else\
      {\
        $programms1 .= $1;;\
      }\
    }\
\
    if (defined($srcName))\
    {\
      while ($src =~ /(\s*<channel\s.*?id="(.*?)".*?<\/channel>)/sg)\
      {\
        if (0 != $_filterChannels)\
        {\
          $_ = $1;;\
\
          if ($2 =~ $_channelFilter)\
          {\
            $channels2_flt .= $_;;\
          }\
        }\
        else\
        {\
          $channels2 .= $1;;\
        }\
      }\
\
      while ($src =~ /(\s*<programme\s.*?channel="(.*?)".*?<\/programme>)/sg)\
      {\
        if (0 != $_filterChannels)\
        {\
          $_ = $1;;\
\
          if ($2 =~ $_channelFilter)\
          {\
            $programms2_flt .= $_;;\
          }\
        }\
        else\
        {\
          $programms2 .= $1;;\
        }\
      }\
    }\
\
    if (0 != $_filterChannels)\
    {\
      open($fh, '>', $dstName) or die "Can't open file $!";;\
\
      if (defined($srcName))\
      {\
        print $fh $start.$channels1_flt.$channels2_flt.$programms1_flt.$programms2_flt.$end;;\
      }\
      else\
      {\
        print $fh $start.$channels1_flt.$programms1_flt.$end;;\
      }\
\
      close($fh);;\
    }\
    else\
    {\
      open($fh, '>', $dstName) or die "Can't open file $!";;\
\
      if (defined($srcName))\
      {\
        print $fh $start.$channels1.$channels2.$programms1.$programms2.$end;;\
      }\
      else\
      {\
        print $fh $start.$channels1.$programms1.$end;;\
      }\
\
      close($fh);;\
    }\
  }\
\
  sub tvDownload()\
  {\
    my $output = '';;\
\
    ## other server see below\
    $output .= qx(wget $_server/rytecDE_Basic.xz -O $_path/rytecDE_Basic.xz 2>&1);;\
    $output .= qx(xz -df $_path/rytecDE_Basic.xz 2>&1);;\
\
    if (0 != $_filterChannels)\
    {\
      tvMerge($_dataFile);;\
    }\
\
    return $output;;\
  }\
\
  sub tvDownloadMerge()\
  {\
    my $output = '';;\
\
    ## other server\
    ## http://www.xmltvepg.nl/rytecDE_Basic.xz\
    ## http://91.121.106.172/~rytecepg/epg_data/rytecDE_Basic.xz\
    ## http://rytecepg.epgspot.com/epg_data/rytecDE_Basic.xz\
    ## http://epg.vuplus-community.net/rytecDE_Basic.xz\
    ## http://www.xmltvepg.nl/rytecDE_Common.xz\
    ## http://91.121.106.172/~rytecepg/epg_data/rytecDE_Common.xz\
    ## http://rytecepg.epgspot.com/epg_data/rytecDE_Common.xz\
    ## http://epg.vuplus-community.net/rytecDE_Common.xz\
    ## http://www.xmltvepg.nl/rytecDE_SportMovies.xz\
    ## http://91.121.106.172/~rytecepg/epg_data/rytecDE_SportMovies.xz\
    ## http://rytecepg.epgspot.com/epg_data/rytecDE_SportMovies.xz\
    $output .= qx(wget $_server/rytecDE_Basic.xz -O $_path/rytecDE_Basic.xz 2>&1);;\
    $output .= qx(xz -df $_path/rytecDE_Basic.xz 2>&1);;\
    $output .= qx(wget $_server/rytecDE_Common.xz -O $_path/rytecDE_Common.xz 2>&1);;\
    $output .= qx(xz -df $_path/rytecDE_Common.xz 2>&1);;\
\
    tvMerge($_dataFile, $_path.'/rytecDE_Common');;\
\
    ## download and merge other files here if needed\
\
    return $output;;\
  }\
\
  sub startDownload($)\
  {\
    my $name = shift;;\
\
    ## prevent download spamming\
    if (-e $_dataFile)\
    {\
      my $ftime = ((time() - (stat($_dataFile))[9]) / 60.0 / 60.0 / 24.0);;\
\
      if ($ftime < 1.0)\
      {\
        ::Log3 $name, 1, $name.': Download of TV data skipped because file is not older than 1 day ('.($ftime).').';;\
        return;;\
      }\
    }\
\
    if (defined($_blockingcalls{PID_DOWNLOAD}))\
    {\
      ::Log3 $name, 3, $name.': Blocking call already running (download).';;\
\
      ::BlockingKill($_blockingcalls{PID_DOWNLOAD});;\
    }\
\
    $_blockingcalls{PID_DOWNLOAD} = ::BlockingCall('DOIF::doDownload', $name, 'DOIF::endDownload', 300, 'DOIF::abortDownload', $name);;\
  }\
\
  sub DOIF::doDownload($)\
  {\
    my $name = shift;;\
    my $output = '';;\
\
    $output = tvDownloadMerge();;\
\
    return $name.'|'.$output;;\
  }\
  \
  sub DOIF::endDownload($)\
  {\
    my ($name, $output) = split("\\|", shift);;\
\
    ::Log3 $name, 5, $name.': '.$output;;\
    ::Log3 $name, 4, $name.': Blocking call finished to download tv data.';;\
\
    delete($_blockingcalls{PID_DOWNLOAD});;\
  }\
\
  sub DOIF::abortDownload($)\
  {\
    my $name = shift;;\
\
    delete($_blockingcalls{PID_DOWNLOAD});;\
\
    ::Log3 $name, 1, $name.': Blocking call aborted (download).';;\
  }\
\
  sub startParse($$)\
  {\
    my ($name, $mode) = @_;;\
    my $port;;\
\
    if (defined($_blockingcalls{PID_PARSE}))\
    {\
      ::Log3 $name, 3, $name.': Blocking call already running (parse).';;\
\
      ::BlockingKill($_blockingcalls{PID_PARSE});;\
    }\
\
    $port = createTelnet($name);;\
    $port = $_telnetPort if (!defined($port));;\
\
    $_blockingcalls{PID_PARSE} = ::BlockingCall('DOIF::doParse', $name.'|'.$mode.'|'.$port, 'DOIF::endParse', 300, 'DOIF::abortParse', $name);;\
  }\
\
  sub DOIF::doParse($)\
  {\
    my ($name, $mode, $port) = split("\\|", shift);;\
    my $ret = $name;;\
    my %startTimes = tvParse($name, $mode, $port);;\
\
    foreach (keys(%startTimes))\
    {\
      $ret .= '|'.$_.'|'.$startTimes{$_};;\
    }\
\
    return $ret;;\
  }\
\
  sub DOIF::endParse($)\
  {\
    my ($name, @startTimes) = split("\\|", shift);;\
\
    for (my $i = 0;; $i < (scalar(@startTimes) / 2);; $i += 2)\
    {\
      $_startTimes{$startTimes[$i]} = $startTimes[$i + 1];;\
    }\
\
    ::Log3 $name, 4, $name.': Blocking call finished to parse tv data.';;\
\
    delete($_blockingcalls{PID_PARSE});;\
  }\
\
  sub DOIF::abortParse($)\
  {\
    my $name = shift;;\
\
    delete($_blockingcalls{PID_PARSE});;\
\
    ::Log3 $name, 1, $name.': Blocking call aborted (parse).';;\
  }\
}\
init\
{\
  startDownload("$SELF");;\
  set_Exec('init_next', 300, 'startParse("$SELF", "next")');;\
  set_Exec('init_prime', 600, 'startParse("$SELF", "prime")');;\
}\
{\
  if ([00:05|Mo Do])\
  {\
    startDownload("$SELF");;\
  }\
\
  if ([+00:15])\
  {\
    startParse("$SELF", 'next');;\
  }\
\
  if ([00:30])\
  {\
    startParse("$SELF", 'prime');;\
  }\
}
attr doif_TEST userattr server
attr doif_TEST alias Aktuelles TV-Programm
attr doif_TEST event-on-change-reading .*
attr doif_TEST room TV
attr doif_TEST server http://www.xmltvepg.nl
attr doif_TEST uiTable {\
  package ui_Table;;\
\
  $SHOWNOSTATE = 1;;\
  $ATTRIBUTESFIRST = 1;;\
\
  ## 29 normal channels, 2 heading lines and 29 prime channels
  ## 31 = 29 (normal channels) + 2 (headings)
  ## 60 = 29 (normal channels) + 2 (headings) + 29 (prime channels)
  ## 30 = 29 (normal channels) + 1 (first heading)
  $TR{0,31} = "style='color:yellow;;text-align:center;;font-weight:bold;;font-size:18px'";;\
  $TD{0..29,31..60}{2,4} = "style='font-size:16px;;border-right-style:solid;;border-color:#CCCCCC;;border-right-width:1px;;'";;\
  $TD{0..29,31..60}{0} = "align='center' style='border-right-style:solid;;border-color:#CCCCCC;;border-right-width:1px;;'";;\
  $TD{0..60}{1,3,5,6} = "style='font-size:16px;;'";;\
  $TD{30}{0..6} = "style='border-top-style:solid;;border-bottom-style:solid;;border-color:#CCCCCC;;border-top-width:1px;;border-bottom-width:1px;;'";;\
\
  sub showIcon\
  {\
    my ($icon, $device, $state) = @_;;\
\
    if (defined($device) && defined($state))\
    {\
      return "<a href=\"$::FW_ME?cmd=set $device $state$::FW_CSRF\">".ICON("tv/$icon")."</a>";;\
    }\
    else\
    {\
      return ICON("tv/$icon");;\
    }\
  }\
\
  sub showIconIP\
  {\
    my ($icon, $device, $state) = @_;;\
\
    if (defined($device) && defined($state))\
    {\
      return "<a href=\"". ::ReadingsVal("$SELF","$device","") =~ s/.state/$state/r ."\" target=\"IPTV\">".ICON("tv/$icon")."</a>";;\
    }\
    else\
    {\
      return ICON("tv/$icon");;\
    }\
  }\
\
  sub unfold\
  {\
    my ($title, $desc) = @_;;\
\
    $title = 'na' if (!defined($title));;\
    $desc = 'na'."\n\n".'na' if (!defined($desc));;\
\
    $title =~ s/(.{1,45}|\S{46,})(?:\s[^\S\r\n]*|\Z)/$1<br>/g;;\
    $desc =~ s/<br>/\n/g;;\
    $desc =~ s/(.{1,65}|\S{66,})(?:\s[^\S\r\n]*|\Z)/$1<br>/g;; \
    $desc =~ s/[\r\'\"]/ /g;;\
    $desc =~ s/[\n]|\\n/<br>/g;;\
\
    return "<a href=\"#!\" onclick=\"FW_okDialog(';".$desc."';)\">".$title."</a>";;\
  }\
}\
\
## parameter: device name, mode (next or prime), channel name (see xml data file), icon name (filename of channel logo)\
DEF TPL_TV(showIcon("$4",undef,undef)|substr([$1:$2_$3_000_btime],0,5)|unfold([$1:$2_$3_000_title],[$1:$2_$3_000_stitle]."\n\n".[$1:$2_$3_000_desc])|substr([$1:$2_$3_001_btime],0,5)|unfold([$1:$2_$3_001_title],[$1:$2_$3_001_stitle]."\n\n".[$1:$2_$3_001_desc])|substr([$1:$2_$3_002_btime],0,5)|unfold([$1:$2_$3_002_title],[$1:$2_$3_002_stitle]."\n\n".[$1:$2_$3_002_desc]))\
\
## parameter: device name, mode (next or prime), channel name (see xml data file), icon name (filename of channel logo), device name for set command, command\
## example: TPL_TVSET($SELF,next,DasErste,ard,<ir blaster device>,<ir blaster command>)\
DEF TPL_TVSET(showIcon("$4","$5","$6")|substr([$1:$2_$3_000_btime],0,5)|unfold([$1:$2_$3_000_title],[$1:$2_$3_000_stitle]."\n\n".[$1:$2_$3_000_desc])|substr([$1:$2_$3_001_btime],0,5)|unfold([$1:$2_$3_001_title],[$1:$2_$3_001_stitle]."\n\n".[$1:$2_$3_001_desc])|substr([$1:$2_$3_002_btime],0,5)|unfold([$1:$2_$3_002_title],[$1:$2_$3_002_stitle]."\n\n".[$1:$2_$3_002_desc]))\
\
## parameter: device name, mode (next or prime), channel name (see xml data file), icon name (filename of channel logo), device name for set command, command\
## example: TPL_TVIP($SELF,next,DasErste,ard,VIEW1,29438503040)\
DEF TPL_TVIP(showIconIP("$4","$5","$6")|substr([$1:$2_$3_000_btime],0,5)|unfold([$1:$2_$3_000_title],[$1:$2_$3_000_stitle]."\n\n".[$1:$2_$3_000_desc])|substr([$1:$2_$3_001_btime],0,5)|unfold([$1:$2_$3_001_title],[$1:$2_$3_001_stitle]."\n\n".[$1:$2_$3_001_desc])|substr([$1:$2_$3_002_btime],0,5)|unfold([$1:$2_$3_002_title],[$1:$2_$3_002_stitle]."\n\n".[$1:$2_$3_002_desc]))\
\
"Sender"|"ab"|"Aktuelle Sendung"|"ab"|"Nächste Sendung"|"ab"|"Sendung"\
TPL_TV($SELF,next,DasErste,ard)\
TPL_TV($SELF,next,ZDF,zdf)\
TPL_TV($SELF,next,Sat1,sat1)\
TPL_TV($SELF,next,RTL,rtl)\
TPL_TV($SELF,next,RTL2,rtl2)\
TPL_TV($SELF,next,ProSieben,pro7)\
TPL_TV($SELF,next,DMax,dmax)\
TPL_TV($SELF,next,Vox,vox)\
TPL_TV($SELF,next,KabelEins,kabel1)\
TPL_TV($SELF,next,KabelEinsClassic,kabel1classic)\
TPL_TV($SELF,next,13thStreet,13thstreet)\
TPL_TV($SELF,next,Silverline,silverline)\
TPL_TV($SELF,next,TNTFilm,tntfilm)\
TPL_TV($SELF,next,AXN,axn)\
TPL_TV($SELF,next,SonyEntertainmentTV,sonytv)\
TPL_TV($SELF,next,Kinowelt,kinowelt)\
TPL_TV($SELF,next,ProSiebenMaxx,pro7maxx)\
TPL_TV($SELF,next,Sixx,sixx)\
TPL_TV($SELF,next,TNTSerie,tntserie)\
TPL_TV($SELF,next,SciFi,syfy)\
TPL_TV($SELF,next,ntv,ntv)\
TPL_TV($SELF,next,N24Doku,n24)\
TPL_TV($SELF,next,History,history)\
TPL_TV($SELF,next,PLANET,planet)\
TPL_TV($SELF,next,KabelEinsDoku,kabel1doku)\
TPL_TV($SELF,next,AnimalPlanet,animalplanet)\
TPL_TV($SELF,next,NatGeoHD,natgeo)\
TPL_TV($SELF,next,TLC,tlc)\
TPL_TV($SELF,next,AandE,ae)\
"&nbsp;;"|"&nbsp;;"|"&nbsp;;"|"&nbsp;;"|"&nbsp;;"|"&nbsp;;"|"&nbsp;;"\
"Sender"|"ab"|"Sendung"|"ab"|"Sendung"|"ab"|"Sendung"\
TPL_TV($SELF,prime,DasErste,ard)\
TPL_TV($SELF,prime,ZDF,zdf)\
TPL_TV($SELF,prime,Sat1,sat1)\
TPL_TV($SELF,prime,RTL,rtl)\
TPL_TV($SELF,prime,RTL2,rtl2)\
TPL_TV($SELF,prime,ProSieben,pro7)\
TPL_TV($SELF,prime,DMax,dmax)\
TPL_TV($SELF,prime,Vox,vox)\
TPL_TV($SELF,prime,KabelEins,kabel1)\
TPL_TV($SELF,prime,KabelEinsClassic,kabel1classic)\
TPL_TV($SELF,prime,13thStreet,13thstreet)\
TPL_TV($SELF,prime,Silverline,silverline)\
TPL_TV($SELF,prime,TNTFilm,tntfilm)\
TPL_TV($SELF,prime,AXN,axn)\
TPL_TV($SELF,prime,SonyEntertainmentTV,sonytv)\
TPL_TV($SELF,prime,Kinowelt,kinowelt)\
TPL_TV($SELF,prime,ProSiebenMaxx,pro7maxx)\
TPL_TV($SELF,prime,Sixx,sixx)\
TPL_TV($SELF,prime,TNTSerie,tntserie)\
TPL_TV($SELF,prime,SciFi,syfy)\
TPL_TV($SELF,prime,ntv,ntv)\
TPL_TV($SELF,prime,N24Doku,n24)\
TPL_TV($SELF,prime,History,history)\
TPL_TV($SELF,prime,PLANET,planet)\
TPL_TV($SELF,prime,KabelEinsDoku,kabel1doku)\
TPL_TV($SELF,prime,AnimalPlanet,animalplanet)\
TPL_TV($SELF,prime,NatGeoHD,natgeo)\
TPL_TV($SELF,prime,TLC,tlc)\
TPL_TV($SELF,prime,AandE,ae)


Was richtig viel bringt ist übrigens das entfernen des channelFilters bei der Aktualisierung der Readings. Mein Rechner bleibt jetzt im Durchschnitt 1-2°C kühler als vorher. Der channelFilter kommt jetzt nur noch beim Download alle 3 Tage zum tragen.

[Per]

- deletereading 200000 löscht alle Readings > 2000000s (etwas mehr als 2 Tage). Die längste mir bekannte Sendung war die Live-Übertragung eines 24-Stunden-Rennens. Hatte damals aber nicht geschaut, ob das nur ein Eintrag ist. >2Tage dürfte da ausreichend Puffer sein.

- Warum gibt es in StartDownload $_channelFilter? Ich habe nichts gefunden, wohin das übergeben wird.
- tvParse und tvMerge bekomme ich nicht zum Setzen von Readings überredet. Können die das nicht, weil es im BlockingCall arbeiten?
- mein erstelltes RegEx sieht dem manuell erstelten zum Verwechseln ähnlich, zumindest die exportierten Readings. Ich kann das aber auch nur im StartDownload testen, weil tvParse und tvMerge keine Readings erstellen. Zumindest zeigen sie die mir nicht.

- Die Daten für die Formatierung ist etwas durcheinander, weil ich $_channelFilter zwischendurch nicht aktualisiert habe.

[mumpitzstuff]

In startDownload gibt es doch gar keinen channelFilter. Oder übersehe ich irgendwas?
tvParse und tvMerge werden NonBlocking ausgeführt, deshalb kannst du dort keine Readings auf direktem Wege setzen. Also entweder über Telnet (so wie ich das mache) oder du musst das über die returns durchschleifen.

[Per]

Das mit dem nonBlocking fiel mir dann auch wie Schuppen von den Haaren

Habe jetzt eine Variante durchgeproggt, ich poste sie, wenn sie ein paar Tage gelaufen ist. Dabei sind nicht nur alle meine bisherigen Punkte abgehakt, sie ist auch noch Multi-Device-fähig. Falls Mama was anderes ansehen will als Papa.

Allerdings werde ich den Quellcode dann nochmal komplett umsortieren. Und meinen Debugcode ausmisten.

[Per]

So, Tests laufen weiter, aber wer schon mal reinschauen will...

Code Auswählen Erweitern

defmod TV_Programm DOIF subs\
{\
  use utf8;;\
  use Date::Parse;;\
  # sudo apt-get install libxml-bare-perl\
  use XML::Bare 0.53 qw(forcearray);;\
  use Blocking;;\
  $_name = "$SELF";;\
  $_path = '/opt/fhem/';;\
  $_data = 'rytecDE_filt_'.$_name;;\
  $_dataFile = $_path.$_data;;\
  #use Encode qw(encode_utf8 decode_utf8);;\
  \
  ### CONFIG AREA ###\
  $_server = AttrVal($_name,"server","http://epg.vuplus-community.net");; \
  my $channelFilter = ReadingsVal($_name,"sender","ZDF\\.|");;\
  $channelFilter =~ s/\|$//;;\
  $_channelFilter = qr/^(?:$channelFilter)/;;\
  # telnet port must not be password protected (open)\
  # this is used as fallback if telnet port cannot created automatically\
  $_telnetPort = 7072;;\
  # can be used to adjust the program times (mostly not needed!)\
  $_timeAdjust = 0;;\
  # enable/disable unused channel filtering on filemerge (enabled = small file = faster)\
  $_filterChannels = 1;;\
  # enable/disable updates based on starttimes (enabled = update channels only if needed = faster)\
  $_updateBasedOnStarttimes = 1;;\
  # enable/disable use of Time::Piece (timepiece is faster but not instaled on some systems)\
  $_timepiece = 0;;\
  \
  # internal variables\
  $_startTimes = ();;\
\
  sub filterText($)\
  {\
    my $text = shift;;\
    \
    $text =~ s/[\x{0022}\x{0060}\x{003b}\x{0027}\"\`;;\'\r]//g;;\
    #$text =~ s/[\"\`;;\'\r]//g;;\
    $text =~ s/[\n]/<br>/g;;\
    \
    return $text;;\
  }\
\
  sub xmltv2epoch($)\
  {\
    my $t = shift;;\
    \
    if ($_timepiece)\
    {\
      use Time::Piece;;\
      \
      # fast version\
      return Time::Piece->strptime($t, '%Y%m%d%H%M%S %z')->epoch;;\
    }\
    else\
    {\
      # slow but compatible version\
      substr($t, 8, 0) = 'T';;\
      \
      return str2time($t);;\
    }\
  }\
\
  sub FmtDateTime($)\
  {\
    my @t = localtime(shift);;\
    return sprintf("%04d-%02d-%02d %02d:%02d:%02d", $t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]);;\
  }\
\
  sub createTelnet($)\
  {\
    my $device = shift;;\
    my $telnet = undef;;\
    \
    foreach my $d (sort keys %::defs)\
    {\
      next if ($d !~ /telnetForTvUpdateFn_\d+/);;\
      my $h = $::defs{$d};;\
      next if (!$h->{TYPE} || $h->{TYPE} ne 'telnet' || $h->{SNAME});;\
      next if (::AttrVal($d, 'allowfrom', '127.0.0.1') ne '127.0.0.1');;\
      next if ($h->{DEF} !~ /^\d+( global)?$/);;\
      next if ($h->{DEF} =~ /IPV6/);;\
      \
      $telnet = $d;;\
      last;;\
    }\
    \
    if (!defined($telnet))\
    {\
      $telnet = 'telnetForTvUpdateFn_'.time();;\
      my $ret = ::CommandDefine(undef, "-temporary $telnet telnet 0");;\
      \
      if (defined($ret))\
      {\
        ::Log3 $device, 1, $device.': Cannot create telnet port ('.$ret.')';;\
        return undef;;\
      }\
      \
      $::attr{$telnet}{room} = 'hidden';;\
      $::attr{$telnet}{allowfrom} = '127.0.0.1';;\
    }\
    \
    return $::defs{$telnet}{PORT};;\
  }\
\
  sub tvParse($$$)\
  {\
    my ($device, $mode, $port) = @_;;\
    my $obj;;\
    my $xml;;\
    my $lastChannel = '';;\
    my $reading = '';;\
    my $i = 999;;\
    my $n = 999;;\
    my $k = 0;;\
    my $primeTime = substr(FmtDateTime(time() + $_timeAdjust), 0, 11).'20:14:00';;\
    my $sendTelnet = '';;\
    \
    $obj = XML::Bare->new(file => $_dataFile);;\
    $xml = $obj->parse();;\
    \
    if (!$@)\
    {\
      my $old = time() + $_timeAdjust;;\
      \
      foreach (@{forcearray($xml->{'tv'}{'programme'})})\
      {\
        my $stop = xmltv2epoch($_->{'stop'}{'value'});;\
        \
           # filter old stuff\
        if ($stop > $old)\
        {\
          if ($lastChannel ne $_->{'channel'}{'value'})\
          {\
            $lastChannel = $_->{'channel'}{'value'};;\
            $reading = $_->{'channel'}{'value'};;\
            $reading =~ s/[\.\s]//g;;\
            $reading =~ s/de$//;;\
            $n = 0;;\
    \
            if ((0 == $_updateBasedOnStarttimes) || !exists($_startTimes{$reading}) || ($_startTimes{$reading} <= $old))\
            {\
              $i = 0;;\
      \
              if (0 != $_updateBasedOnStarttimes)\
              {\
                $_startTimes{$reading} = $stop;;\
              }\
            }\
            else\
            {\
              ::Log3 $device, 4, $device.': '.$reading.' is blocked because actual program is not finished (start: '.$_startTimes{$reading}.', old: '.$old.').';;\
            }\
          }\
  \
          if ($i < 3 && 'next' eq $mode)\
          {\
            my $fi = sprintf("%03d", $i);;\
            my $start = xmltv2epoch($_->{'start'}{'value'});;\
            my $readingName;;\
            my $readingValue;;\
    \
            $readingName = $reading.'_'.'next_'.$fi.'_1bdate';;\
            $readingValue = substr(FmtDateTime($start), 0, 10);;\
            $sendTelnet .= ";;setreading $device _$readingName $readingValue";;\
    \
            $readingName = $reading.'_'.'next_'.$fi.'_2btime';;\
            $readingValue = substr(FmtDateTime($start), 11, 8);;\
            $sendTelnet .= ";;setreading $device _$readingName $readingValue";;\
    \
            $readingName = $reading.'_'.'next_'.$fi.'_3title';;\
            $readingValue = filterText(@{forcearray($_->{'title'})}[0]->{'value'});;\
            $sendTelnet .= ";;setreading $device _$readingName $readingValue";;\
    \
            $readingName = $reading.'_'.'next_'.$fi.'_4stitle';;\
            if (exists($_->{'sub-title'}{'value'}))\
            {\
              $readingValue = filterText($_->{'sub-title'}{'value'});;\
            }\
            else\
            {\
              $readingValue = 'na';;\
            }\
            $sendTelnet .= ";;setreading $device _$readingName $readingValue";;\
    \
            $readingName = $reading.'_'.'next_'.$fi.'_5desc';;\
            if (exists($_->{'desc'}{'value'}))\
            {\
              $readingValue = filterText($_->{'desc'}{'value'});;\
            }\
            else\
            {\
              $readingValue = 'na';;\
            }\
            $sendTelnet .= ";;setreading $device _$readingName $readingValue";;\
    \
            $k++;;\
            $i++;;\
          }\
  \
          if ($n < 3 && 'prime' eq $mode)\
          {\
            my $start = xmltv2epoch($_->{'start'}{'value'});;\
            my $fmtStart = FmtDateTime($start);;\
            my $bdate = substr($fmtStart, 0, 10);;\
            my $btime = substr($fmtStart, 11, 8);;\
    \
            if ($bdate.' '.$btime gt $primeTime)\
            {\
              my $fn = sprintf("%03d", $n);;\
              my $readingName;;\
              my $readingValue;;\
      \
              $readingName = $reading.'_'.'prime_'.$fn.'_1bdate';;\
              $readingValue = substr(FmtDateTime($start), 0, 10);;\
              $sendTelnet .= ";;setreading $device _$readingName $readingValue";;\
      \
              $readingName = $reading.'_'.'prime_'.$fn.'_2btime';;\
              $readingValue = substr(FmtDateTime($start), 11, 8);;\
              $sendTelnet .= ";;setreading $device _$readingName $readingValue";;\
      \
              $readingName = $reading.'_'.'prime_'.$fn.'_3title';;\
              $readingValue = filterText(@{forcearray($_->{'title'})}[0]->{'value'});;\
              $sendTelnet .= ";;setreading $device _$readingName $readingValue";;\
      \
              $readingName = $reading.'_'.'prime_'.$fn.'_4stitle';;\
              if (exists($_->{'sub-title'}{'value'}))\
              {\
                $readingValue = filterText($_->{'sub-title'}{'value'});;\
              }\
              else\
              {\
                $readingValue = 'na';;\
              }\
              $sendTelnet .= ";;setreading $device _$readingName $readingValue";;\
      \
              $readingName = $reading.'_'.'prime_'.$fn.'_5desc';;\
              if (exists($_->{'desc'}{'value'}))\
              {\
                $readingValue = filterText($_->{'desc'}{'value'});;\
              }\
              else\
              {\
                $readingValue = 'na';;\
              }\
              $sendTelnet .= ";;setreading $device _$readingName $readingValue";;\
      \
              $k++;;\
              $n++;;\
            }\
          }\
  \
          if ($k >= 10)\
          {\
    #::Log3 $device, 5, $device.': '.encode_utf8($sendTelnet);;\
            \
            `perl /opt/fhem/fhem.pl $port "$sendTelnet"`;;\
            \
            $k = 0;;\
            $sendTelnet = '';;\
          }\
        }\
      }\
      \
      if ('' ne $sendTelnet)\
      {\
          #::Log3 $device, 5, $device.': '.encode_utf8($sendTelnet);;\
        \
        `perl /opt/fhem/fhem.pl $port "$sendTelnet"`;;\
      }\
    }\
    \
    return %{$_startTimes};;\
  }\
\
  sub DOIF::doParse($)\
  {\
    my ($name, $mode, $port) = split("\\|", shift);;\
    my $ret = $name;;\
    my %startTimes = tvParse($name, $mode, $port);;\
    \
    foreach (keys(%startTimes))\
    {\
      $ret .= '|'.$_.'|'.$startTimes{$_};;\
    }\
    \
    return $ret;;\
  }\
\
  sub DOIF::endParse($)\
  {\
    my ($name, @startTimes) = split("\\|", shift);;\
    \
    for (my $i = 0;; $i < (scalar(@startTimes) / 2);; $i += 2)\
    {\
      $_startTimes{$startTimes[$i]} = $startTimes[$i + 1];;\
    }\
    \
    ::Log3 $name, 4, $name.': Blocking call finished to parse tv data.';;\
    \
    delete($_blockingcalls{PID_PARSE});;\
  }\
\
  sub DOIF::abortParse($)\
  {\
    my $name = shift;;\
    \
    delete($_blockingcalls{PID_PARSE});;\
    \
    ::Log3 $name, 1, $name.': Blocking call aborted (parse).';;\
  }\
\
  sub startParse($$)\
  {\
    my ($name, $mode) = @_;;\
    my $port;;\
    \
    if (defined($_blockingcalls{PID_PARSE}))\
    {\
      ::Log3 $name, 3, $name.': Blocking call already running (parse).';;\
      ::BlockingKill($_blockingcalls{PID_PARSE});;\
    }\
    \
    $port = createTelnet($name);;\
    $port = $_telnetPort if (!defined($port));;\
    \
    $_blockingcalls{PID_PARSE} = ::BlockingCall('DOIF::doParse', $name.'|'.$mode.'|'.$port, 'DOIF::endParse', 300, 'DOIF::abortParse', $name);;\
  }\
\
  sub tvMerge($$$$)\
  {\
    my ($path, $dstName, $orgName, $server) = @_;;\
    my $fh;;\
    my $dst;;\
    my $src;;\
    my $start = '';;\
    my $channels1 = '';;\
    my $channels1_flt = '';;\
    my $channels2 = '';;\
    my $channels2_flt = '';;\
    my $programms1 = '';;\
    my $programms1_flt = '';;\
    my $programms2 = '';;\
    my $programms2_flt = '';;\
    my $end = '';;\
    my $pos;;\
    my $output = "";;\
    my $ftime = 2;;\
    my $srcName = $path.$orgName;;\
    $dstName = $path.$dstName;;\
    \
    if (-e $srcName)\
      {\
      $ftime = ((time() - (stat($srcName))[9]) / 60.0 / 60.0 / 24.0);;\
    }\
    if ($ftime > 1)\
    {\
        $output .= qx(wget $server/$orgName -O $srcName.xz 2>&1);;\
        $output .= qx(xz -df $srcName.xz 2>&1);;\
    }\
    \
    open($fh, '<', $dstName) or die "Can't open file $!";;\
    read($fh, $dst, -s $fh);;\
    close($fh);;\
    \
    if (defined($srcName))\
    {\
      open($fh, '<', $srcName) or die "Can't open file $!";;\
      read($fh, $src, -s $fh);;\
      close($fh);;\
    }\
    \
    if (-1 != ($pos = index($dst, '<channel ')))\
    {\
      $start = substr($dst, 0, $pos);;\
    }\
    \
    if (-1 != ($pos = rindex($dst, '</programme>')))\
    {\
      $end = substr($dst, $pos + 12);;\
    }\
    \
    while ($dst =~ /(\s*<channel\s.*?id="(.*?)".*?<\/channel>)/sg)\
    {\
      if (0 != $_filterChannels)\
      {\
        $_ = $1;;\
        \
        if ($2 =~ $_channelFilter)\
        {\
          $channels1_flt .= $_;;\
        }\
      }\
      else\
      {\
        $channels1 .= $1;;\
      }\
    }\
    \
    while ($dst =~ /(\s*<programme\s.*?channel="(.*?)".*?<\/programme>)/sg)\
    {\
      if (0 != $_filterChannels)\
      {\
        $_ = $1;;\
        \
        if ($2 =~ $_channelFilter)\
        {\
          $programms1_flt .= $_;;\
        }\
      }\
      else\
      {\
        $programms1 .= $1;;\
      }\
    }\
    \
    if (defined($srcName))\
    {\
      while ($src =~ /(\s*<channel\s.*?id="(.*?)".*?<\/channel>)/sg)\
      {\
        if (0 != $_filterChannels)\
        {\
          $_ = $1;;\
          \
          if ($2 =~ $_channelFilter)\
          {\
            $channels2_flt .= $_;;\
          }\
        }\
        else\
        {\
          $channels2 .= $1;;\
        }\
      }\
      \
      while ($src =~ /(\s*<programme\s.*?channel="(.*?)".*?<\/programme>)/sg)\
      {\
        if (0 != $_filterChannels)\
        {\
          $_ = $1;;\
          \
          if ($2 =~ $_channelFilter)\
          {\
            $programms2_flt .= $_;;\
          }\
        }\
        else\
        {\
          $programms2 .= $1;;\
        }\
      }\
    }\
    \
    if (0 != $_filterChannels)\
    {\
      open($fh, '>', $dstName) or die "Can't open file $!";;\
      \
      if (defined($srcName))\
      {\
        print $fh $start.$channels1_flt.$channels2_flt.$programms1_flt.$programms2_flt.$end;;\
      }\
      else\
      {\
        print $fh $start.$channels1_flt.$programms1_flt.$end;;\
      }\
      \
      close($fh);;\
    }\
    else\
    {\
      open($fh, '>', $dstName) or die "Can't open file $!";;\
      \
      if (defined($srcName))\
      {\
        print $fh $start.$channels1.$channels2.$programms1.$programms2.$end;;\
      }\
      else\
      {\
        print $fh $start.$channels1.$programms1.$end;;\
      }\
      \
      close($fh);;\
    }\
    return $output;;\
  }\
\
  sub tvDownloadMerge($$$$)\
  {\
    my ($name, $path, $data, $server) = @_;;\
    my $output = '';;\
    \
    $output .= qx(cp -f $path/rytecDE_leer $path/$data 2>&1);;\
    \
    $output .= tvMerge($path, $data, 'rytecDE_Basic', $server);;\
    $output .= tvMerge($path, $data, 'rytecDE_Common', $server);;\
##    $output .= tvMerge($path, $data, 'rytecDE_SportMovies.xz', $server);;\
    # download and merge other files here if needed\
    \
    return $output;;\
  }\
\
  sub DOIF::doDownload($)\
  {\
    my ($name, $path, $data, $server) = split("\\|", shift);;\
    my $output = '';;\
    \
    $output = tvDownloadMerge($name, $path, $data, $server);;\
    \
    return $name.'|'.$output;;\
  }\
\
  sub DOIF::endDownload($)\
  {\
    my ($name, $output) = split("\\|", shift);;\
    \
    ::Log3 $name, 5, $name.': '.$output;;\
    ::Log3 $name, 4, $name.': Blocking call finished to download tv data.';;\
    \
    delete($_blockingcalls{PID_DOWNLOAD});;\
  }\
\
  sub DOIF::abortDownload($)\
  {\
    my $name = shift;;\
    \
    delete($_blockingcalls{PID_DOWNLOAD});;\
    \
    ::Log3 $name, 1, $name.': Blocking call aborted (download).';;\
  }\
\
  sub startDownload($)\
  {\
    my $name = shift;;\
    \
    my $channelFilter = ReadingsVal($_name,"sender","ZDF\\.|");;\
    $channelFilter =~ s/\|$//;;\
    $_channelFilter = qr/^(?:$channelFilter)/;;\
    # prevent download spamming\
    if (-e $_dataFile)\
    {\
      my $btime = ((time() - (stat($_path.'rytecDE_Basic'))[9]) / 60.0 / 60.0 / 24.0);;\
      my $ftime = ((time() - (stat($_dataFile))[9]) / 60.0 / 60.0 / 24.0);;\
      my $rtime = (ReadingsAge($_name,"sender",3600)  / 60.0 / 60.0 / 24.0) ;;\
      \
      if ($btime < 1.0 and $ftime < 1.0 and $ftime < $rtime)\
      {\
        ::Log3 $name, 1, $name.': Download of TV data skipped because file is not older than 1 day ('.($btime).')('.($ftime).')('.($rtime).').';;\
        return;;\
      }\
    }\
    \
    if (defined($_blockingcalls{PID_DOWNLOAD}))\
    {\
      ::Log3 $name, 3, $name.': Blocking call already running (download).';;\
      \
      ::BlockingKill($_blockingcalls{PID_DOWNLOAD});;\
    }\
    \
    $_blockingcalls{PID_DOWNLOAD} = ::BlockingCall('DOIF::doDownload', $name.'|'.$_path.'|'.$_data.'|'.$_server, 'DOIF::endDownload', 300, 'DOIF::abortDownload', $name);;\
  }\
}\
\
init\
{\
  startDownload("$SELF");;\
  set_Exec('init_next', 300, 'startParse("$SELF", "next")');;\
  set_Exec('init_prime', 480, 'startParse("$SELF", "prime")');;\
}\
{\
  if ([00:05|Mo Do])\
  {\
    startDownload("$SELF");;\
  }\
  \
  if ([+00:01])\
  {\
    startParse("$SELF", 'next');;\
  }\
  \
  if ([00:30])\
  {\
    startParse("$SELF", 'prime');;\
  }\
}\
renew\
  {\
  if ([$SELF:sender])\
  {\
    startDownload("$SELF");;\
    set_Exec('init_next', 30, 'startParse("$SELF", "next")');;\
    set_Exec('init_prime', 60, 'startParse("$SELF", "prime")');;\
  }\
}
attr TV_Programm alias Aktuelles TV-Programm
attr TV_Programm event-on-change-reading .*
attr TV_Programm userattr server:http://epg.vuplus-community.net,http://www.xmltvepg.nl,http://91.121.106.172/~rytecepg/epg_data,http://epg.vuplus-community.net
attr TV_Programm server http://epg.vuplus-community.net
attr TV_Programm room Wohnzimmer
attr TV_Programm uiTable\
{\
  package ui_Table;;\
  \
  $SHOWNOSTATE = 1;;\
  $ATTRIBUTESFIRST = 1;;\
  my $PRIMEROW = 39;;\
  \
  $TR{0,40} = "style='color:red;;text-align:center;;font-weight:bold;;font-size:18px'";;\
  $TR{1..($PRIMEROW - 1),($PRIMEROW + 2)..($PRIMEROW * 2)} = "style='font-size:16px'";;\
  $TR{$PRIMEROW} = "style='border-top-style:solid;;border-bottom-style:solid;;border-color:#CCCCCC;;border-top-width:1px;;border-bottom-width:1px;;'";;\
  $TD{0..($PRIMEROW * 2)}{0} = "align='center'";;\
  $TD{0..($PRIMEROW - 1),($PRIMEROW + 1)..($PRIMEROW * 2)}{1,3,5} = "style='border-left-style:solid;;border-color:#CCCCCC;;border-left-width:1px;;'";;\
\
  sub showIcon\
  {\
    my ($icon, $show, $device, $state) = @_;;\
    $_Senderliste =~ s/$icon\\.\|//;;\
    $_Senderliste .= $icon . "\\.|";;\
    \
    if (defined($device) && defined($state))\
    {\
      return "<a href=\"$::FW_ME?cmd=set $device $state$::FW_CSRF\">".ICON("tv/$icon")."</a>";;\
    }\
    else\
    {\
      return ICON("$show");;\
    }\
  }\
\
  sub showIconIP\
  {\
    my ($icon, $show, $device, $state) = @_;;\
    $_Senderliste =~ s/$icon\\.\|//;;\
    $_Senderliste .= $icon . "\\.|";;\
    \
    if (defined($device) && defined($state))\
    {\
      return "<a href=\"". ::ReadingsVal("$SELF","$device","") =~ s/.state/$state/r ."\" target=\"IPTV\">".ICON("$show")."</a>";;\
    }\
    else\
    {\
      return ICON("$show");;\
    }\
  }\
\
  sub unfold\
  {\
    my ($ReadingPre) = @_;;\
    my $title = ::ReadingsVal("$SELF","_${ReadingPre}_3title","-");;\
    my $desc = ::ReadingsVal("$SELF","_${ReadingPre}_4stitle","na")."\n\n". ::ReadingsVal("$SELF","_${ReadingPre}_5desc","na") ;;\
    \
    $title =~ s/(.{1,45}|\S{46,})(?:\s[^\S\r\n]*|\Z)/$1<br>/g;;\
    $desc =~ s/<br>/\n/g;;\
    $desc =~ s/(.{1,65}|\S{66,})(?:\s[^\S\r\n]*|\Z)/$1<br>/g;;\
    $desc =~ s/[\r\'\"]/ /g;;\
    $desc =~ s/[\n]|\\n/<br>/g;;\
    \
    return substr(::ReadingsVal("$SELF","_${ReadingPre}_2btime",""),0,5) . \
            "</td><td><a href=\"#!\" onclick=\"FW_okDialog(';$title<br>$desc';)\">$title</a>";;\
  }\
\
  sub renewFilter()\
  {\
    if (::ReadingsVal("$SELF","sender","ZDF\\.") ne $_Senderliste)\
    {\
      ::fhem("setreading $SELF sender $_Senderliste");;\
    }\
    ::fhem("deletereading $SELF .*(next|prime)_.*  200000");;\
  }\
}\
\
## parameter: mode (next or prime), channel name (see xml data file), icon name (filename of channel logo)\
DEF TPL_TV(showIcon("$2","$3",undef,undef)|unfold("$2_$1_000")|unfold("$2_$1_001")|unfold("$2_$1_002"))\
\
## parameter: mode (next or prime), channel name (see xml data file), icon name (filename of channel logo), device name for set command, command\
DEF TPL_TVSET(showIcon("$2","$3","$4","$5")|unfold("$2_$1_000")|unfold("$2_$1_001")|unfold("$2_$1_002"))\
\
## parameter: mode (next or prime), channel name (see xml data file), icon name (filename of channel logo), device name for set command, command\
DEF TPL_TVIP(showIconIP("$2","$3","$4","$5")|unfold("$2_$1_000")|unfold("$2_$1_001")|unfold("$2_$1_002"))\
\
$_Senderliste = "";;"Sender"|"ab"|"Aktuelle Sendung"|"ab"|"Naechste Sendung"|"ab"|"Sendung"\
TPL_TVIP(next,DasErste,01 ARD,VIEW1,29438503040)\
TPL_TVIP(next,ZDF,02 ZDF,VIEW1,29438503164)\
TPL_TVIP(next,RTL,04 RTL,VIEW1,29438503175)\
TPL_TVIP(next,RTL2,05 RTL2,VIEW1,904120359445)\
TPL_TVIP(next,Vox,06 Vox,VIEW1,29438503001)\
TPL_TVIP(next,VOXup,.. VOXup,VIEW1,911733287342)\
TPL_TVIP(next,ProSieben,07 ProSieben,VIEW1,29438503097)\
TPL_TVIP(next,Sat1,08 Sat1,VIEW1,29438503126)\
TPL_TVIP(next,KabelEins,09 KabelEins,VIEW1,29438503100)\
TPL_TVIP(next,3sat,10 3Sat,VIEW1,616178215134)\
TPL_TVIP(next,ARTE,11 Arte,VIEW1,342571559048)\
TPL_TVIP(next,DMax,12 D-Max,VIEW1,29438503089)\
TPL_TVIP(next,ServusHD,13 ServusTV,VIEW1,29438502999)\
TPL_TVIP(next,NDRFernsehen,14 NDR,VIEW1,29438503143)\
TPL_TVIP(next,WDRFernsehen,15 WDR,VIEW1,761024551272)\
TPL_TVIP(next,HRFernsehen,16 HR3,VIEW1,761026599328)\
TPL_TVIP(next,SWRFernsehen,17 SWR,VIEW1,761023015389)\
TPL_TVIP(next,MDRS-Anhalt,18 MDR SA,VIEW1,834825255151)\
TPL_TVIP(next,BRFernsehen,BR3,VIEW1,29438503048)\
TPL_TVIP(next,ComedyCentralVIVA,19 CC,VIEW1,29438502952)\
TPL_TVIP(next,ProSiebenMaxx,20 pro7maxx,VIEW1,432862759167)\
TPL_TVIP(next,SuperRTL,21 SuperRTL,VIEW1,29438503124)\
TPL_TVIP(next,RTLNitro,22 Nitro,VIEW1,29438503118)\
TPL_TVIP(next,Tele5,23 Tele5,VIEW1,29609511124)\
TPL_TVIP(next,Sat1Gold,24 Sat1 Gold,VIEW1,720012839067)\
TPL_TVIP(next,phoenix,25 phoenix,VIEW1,706496551303)\
TPL_TVIP(next,KabelEinsDoku,202 Kabel1doku,VIEW1,745574951375)\
TPL_TVIP(next,N24Doku,203 n24 Doku,VIEW1,745574951376)\
TPL_TVIP(next,ZDFinfo,204 ZDF Info,VIEW1,745574951376)\
TPL_TVIP(next,Sport1HD,300 DSF,VIEW1,465354791385)\
TPL_TVIP(next,Eurosport1,301 Eurosport,VIEW1,465354791385)\
TPL_TVIP(next,WELT,302 Welt n-24,VIEW1,465354791385)\
TPL_TVIP(next,ntv,303 n-tv,VIEW1,29438503069)\
TPL_TVIP(next,tagesschau24,304 tagesschau24,VIEW1,834825255153)\
TPL_TVIP(next,TLC,TLC,VIEW1,488928807317)\
TPL_TVIP(next,Sixx,?? Sixx,VIEW1,465354791388)\
TPL_TVIP(next,MotorVision,552 MV,VIEW1,817724967007)\
TPL_TV(next,HGTV,428 HGTV,VIEW1,0)\
"&nbsp;;"|"&nbsp;;"|"&nbsp;;"|"&nbsp;;"|"&nbsp;;"|"&nbsp;;"|"&nbsp;;"\
"Sender"|"ab"|"Sendung"|"ab"|"Sendung"|"ab"|"Sendung"\
TPL_TV(prime,DasErste,ard)\
TPL_TV(prime,ZDF,zdf)\
TPL_TV(prime,Sat1,sat1)\
TPL_TV(prime,RTL,rtl)\
TPL_TV(prime,RTL2,rtl2)\
TPL_TV(prime,ProSieben,pro7)\
TPL_TV(prime,DMax,dmax)\
TPL_TV(prime,Vox,vox)\
TPL_TV(prime,KabelEins,kabel1)\
TPL_TV(prime,KabelEinsDoku,kabel1doku)\
TPL_TV(prime,KabelEinsClassic,kabel1classic)\
TPL_TV(prime,ProSiebenMaxx,pro7maxx)\
TPL_TV(prime,Sixx,sixx)\
TPL_TV(prime,ntv,ntv)\
TPL_TV(prime,N24Doku,n24)\
TPL_TV(prime,History,history)\
TPL_TV(prime,TLC,tlc)\
renewFilter();;
Natürlich wieder meine Sender und meine Formatierung Und die Parameter für Unitymedia-IPTV. Ist zwar inzwischen offline, habe ich aber noch nicht gelöscht. Mal sehen, vllt. kommt da eine Verlinkung auf den jeweiligen Live-Stream hin, denn mein TV unterstützt keine Fernbedienung außer der beigelegten IR. Und eine IR für Fhem liegt zwar schon da, ist aber noch nicht installiert.
Einstellungen sind wie beim Original die TPL für next und prime am Ende, und die rytec-Dateien Zeile 495ff. Der Server kann über attr ausgewählt werden. Und wer nicht in "/opt/fhem" installiert hat, muss diese Variable im Code ändern. K.A., ob und wie das über Perl automatisch abzufragen geht.
Am Merge und am Parse habe ich, magels Verständnis außer der Reihenfolge im Code und den übergebenen Parametern (noch ) nichts geändert.

Achja, die Datei "rytecDE_leer" in "/opt/fhem" braucht es noch. Inhalt:

Code Auswählen Erweitern

<?xml version="1.0" encoding="UTF-8"?>
<tv generator-info-name="Rytec" generator-info-url="https://forums.openpli.org" generator-info-partner="bStream-Panel">
  <channel id="XXX.de">
    <display-name lang="de">XXX</display-name>
  </channel>
  <programme start="20221220035500 +0000" stop="20221220040000 +0000" channel="XXX.de">
    <title lang="de">Platzhalter</title>
    <sub-title lang="de">Platz</sub-title>
    <desc lang="de">Platzhalter</desc>
  </programme>
</tv>
Könnte man, statt sie als Datei zu kopieren, auch aus dem Quellcode heraus erstellen, aber ersteres empfinde ich einfacher.
Statt der Datei gäbe es bestimmt noch andere Möglichkeiten ohne, aber wie gesagt, dafür komme ich zuwenig mit Parse und Merge klar.

PS: durch einen Programmierfehler (einer von hunderten ) habe ich heute mal die ZDFneo Videothek aufgesucht...

Tante Edit sagt: pwd gibt das aktuelle Arbeitsverzeichnis zurück. Denke, das werde ich noch nachpflegen.

[Per]

Folgende Dinge musste ich aktuell aber schon wieder zurück bauen:

$TR{0,($NUM_CHANNELS + 2)} = ...

Aktionen wie diese funktionieren bei mir nicht. Das Format wird einfach gar nicht mehr übernommen. Vielleicht muss ich da noch mal nachfragen, weshalb das so ist.

Bei mir auch nicht, deshalb hatte ich dort eine feste Zahl  {0,40} drin.
was aber geht:
$TR{0} = XXX...
$TR{($NUM_CHANNELS + 2)} = XXX...

Warum auch immer. Die Zahl habe ich jetzt auch automatisch erstellt, da sie aber erst nach einem Durchlauf erstellt wird, ist es nötig, das attr ui_Table noch ein zweites Mal zu speichern.

[Damian]

Bei mir auch nicht, deshalb hatte ich dort eine feste Zahl  {0,40} drin.
was aber geht:
$TR{0} = XXX...
$TR{($NUM_CHANNELS + 2)} = XXX...

Warum auch immer. Die Zahl habe ich jetzt auch automatisch erstellt, da sie aber erst nach einem Durchlauf erstellt wird, ist es nötig, das attr ui_Table noch ein zweites Mal zu speichern.

$TR wird wie folgt abgebildet:

  $wcmd =~ s/\$TR\{/\$hash->{$table}{tr}\{/g;

Offenbar kann in Perl die Referenz keine Berechnung sein, reine Variablen sollten funktionieren.

[Per]

In anderen Zeilen habe ich Berechnungen drin, da geht es. Als Zweizeiler kann er ja auch.
Und {0,$YYY} ging auch nicht.
Vllt mit anderen oder ohne Klammern?

[mumpitzstuff]

Ich habe noch zwei Verständnisfragen.

Die leere Datei wird weswegen erzeugt/benötigt?
Die obere renew Funktion mit dem download und den zwei Parse Funktionen wird wann genau aktiv?

[Per]

1. fürs mergen. Quasi als Basis, damit nicht die "teure" gedownloadete Datei verwendet wird. Technisch wird es nicht notwendig sein, aber ich (!) kann es nicht besser. Besser wäre es, wenn die Datei vorhandene gefilterte Datei erst gelöscht wird, wenn die Downloads abgeschlossen sind.
2. wenn sich die Senderliste geändert hat. Da es keine einzelne Merge-Funktion gibt, habe ich die downloadmerge genutzt. Der Timer ist notwendig, weil beim Start von Fhem das Reading sender kurzzeitig leer ist.

[Damian]

$TR wird wie folgt abgebildet:

  $wcmd =~ s/\$TR\{/\$hash->{$table}{tr}\{/g;

Offenbar kann in Perl die Referenz keine Berechnung sein, reine Variablen sollten funktionieren.

Ich muss meine Aussage korrigieren. Perl kann sehr wohl Berechnungen als Namen im Hash vornehmen, das Problem wird wohl sein, dass die Variable, die du angibst zum späteren Zeitpunkt nicht bekannt ist, wo die Auswertung stattfindet. Mit Instanzvariablen $_... müsste es dagegen klappen.