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

mumpitzstuff · 23 Dezember 2022, 22:31:32

Zitat von: Damian am 23 Dezember 2022, 22:15:50
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.

Mein erster kurzer Test sagt leider nein. Vielleicht habe ich aber auch noch was anderes falsch gemacht oder es ist irgendein Folgeproblem...

Damian · 23 Dezember 2022, 22:44:27

Zitat von: mumpitzstuff am 23 Dezember 2022, 22:31:32
Mein erster kurzer Test sagt leider nein. Vielleicht habe ich aber auch noch was anderes falsch gemacht oder es ist irgendein Folgeproblem...

Also bei mir funktionieren sogar lokale Variablen:

Code Auswählen

defmod di_tr DOIF ##
attr di_tr uiTable {package ui_Table;;\
 my $a=1;;\
 $TR{$a+1} = "style='font-weight:bold'";;\
}\
"test"\
"test2"\
"test3"

mumpitzstuff · 23 Dezember 2022, 22:46:52

Ich habe jetzt noch dein erweitertes userattr übernommen und in den wget Zeilen lösche ich die Datei bei einem Fehler, dadurch sollte das nachfolgende entpacken schief gehen und die bestehende Datei nicht überschrieben werden.
Ich werde jetzt deine Version im ersten Beitrag verlinken und den Link anpassen, falls du eine Änderung posten solltest.

Ein wirkliches Killerfeature (falls du noch eine Challenge suchst) wäre übrigens folgendes: Anstatt next immer alle x Minuten zu parsen, könnte man sich beim parsen auch die am nächsten liegende Anfangszeit der Folgesendungen aller Sender merken und den entsprechenden Timer auf diesen Wert setzen. Dadurch würde man sich einige parse Vorgänge sparen.

Beispiel: aktuelle Zeit ist 22:00 Uhr und wir haben 3 Sender A, B und C. Die nächste Sendung von A beginnt um 23:30 Uhr, die von B um 22:15 Uhr und die von C um 0:00 Uhr. Also merken wir uns 22:15 Uhr und parsen erst wieder, wenn diese Zeit erreicht ist.

Btw. dein reparse jede Minute ist krasser Overkill. Es gibt so gut wie keine Sendung, die nicht zu einer Zeit startet, die nicht ein Vielfaches von 5 ist. Daher kannst du dein reparse auch auf 5 Minuten setzen, ohne etwas zu verpassen. Außerdem solltest du dir Gedanken darüber machen, wie du verhinderst, dass ein reparse getriggert wird, wenn der Download noch läuft. In meiner Version laufen beide Dinge nicht zur selben Zeit ab und Kollisionen sind ausgeschlossen. Ich würde dir empehlen, den Download auf 00:01 zu setzen und dein reparse alle 5 Minuten anzusetzen. Dann hast du genau 4 Minuten für den Download, in denen DOwnload und Parse nicht kollidieren können.

