API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Sep 16th, 2013
303
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 17.15 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl
  2.  
  3. # xmltv2vdr.pl
  4. #
  5. # Converts data from an xmltv output file to VDR - tested with 1.2.6
  6. #
  7. # The TCP SVDRSend and Receive functions have been used from the getskyepg.pl
  8. # Plugin for VDR.
  9. #
  10. # This script requires: -
  11. #
  12. # The PERL module date::manip (required for xmltv anyway)
  13. #
  14. # You will also need xmltv installed to get the channel information:
  15. # http://sourceforge.net/projects/xmltv
  16. #
  17. # This software is released under the GNU GPL
  18. #
  19. # See the README file for copyright information and how to reach the author.
  20.  
  21. # $Id: xmltv2vdr.pl 1.0.7 2007/04/13 20:01:04 psr Exp $
  22.  
  23.  
  24. #use strict;
  25. use Getopt::Std;
  26. use Time::Local;
  27. use Date::Manip;
  28.  
  29. my $sim=0;
  30. my $verbose=0;
  31. my $adjust;
  32. my @xmllines;
  33.  
  34. # Translate HTML/XML encodings into normal characters
  35. # For some German problems, and also English
  36. sub xmltvtranslate
  37. {
  38.     my $line=shift;
  39.  
  40.     # German Requests - mail me with updates if some of these are wrong..
  41.     $line=~s/ und uuml;/ü/g;
  42.     $line=~s/ und auml;/ä/g;
  43.     $line=~s/ und ouml;/ö/g;
  44.     $line=~s/ und quot;/"/g;
  45.    $line=~s/ und szlig;/ß/g;
  46.    $line=~s/ und amp;/\&/g;
  47.    $line=~s/ und middot;/·/g;
  48.    $line=~s/ und Ouml;/Ö/g;
  49.    $line=~s/ und Auml;/Ä/g;
  50.    $line=~s/ und Uuml;/Ü/g ;
  51.    $line=~s/ und eacute;/é/g;
  52.    $line=~s/ und aacute;/á/g;
  53.    $line=~s/ und deg;/°/g;
  54.    $line=~s/ und ordm;/º/g;
  55.    $line=~s/ und ecirc;/ê/g;
  56.    $line=~s/ und ecirc;/ê/g;
  57.    $line=~s/ und ccedil;/ç/g;
  58.    $line=~s/ und curren;/€/g;
  59.    $line=~s/und curren;/€/g;
  60.    $line=~s/und Ccedil;/Ç/g;
  61.    $line=~s/ und ocirc;/ô/g;
  62.    $line=~s/ und egrave;/è/g;
  63.    $line=~s/ und agrave;/à/g;
  64.    $line=~s/und quot;/"/g;
  65.     $line=~s/und Ouml;/Ö/g;
  66.     $line=~s/und Uuml;/Ü/g;
  67.     $line=~s/und Auml;/Ä/g;
  68.     $line=~s/und ouml;/ö/g;
  69.     $line=~s/und uuml;/ü/g;
  70.     $line=~s/und auml;/ä/g;
  71.  
  72.     # English - only ever seen a problem with the Ampersand character..
  73.     $line=~s/&/&/g;
  74.  
  75.     # English - found in Radio Times data
  76.     $line=~s/—/--/g;
  77.     $line=~s/<BR \/>/|/g;
  78.  
  79.     return $line;
  80. }
  81.  
  82. # Translate genre text to hex numbers
  83. sub genre_id {
  84.     my ($xmlline, $genretxt, $genrenum) = @_;
  85.     if ( $xmlline =~ m/\<category.*?\>($genretxt)\<\/category\>/)
  86.     {
  87.          return "G $genrenum\r\n";
  88.     }
  89. }
  90.  
  91. # Translate ratings text to hex numbers
  92. sub ratings_id {
  93.     my ($xmlline, $ratingstxt, $ratingsnum) = @_;
  94.     if ( $xmlline =~ m/\<value\>($ratingstxt)\<\/value\>/)
  95.     {
  96.          return "R $ratingsnum\r\n";
  97.     }
  98. }
  99.  
  100.  
  101. # Convert XMLTV time format (YYYYMMDDmmss ZZZ) into VDR (secs since epoch)
  102. sub xmltime2vdr
  103. {
  104.     my $xmltime=shift;
  105.     my $secs = &Date::Manip::UnixDate($xmltime, "%s");
  106.     return $secs + ( $adjust * 60 );
  107. }
  108.  
  109. # Send info over SVDRP (thanks to Sky plugin)
  110. sub SVDRPsend
  111. {
  112.     my $s = shift;
  113.     if ($sim == 0)
  114.     {
  115.         print SOCK "$s\r\n";
  116.     }
  117.     else
  118.     {
  119.         print "$s\r\n";
  120.     }
  121. }
  122.  
  123. # Recv info over SVDRP (thanks to Sky plugin)
  124. sub SVDRPreceive
  125. {
  126.     my $expect = shift | 0;
  127.  
  128.     if ($sim == 1)
  129.     { return 0; }
  130.  
  131.     my @a = ();
  132.     while (<SOCK>) {
  133.         s/\s*$//; # 'chomp' wouldn't work with "\r\n"
  134.         push(@a, $_);
  135.         if (substr($_, 3, 1) ne "-") {
  136.             my $code = substr($_, 0, 3);
  137.             warn("expected SVDRP code $expect, but received $code") if ($code != $expect);
  138.             last;
  139.         }
  140.     }
  141.     return @a;
  142. }
  143.  
  144. sub EpgSend
  145. {
  146.     my ($p_chanId, $p_chanName, $p_epgText, $p_nbEvent) = @_;
  147.     # Send VDR PUT EPG
  148.     SVDRPsend("PUTE");
  149.     SVDRPreceive(354);
  150.     SVDRPsend($p_chanId . $p_epgText . "c\r\n" . ".");
  151.     SVDRPreceive(250);
  152.     if ($verbose == 1 ) { warn("$p_nbEvent event(s) sent for $p_chanName\n"); }
  153. }
  154.  
  155. # Process info from XMLTV file / channels.conf and send via SVDRP to VDR
  156. sub ProcessEpg
  157. {
  158.     my %chanId;
  159.     my %chanName;
  160.     my %chanMissing;
  161.     my $chanline;
  162.     my $epgfreq;
  163.     while ( $chanline=<CHANNELS> )
  164.     {
  165.         # Split a Chan Line
  166.         chomp $chanline;
  167.  
  168.         my ($channel_name, $freq, $param, $source, $srate, $vpid, $apid, $tpid, $ca, $sid, $nid, $tid, $rid, $xmltv_channel_name) = split(/:/, $chanline);
  169.  
  170.         if ( $source eq 'A' or $source eq 'T' )
  171.         {
  172.             $epgfreq=$freq / 1000;
  173.         }
  174.         else
  175.         {
  176.             $epgfreq=$freq;
  177.         }
  178.  
  179.         if (!$xmltv_channel_name) {
  180.             if(!$channel_name) {
  181.                 $chanline =~ m/:(.*$)/;
  182.                 if ($verbose == 1 ) { warn("Ignoring header: $1\n"); }
  183.             } else {
  184.                 if ($verbose == 1 ) { warn("Ignoring channel: $channel_name, no xmltv info\n"); }
  185.             }
  186.             next;
  187.         }
  188.         my @channels = split ( /,/, $xmltv_channel_name);
  189.         foreach my $myChannel ( @channels )
  190.         {
  191.             $chanName{$myChannel} = $channel_name;
  192.  
  193.             # Save the Channel Entry
  194.             if ($tid>0 or $nid>0)
  195.             {
  196.                 push @{ $chanId{$myChannel} }, "C $source-$nid-$tid-$sid $channel_name\r\n";
  197.             }
  198.             else
  199.             {
  200.                 push @{ $chanId{$myChannel} }, "C $source-$nid-$epgfreq-$sid $channel_name\r\n";
  201.             }
  202.         }
  203.     }
  204.  
  205.     # Set XML parsing variables
  206.     my $chanevent = 0;
  207.     my $dc = 0;
  208.     my $founddesc=0;
  209.     my $foundcredits=0;
  210.     my $creditscomplete=0;
  211.     my $description = "";
  212.     my $creditdesc = "";
  213.     my $foundrating=0;
  214.     my $setrating=0;
  215.     my $genreinfo=0;
  216.     my $gi = 0;
  217.     my $chanCur = "";
  218.     my $nbEventSent = 0;
  219.     my $atLeastOneEpg = 0;
  220.     my $epgText = "";
  221.     my $pivotTime = time ();
  222.     my $xmlline;
  223.  
  224.     # Find XML events
  225.     foreach $xmlline (@xmllines)
  226.     {
  227.         chomp $xmlline;
  228.         $xmlline=xmltvtranslate($xmlline);
  229.  
  230.         # New XML Program - doesn't handle split programs yet
  231.         if ( ($xmlline =~ /\<programme/o ) && ( $xmlline !~ /clumpidx=\"1\/2\"/o ) && ( $chanevent == 0 ) )
  232.         {
  233.             my ( $chan ) = ( $xmlline =~ m/channel\=\"(.*?)\"/ );
  234.             if ( !exists ($chanId{$chan}) )
  235.             {
  236.                 if ( !exists ($chanMissing{$chan}) )
  237.                 {
  238.                     if ($verbose == 1 ) { warn("$chan unknown in channels.conf\n"); }
  239.                     $chanMissing{$chan} = 1;
  240.                 }
  241.                 next;
  242.             }
  243.             my ( $xmlst, $xmlet ) = ( $xmlline =~ m/start\=\"(.*?)\"\s+stop\=\"(.*?)\"/o );
  244.             my $vdrst = &xmltime2vdr($xmlst);
  245.             my $vdret = &xmltime2vdr($xmlet);
  246.             if ($vdret < $pivotTime)
  247.             {
  248.                 next;
  249.             }
  250.             if ( ( $chanCur ne "" ) && ( $chanCur ne $chan ) )
  251.             {
  252.                 $atLeastOneEpg = 1;
  253.                 my @chanIds = (@{ $chanId{$chanCur} });
  254.                 foreach $id (@chanIds)
  255.                 {
  256.                     EpgSend ($id, $chanName{$chanCur}, $epgText, $nbEventSent);
  257.                 }
  258.                 $epgText = "";
  259.                 $nbEventSent = 0;
  260.             }
  261.             $chanCur = $chan;
  262.             $nbEventSent++;
  263.             $chanevent = 1;
  264.             my $vdrdur = $vdret - $vdrst;
  265.             my $vdrid = $vdrst / 60 % 0xFFFF;
  266.  
  267.             # Send VDR Event
  268.             $epgText .= "E $vdrid $vdrst $vdrdur 0\r\n";
  269.         }
  270.  
  271.         if ( $chanevent == 0 )
  272.         {
  273.             next;
  274.         }
  275.  
  276.         # XML Program Title
  277.         $epgText .= "T $1\r\n" if ( $xmlline =~ m:\<title.*?\>(.*?)\</title\>:o );
  278.  
  279.         # XML Program Sub Title
  280.         if ( $xmlline =~ m:\<sub-title.*?\>(.*?)\</sub-title\>:o )
  281.         {
  282.             $epgText .= "S $1\r\n";
  283.             $foundsubtitle=1;
  284.         }
  285.  
  286.         # XML Episode Number (set as subtitle if none already found)
  287.         if ( $foundsubtitle == 0 )
  288.         {
  289.             if ( $xmlline =~ m:\<episode-num.*?\>([0-9]*).*\.([0-9]*).*\.(.*)\</episode-num\>:o) {
  290.                 $epgText .= "S ";
  291.                 if ( length $1 > 0 ) {
  292.                     $num = sprintf("%02d", $1);
  293.                     if ( $num.atoi >= 0 ) {
  294.                         $num++;
  295.                         $epgText .= "s$num";
  296.                         $epgText .= "e";
  297.                         if (! (length $2 > 0 && $2.atoi >= 0 ) ) {
  298.                             $epgText .= "00";
  299.                         }
  300.                     }
  301.                 }
  302.                 if ( length $2 > 0 ) {
  303.                     $num = sprintf("%02d", $2);
  304.                     if ( $num.atoi >= 0 ) {
  305.                         $num++;
  306.                         $epgText .= "$num";
  307.                     }
  308.                 }
  309.                 if ( length $3 > 0 ) {
  310.                     $num = sprintf("%02d", $2);
  311.                     if ( $num.atoi >= 0 ) {
  312.                         $num++;
  313.                         $epgText .= " part $3";
  314.                     }
  315.                 }
  316.                 $epgText .= "\r\n";
  317.                 $foundsubtitle=1;
  318.             }
  319.         }
  320.  
  321.         # XML Program description at required verbosity
  322.         if ( ( $founddesc == 0 ) && ( $xmlline =~ m/\<desc.*?\>(.*?)\</o ) )
  323.         {
  324.             if ( $descv == $dc )
  325.             {
  326.                 # Send VDR Description & end of event
  327.                 $description .= "$1|";
  328.                 $founddesc=1;
  329.             }
  330.             else
  331.             {
  332.                 # Description is not required verbosity
  333.                 $dc++;
  334.             }
  335.         }
  336.         if ( ( $foundcredits == 0 ) && ( $xmlline =~ m/\<credits\>/o ) )
  337.         {
  338.             $foundcredits=1;
  339.             $creditdesc="";
  340.         }
  341.  
  342.         if ( ( $foundcredits == 1 ) && ( $xmlline =~ m:\<.*?\>(.*?)\<:o ) )
  343.         {
  344.             my $desc;
  345.             my $type;
  346.             $desc = $1;
  347.             $temp = "";
  348.             if ( $xmlline =~ m:\<(.*?)\>:o )
  349.             {
  350.                 $type = ucfirst $1;
  351.             }
  352.             $creditdesc .= "$type $desc|";
  353.         }
  354.         if ( ( $foundcredits== 1) && ( $xmlline =~ m/\<\/credits\>/o ) )
  355.         {
  356.             $foundcredits = 0;
  357.             $creditscomplete = 1;
  358.         }
  359.         if ( ( $foundrating == 0 ) && ( $xmlline =~ m:\<rating.*?\=(.*?)\>:o ) )
  360.         {
  361.             $foundrating=1;
  362.         }
  363.         if ( ( $foundrating == 1 ) && ( $ratings == 0 ) && ( $xmlline =~ m:\<value.*?\>(.*?)\<:o ) )
  364.         {
  365.             if ( $setrating == 0 )
  366.             {
  367.                 my $ratingstxt;
  368.                 my $ratingsnum;
  369.                 my $ratingsline;
  370.                 my $tmp;
  371.                 foreach my $ratingsline ( @ratinglines )
  372.                 {
  373.                     my ($ratingstxt, $ratingsnum) = split(/:/, $ratingsline);
  374.                     $tmp=ratings_id($xmlline, $ratingstxt, $ratingsnum);
  375.                     if ($tmp)
  376.                     {
  377.                         last; # break out of the while loop
  378.                     }
  379.  
  380.                 }
  381.                 if ($tmp) {
  382.                     $epgText .=$tmp;
  383.                     $setrating=1;
  384.                     $description .= "$1|";
  385.                 }
  386.             }
  387.         }
  388.         if ( $genre == 0 )
  389.         {
  390.             if ( ( $genreinfo == 0 ) && ( $xmlline =~ m:\<category.*?\>(.*?)\</category\>:o ) )
  391.             {
  392.                 if ( $genre == $gi )
  393.                 {
  394.                     my $genretxt;
  395.                     my $genrenum;
  396.                     my $genreline;
  397.                     my $tmp;
  398.                     foreach my $genreline ( @genlines )
  399.                     {
  400.                         my ($genretxt, $genrenum) = split(/:/, $genreline);
  401.                         $tmp=genre_id($xmlline, $genretxt, $genrenum);
  402.                         if ($tmp)
  403.                         {
  404.                             last; # break out of the while loop
  405.                         }
  406.                     }
  407.                     if ($tmp) {
  408.                         $epgText .=$tmp;
  409.                         $description .= "$genretxt|";
  410.                         $gi++;
  411.                         $genreinfo=1;
  412.                     }
  413.                 }
  414.                 else
  415.                 {
  416.                     # No genre information asked
  417.                     $genre++;
  418.                 }
  419.             }
  420.         }
  421.         else
  422.         {
  423.             $genreinfo=1;
  424.         }
  425.  
  426.         # No Description and or Genre found
  427.         if (( $xmlline =~ /\<\/programme/o ))
  428.         {
  429.             if (( $founddesc == 0 ) || ( $genreinfo == 0 ))
  430.             {
  431.                 if (( $founddesc == 0 ) && ( $genreinfo == 0 )) {
  432.                     $epgText .= "D Info Not Available\r\n";
  433.                     $epgText .= "G 0\r\n";
  434.                     $epgText .= "e\r\n";
  435.                 }
  436.                 if  (( $founddesc == 0 ) && ( $genreinfo == 1 )) {
  437.                     $epgText .= "D Info Not Available\r\n";
  438.                     $epgText .= "e\r\n";
  439.                 }
  440.                 if  (( $founddesc == 1 ) && ( $genreinfo == 0 )) {
  441.                     $epgText .= "D $description$creditdesc\r\n";
  442.                     $epgText .= "G 0\r\n";
  443.                     $epgText .= "e\r\n";
  444.                 }
  445.             }
  446.             else
  447.             {
  448.                 $epgText .= "D $description$creditdesc\r\n";
  449.                 $epgText .= "e\r\n";
  450.             }
  451.             $chanevent=0 ;
  452.             $dc=0 ;
  453.             $foundsubtitle=0 ;
  454.             $founddesc=0 ;
  455.             $genreinfo=0;
  456.             $foundrating=0;
  457.             $setrating=0;
  458.             $gi=0;
  459.             $creditscomplete = "";
  460.             $creditdesc = "";
  461.             $description = "";
  462.         }
  463.     }
  464.  
  465.     if ( $atLeastOneEpg )
  466.     {
  467.         my @chanIds = (@{ $chanId{$chanCur} });
  468.         foreach $id (@chanIds)
  469.         {
  470.             EpgSend ($id, $chanName{$chanCur}, $epgText, $nbEventSent);
  471.         }
  472.     }
  473. }
  474.  
  475. #---------------------------------------------------------------------------
  476. # main
  477.  
  478. use Socket;
  479.  
  480. my $Usage = qq{
  481. Usage: $0 [options] -c <channels.conf file> -x <xmltv datafile>
  482.  
  483. Options:
  484.  -a (+,-) mins      Adjust the time from xmltv that is fed
  485.                         into VDR (in minutes) (default: 0)
  486.  -c channels.conf   File containing modified channels.conf info
  487.  -d hostname            destination hostname (default: localhost)
  488.  -h         Show help text
  489.  -g genre.conf      if xmltv source file contains genre information then add it
  490.  -r ratings.conf    if xmltv source file contains ratings information then add it
  491.  -l description length  Verbosity of EPG descriptions to use
  492.                         (0-2, 0: more verbose, default: 0)
  493.  -p port                SVDRP port number (default: 6419)
  494.  -s         Simulation Mode (Print info to stdout)
  495.  -t timeout             The time this program has to give all info to
  496.                         VDR (default: 300s)
  497.  -v                 Show warning messages
  498.  -x xmltv output    File containing xmltv data
  499.  
  500. };
  501.  
  502. die $Usage if (!getopts('a:d:p:l:g:r:t:x:c:vhs') || $opt_h);
  503.  
  504. $verbose = 1 if $opt_v;
  505. $sim = 1 if $opt_s;
  506. $adjust = $opt_a || 0;
  507. my $Dest   = $opt_d || "localhost";
  508. my $Port   = $opt_p || 6419;
  509. my $descv   = $opt_l || 0;
  510. my $Timeout = $opt_t || 300; # max. seconds to wait for response
  511. my $xmltvfile = $opt_x  || die "$Usage Need to specify an XMLTV file";
  512. my $channelsfile = $opt_c  || die "$Usage Need to specify a channels.conf file";
  513. $genfile = $opt_g if $opt_g;
  514. $ratingsfile = $opt_r if $opt_r;
  515.  
  516. # Check description value
  517. if ($genfile) {
  518. $genre=0;
  519. my @genrelines;
  520. # Read the genres.conf stuff into memory - quicker parsing
  521. open(GENRE, "$genfile") || die "cannot open genres.conf file";
  522. while ( <GENRE> ) {
  523.     s/#.*//;            # ignore comments by erasing them
  524.     next if /^(\s)*$/;  # skip blank lines
  525.     chomp;
  526.     push @genlines, $_;
  527. }
  528. close GENRE;
  529. }
  530. else {
  531. $genre=1;
  532. }
  533.  
  534. if ($ratingsfile) {
  535. $ratings=0;
  536. my @ratinglines;
  537. # Read the genres.conf stuff into memory - quicker parsing
  538. open(RATINGS, "$ratingsfile") || die "cannot open genres.conf file";
  539. while ( <RATINGS> ) {
  540.     s/#.*//;            # ignore comments by erasing them
  541.     next if /^(\s)*$/;  # skip blank lines
  542.     chomp;
  543.     push @ratinglines, $_;
  544. }
  545. close RATINGS;
  546. }
  547. else {
  548. $ratings=1;
  549. }
  550.  
  551.  
  552. if ( ( $descv < 0 ) || ( $descv > 2 ) )
  553. {
  554.     die "$Usage Description out of range. Try 0 - 2";
  555. }
  556.  
  557. # Read all the XMLTV stuff into memory - quicker parsing
  558. open(XMLTV, "$xmltvfile") || die "cannot open xmltv file";
  559. @xmllines=<XMLTV>;
  560. close(XMLTV);
  561.  
  562. # Now open the VDR channel file
  563. open(CHANNELS, "$channelsfile") || die "cannot open channels.conf file";
  564.  
  565. # Connect to SVDRP socket (thanks to Sky plugin coders)
  566. if ( $sim == 0 )
  567. {
  568.     $SIG{ALRM} = sub { die("timeout"); };
  569.     alarm($Timeout);
  570.  
  571.     my $iaddr = inet_aton($Dest)                   || die("no host: $Dest");
  572.     my $paddr = sockaddr_in($Port, $iaddr);
  573.  
  574.     my $proto = getprotobyname('tcp');
  575.     socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || die("socket: $!");
  576.     connect(SOCK, $paddr)                       || die("connect: $!");
  577.     select((select(SOCK), $| = 1)[0]);
  578. }
  579.  
  580. # Look for initial banner
  581. SVDRPreceive(220);
  582. SVDRPsend("CLRE");
  583. SVDRPreceive(250);
  584.  
  585. # Do the EPG stuff
  586. ProcessEpg();
  587.  
  588. # Lets get out of here! :-)
  589. SVDRPsend("QUIT");
  590. SVDRPreceive(221);
  591.  
  592. close(SOCK);
  593.  
  594.  # vim: set sw=4 et ts=8 :
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!