Code Auswählen

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\.|ZDFinfo\.|Sat1\.|RTL2?\.|Pro(Sieben|SiebenMaxx)\.|DMax\.|Vox\.|KabelEins(?:Classic|Doku)?\.|ntv\.|Sixx\.|TLC\.|N24Doku\.|SonyEntertainmentTV\.|AandE\.|TNT(?:Serie|Film)\.|AnimalPlanet\.|History\.|Kinowelt\.|NatGeo(?:HD|Wild)\.|GeoTV\.|CuriosityChannel\.|Sky1\.|WELT\.|phoenix\.|ServusHD\.|BILD\.|Silverline\.|13thStreet\.|AXN\.|SciFi\.|CrimeInvestigation\.|ComedyCentralVIVA\.|Universal\.|DiscoveryHD\.|eSports1\.)/;;\
  ## 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 || rm -f $_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\
    ## http://91.121.106.172/~rytecepg/epg_data\
    ## http://rytecepg.epgspot.com/epg_data\
    ## http://epg.vuplus-community.net\
    ## datafiles: rytecDE_Basic.xz, rytecDE_Common.xz, rytecDE_SportMovies.xz\
    $output .= qx(wget $_server/rytecDE_Basic.xz -O $_path/rytecDE_Basic.xz 2>&1 || rm -f $_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 || rm -f $_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:http://www.xmltvepg.nl,http://epg.vuplus-community.net,http://91.121.106.172/~rytecepg/epg_data,http://rytecepg.epgspot.com/epg_data
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;;\
    \
  ## 42 normal channels, 2 heading lines and 42 prime channels\
  ## 44 = 42 (normal channels) + 2 (headings)\
  ## 86 = 42 (normal channels) + 2 (headings) + 42 (prime channels)\
  ## 43 = 42 (normal channels) + 1 (first heading)\
  $TR{0,44} = "style='color:yellow;;;;text-align:center;;;;font-weight:bold;;;;font-size:18px'";;\
  $TD{0..42,44..86}{2,4} = "style='font-size:16px;;;;border-right-style:solid;;;;border-color:#CCCCCC;;;;border-right-width:1px;;;;'";;\
  $TD{0..42,44..86}{0} = "align='center' style='border-right-style:solid;;;;border-color:#CCCCCC;;;;border-right-width:1px;;;;'";;\
  $TD{0..86}{1,3,5,6} = "style='font-size:16px;;;;'";;\
  $TD{43}{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,Universal,universal)\
TPL_TV($SELF,next,SciFi,syfy)\
TPL_TV($SELF,next,ComedyCentralVIVA,comedycentral)\
TPL_TV($SELF,next,CrimeInvestigation,crimeinvest)\
TPL_TV($SELF,next,ntv,ntv)\
TPL_TV($SELF,next,N24Doku,n24)\
TPL_TV($SELF,next,phoenix,phoenix)\
TPL_TV($SELF,next,ZDFinfo,zdfinfo)\
TPL_TV($SELF,next,History,history)\
TPL_TV($SELF,next,KabelEinsDoku,kabel1doku)\
TPL_TV($SELF,next,WELT,welt)\
TPL_TV($SELF,next,ServusHD,servus)\
TPL_TV($SELF,next,BILD,bild)\
TPL_TV($SELF,next,AnimalPlanet,animalplanet)\
TPL_TV($SELF,next,GeoTV,geotv)\
TPL_TV($SELF,next,NatGeoHD,natgeo)\
TPL_TV($SELF,next,NatGeoWild,natgeowild)\
TPL_TV($SELF,next,DiscoveryHD,discovery)\
TPL_TV($SELF,next,Sky1,skyone)\
TPL_TV($SELF,next,CuriosityChannel,curiosity)\
TPL_TV($SELF,next,TLC,tlc)\
TPL_TV($SELF,next,AandE,ae)\
TPL_TV($SELF,next,eSports1,esports1)\
"&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,Universal,universal)\
TPL_TV($SELF,prime,SciFi,syfy)\
TPL_TV($SELF,prime,ComedyCentralVIVA,comedycentral)\
TPL_TV($SELF,prime,CrimeInvestigation,crimeinvest)\
TPL_TV($SELF,prime,ntv,ntv)\
TPL_TV($SELF,prime,N24Doku,n24)\
TPL_TV($SELF,prime,phoenix,phoenix)\
TPL_TV($SELF,prime,ZDFinfo,zdfinfo)\
TPL_TV($SELF,prime,History,history)\
TPL_TV($SELF,prime,KabelEinsDoku,kabel1doku)\
TPL_TV($SELF,prime,WELT,welt)\
TPL_TV($SELF,prime,ServusHD,servus)\
TPL_TV($SELF,prime,BILD,bild)\
TPL_TV($SELF,prime,AnimalPlanet,animalplanet)\
TPL_TV($SELF,prime,GeoTV,geotv)\
TPL_TV($SELF,prime,NatGeoHD,natgeo)\
TPL_TV($SELF,prime,NatGeoWild,natgeowild)\
TPL_TV($SELF,prime,DiscoveryHD,discovery)\
TPL_TV($SELF,prime,Sky1,skyone)\
TPL_TV($SELF,prime,CuriosityChannel,curiosity)\
TPL_TV($SELF,prime,TLC,tlc)\
TPL_TV($SELF,prime,AandE,ae)\
TPL_TV($SELF,prime,eSports1,esports1)

Damian · 23 Dezember 2022, 22:51:18

Ich würde solche langen Code-Passagen als Zip-Datei anhängen, sonst kann man solche Threads schlecht lesen. Vermutlich ist mein vorheriger Post schon untergegangen

mumpitzstuff · 23 Dezember 2022, 22:51:33

Zitat von: Damian am 23 Dezember 2022, 22:44:27
Also bei mir funktionieren sogar lokale Variablen:

Code Auswählen Erweitern
defmod di_tr DOIF ## attr di_tr uiTable {package ui_Table;;\ my $a=1;;\ $TR{$a+1} = "style='font-weight:bold'";;\ }\ "test"\ "test2"\ "test3"

Komisch. Dann müssen das irgendwelche Zusammenhänge mit dem recht umfangreichen DOIF sein, die hier zum tragen kommen. In dem Beitrag über diesen habe ich das aktuell DOIF mal gepostet und hier probiert die 44 aus dieser Zeile durch eine Variable zu ersetzen. Es ist mir nicht gelungen. Ich verwende auch die Variable erst nach einem Komma, vielleicht spielt das auch eine Rolle...

Code Auswählen

$TR{0,44} = "style='color:yellow;;;;text-align:center;;;;font-weight:bold;;;;font-size:18px'";;\

Das färbt die Überschriften der aktuellen Sendungen und der Prime Sendungen gelb ein, ist also eigentlich recht gut sichtbar.

mumpitzstuff · 23 Dezember 2022, 23:02:31

Code Auswählen

defmod di_tr DOIF ###
attr di_tr uiTable {\
    package ui_Table;;\
    my $a=1;;\
    $TR{0,$a+1} = "style='font-weight:bold'";;\
}\
"test"\
"test2"\
"test3"

Das geht schon nicht mehr.

Damian · 23 Dezember 2022, 23:12:32

Es liegt an dem Parsen nach dem Komma:

Code Auswählen

  $wcmd =~ s/\$hash->\{$table\}\{tr\}\{([\d,.]*)?\}.*(\".*\")/for my \$i ($1) \{\$hash->\{$table\}\{tr\}\{\$i\} = $2\}/g;

Du könntest auf zwei Definitionen ohne Komma ausweichen:

Code Auswählen

my $s= "style='color:yellow;text-align:center;font-weight:bold;font-size:18px'";
$TR{0}=$s;
$TR{44}=$s;

Per · 24 Dezember 2022, 00:14:35

@Damian:

Code Auswählen

  $TR{0} = "style=
  $TR{($_rowsnext + 2)} = "style=
  $TR{1..($_rowsnext),($_rowsnext + 3)..$lastrow} = "style=
  $TR{($_rowsnext + 1)} = "style=
  $TD{0..$lastrow}{0} = "align=
  $TD{0..$_rowsnext, ($_rowsnext + 3)..$lastrow}{1,3,5} = "style=

Diese Varianten funktionieren alle, bei einigen auch mit Variablen nach dem Komma. Aber

Code Auswählen

$TR{0,$_rowsnext + 2)} = "style=
geht nicht.

@mumpitzstuff:
Das mit den Parsen nach Uhrzeit schau ich mir mal an, klingt nicht so dumm. Muss nur schauen, wo ich es reinpacke. Das mit der 1 min habe ich nur gemacht, damit ich in der Testphase sooo lange auf Ergebnisse/Fehlermeldungen warten muss.
Tante Edit hat es fast erledigt, prime Parsing funkt noch dazwischen, aber jetzt erstmal Augen zu!
Tante Edit hat es doch noch gelöst...

Damian · 24 Dezember 2022, 10:35:59

Ich würde hier tatsächlich auf Perl zurückgreifen, das funktioniert dann immer:

Code Auswählen

defmod di_tr DOIF ##
attr di_tr uiTable {package ui_Table;;\
 my $a=0;;\
 for my $i (($a+0),($a+2)) {$TR{$i}="style='font-weight:bold'"};;\
}\
"test"\
"test2"\
"test3"

Per · 26 Dezember 2022, 03:50:00

Das Parsen nach Startzeit war nicht sooo toll, es funktioniert nur richtig, wenn $_updateBasedOnStarttimes = 1 gesetzt ist. Deshalb nutze ich jetzt die Stoppzeit, bis jetzt keine Probleme!
Die Einsparung ggü der 5 min Variante ist in der Praxis minimal, dafür werden aus Sendungen außerhalb des Rasters (Wetter) zu ihrer Zeit aktualisiert.

mumpitzstuff · 28 Dezember 2022, 11:06:49

Ich habe mir das jetzt auch noch einmal angesehen und es ist tatsächlich erschreckend, wie oft ein Update notwendig ist. In den letzten 12h hatte ich nur ein einziges 5 Minuten Raster, wo kein Update notwendig war. Die Funktion bringt deshalb doch nicht so viel, wie ursprünglich gedacht, zumindest dann nicht, wenn man eine gewisse Anzahl von Sendern überschreitet.
Aber die Sache hatte auch ein Gutes, ich habe dabei noch einen Bug entdeckt und beheben können, der mit den startTimes zusammen hängt und dafür gesorgt hat, das zu viele Readings geupdated wurden. Ich bereinige das noch und poste es dann in den nächsten Tagen.

Per · 28 Dezember 2022, 12:26:51

Hoffentlich muss ich dann nicht von vorn anfangen

Könntest du eventuell gleich gucken, ob beim Neustart/init $_updateBasedOnStarttimes = 1 (virtuell

) gesetzt werden kann.

mumpitzstuff · 28 Dezember 2022, 12:42:18

Ich habe das sowieso immer angeschaltet, also auf 1. Eigentlich könnte man auch auf den Schalter verzichten und das Verhalten zum Standard erklären.
Aber zurück zu deiner Frage, die verstehe ich nicht ganz. Selbst wenn du das ausgeschaltet haben solltest und das jetzt beim init. kurz einschalten möchtest, bringt es doch gerade da eigentlich gar nichts. Nach einem Neustart stehen noch gar keine startTimes zur Verfügung. Diese werden beim ersten Durchlauf generiert.

Der Bug befindet sich in dieser Zeile:

Code Auswählen

for (my $i = 0;; $i < (scalar(@startTimes) / 2);; $i += 2)\

muss sein:

Code Auswählen

for (my $i = 0;; $i < scalar(@startTimes);; $i += 2)\

Das hat dazu geführt, das nur die Hälfte der startTimes geupdated wurden.

Per · 28 Dezember 2022, 19:58:03

Na vllt ist das auch der Fehler, den ich mit meinem Vorschlag behoben haben wollte. Nur habe ich die falsche Ursache vermutet.

mumpitzstuff · 28 Dezember 2022, 21:56:47

Code Auswählen

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\.|ZDFinfo\.|Sat1\.|RTL2?\.|Pro(Sieben|SiebenMaxx)\.|DMax\.|Vox\.|KabelEins(?:Classic|Doku)?\.|ntv\.|Sixx\.|TLC\.|N24Doku\.|SonyEntertainmentTV\.|AnimalPlanet\.|History\.|Kinowelt\.|NatGeo(?:HD|Wild)\.|GeoTV\.|CuriosityChannel\.|Sky1\.|WELT\.|phoenix\.|ServusHD\.|BILD\.|Silverline\.|13thStreet\.|AXN\.|SciFi\.|CrimeInvestigation\.|ComedyCentralVIVA\.|Universal\.|DiscoveryHD\.|eSports1\.)/;;\
  ## 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 (sudo cpanm Time::Piece))\
  $_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 = '';;\
    my $old = time() + $_timeAdjust;;\
\
    ## check if any update is needed\
    if ((0 != $_updateBasedOnStarttimes) && ('prime' ne $mode) && keys(%{$_startTimes}))\
    {\
      my $nothingTodo = 1;;\
      foreach (keys(%{$_startTimes}))\
      {\
        if ($_startTimes{$_} <= $old)\
        {\
          $nothingTodo = 0;;\
          ::Log3 $device, 4, $device.': Update is not blocked because at least one actual program is finished (reading: '.$_.', start: '.$_startTimes{$_}.', old: '.$old.').';;\
          last;;\
        }\
      }\
      \
      if (0 != $nothingTodo)\
      {\
        ::Log3 $device, 4, $device.': Update is blocked because no actual program was finished.';;\
        return %{$_startTimes};;\
      }\
    }\
    \
    $obj = XML::Bare->new(file => $_dataFile);;\
    $xml = $obj->parse();;\
\
    if (!$@)\
    {\
      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 (reading: '.$reading.', 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 || rm -f $_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\
    ## http://91.121.106.172/~rytecepg/epg_data\
    ## http://rytecepg.epgspot.com/epg_data\
    ## http://epg.vuplus-community.net\
    ## datafiles: rytecDE_Basic.xz, rytecDE_Common.xz, rytecDE_SportMovies.xz\
    $output .= qx(wget $_server/rytecDE_Basic.xz -O $_path/rytecDE_Basic.xz 2>&1 || rm -f $_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 || rm -f $_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, @newStartTimes) = split("\\|", shift);;\
\
    for (my $i = 0;; $i < scalar(@newStartTimes);; $i += 2)\
    {\
      $_startTimes{$newStartTimes[$i]} = $newStartTimes[$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', 180, 'startParse("$SELF", "next")');;\
  set_Exec('init_prime', 420, 'startParse("$SELF", "prime")');;\
}\
{\
  if ([00:00:30|Mo Do])\
  {\
    startDownload("$SELF");;\
  }\
\
  if ([+:05])\
  {\
    ## start in a raster of 5min\
    startParse("$SELF", 'next');;\
  }\
\
  if ([00:32:30])\
  {\
    ## start between next updates\
    startParse("$SELF", 'prime');;\
  }\
}
attr doif_TEST userattr server:http://www.xmltvepg.nl,http://epg.vuplus-community.net,http://91.121.106.172/~rytecepg/epg_data,http://rytecepg.epgspot.com/epg_data
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;;\
    \
  ## 39 normal channels, 2 heading lines and 38 prime channels\
  ## 41 = 39 (normal channels) + 2 (headings)\
  ## 79 = 39 (normal channels) + 2 (headings) + 38 (prime channels)\
  ## 40 = 39 (normal channels) + 1 (first heading)\
  $TR{0,41} = "style='color:yellow;;;;text-align:center;;;;font-weight:bold;;;;font-size:18px'";;\
  $TD{0..39,41..79}{2,4} = "style='font-size:16px;;;;border-right-style:solid;;;;border-color:#CCCCCC;;;;border-right-width:1px;;;;'";;\
  $TD{0..39,41..79}{0} = "align='center' style='border-right-style:solid;;;;border-color:#CCCCCC;;;;border-right-width:1px;;;;'";;\
  $TD{0..79}{1,3,5,6} = "style='font-size:16px;;;;'";;\
  $TD{40}{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,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,Universal,universal)\
TPL_TV($SELF,next,SciFi,syfy)\
TPL_TV($SELF,next,ComedyCentralVIVA,comedycentral)\
TPL_TV($SELF,next,CrimeInvestigation,crimeinvest)\
TPL_TV($SELF,next,ntv,ntv)\
TPL_TV($SELF,next,N24Doku,n24)\
TPL_TV($SELF,next,phoenix,phoenix)\
TPL_TV($SELF,next,ZDFinfo,zdfinfo)\
TPL_TV($SELF,next,History,history)\
TPL_TV($SELF,next,KabelEinsDoku,kabel1doku)\
TPL_TV($SELF,next,WELT,welt)\
TPL_TV($SELF,next,ServusHD,servus)\
TPL_TV($SELF,next,BILD,bild)\
TPL_TV($SELF,next,AnimalPlanet,animalplanet)\
TPL_TV($SELF,next,GeoTV,geotv)\
TPL_TV($SELF,next,NatGeoHD,natgeo)\
TPL_TV($SELF,next,NatGeoWild,natgeowild)\
TPL_TV($SELF,next,DiscoveryHD,discovery)\
TPL_TV($SELF,next,Sky1,skyone)\
TPL_TV($SELF,next,CuriosityChannel,curiosity)\
TPL_TV($SELF,next,TLC,tlc)\
TPL_TV($SELF,next,eSports1,esports1)\
"&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,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,Universal,universal)\
TPL_TV($SELF,prime,SciFi,syfy)\
TPL_TV($SELF,prime,ComedyCentralVIVA,comedycentral)\
TPL_TV($SELF,prime,CrimeInvestigation,crimeinvest)\
TPL_TV($SELF,prime,ntv,ntv)\
TPL_TV($SELF,prime,N24Doku,n24)\
TPL_TV($SELF,prime,phoenix,phoenix)\
TPL_TV($SELF,prime,ZDFinfo,zdfinfo)\
TPL_TV($SELF,prime,History,history)\
TPL_TV($SELF,prime,KabelEinsDoku,kabel1doku)\
TPL_TV($SELF,prime,WELT,welt)\
TPL_TV($SELF,prime,ServusHD,servus)\
TPL_TV($SELF,prime,BILD,bild)\
TPL_TV($SELF,prime,AnimalPlanet,animalplanet)\
TPL_TV($SELF,prime,GeoTV,geotv)\
TPL_TV($SELF,prime,NatGeoHD,natgeo)\
TPL_TV($SELF,prime,NatGeoWild,natgeowild)\
TPL_TV($SELF,prime,DiscoveryHD,discovery)\
TPL_TV($SELF,prime,Sky1,skyone)\
TPL_TV($SELF,prime,CuriosityChannel,curiosity)\
TPL_TV($SELF,prime,TLC,tlc)