1#!/usr/local/bin/perl 2###################################################################### 3# Changelog: 4# 19/04/2009 first release 5###################################################################### 6# initializations 7use warnings; 8use strict; 9 10=pod 11 12=head1 NAME 13 14tv_grab_it_dvb - Grab TV listings for Italy from the DVB-S stream 15 16=head1 SYNOPSIS 17 18tv_grab_it_dvb --help 19 20tv_grab_it_dvb [--adapter N] [--config-file FILE] --configure 21 22tv_grab_it_dvb [--config-file FILE] [--output FILE] [--days N] 23 [--offset N] [--quiet] [--verbose] [--adapter N] 24 [--no-cache-summaries] 25 26 27=head1 DESCRIPTION 28 29 Output TV listings for several channels as provided by the DVB-S stream from Skyitalia. 30 This grabber is based on the work of Lukkinosat for everything concerning the decoding of data. 31 The tuning part is mostly a port to perl of the relevant parts in szap. 32 This is an early release and should be considered beta quality. 33 34First run B<tv_grab_it_dvb --configure> to choose which channels you want 35to download. Then running B<tv_grab_it> with no arguments will output 36listings in XML format to standard output. 37 38B<--configure> Prompt for which channels, and writes the configuration file. 39 40B<--adapter> Use this adapter for tuning and grabbing. Default is 0. 41 42B<--config-file FILE> Set the name of the configuration file, the 43default is B<~/.xmltv/tv_grab_it_dvb.conf>. This is the file written 44by B<--configure> and read when grabbing. 45 46B<--gui OPTION> Use this option to enable a graphical interface to be used. 47OPTION may be 'Tk', or left blank for the best available choice. 48Additional allowed values of OPTION are 'Term' for normal terminal output 49(default) and 'TermNoProgressBar' to disable the use of XMLTV::ProgressBar. 50 51B<--output FILE> write to FILE rather than standard output. 52 53B<--days N> Grab N days. Since we cannot decide how much data we get we 54simply throw away everything above this number of days. 55 56B<--offset N> Start N days in the future. The default is to start 57from today. 58 59B<--quiet> Suppress the progress messages normally written to standard 60error. 61 62B<--no-cache-summaries> Disables caching of summaries in the file summaries.cache 63It is advised to leave this option on as the summaries part of the data stream can be very 64different between grabs, and you might get blank descriptions. 65 66B<--verbose> Prints out verbose information useful for debugging. 67Repeat (up to 4x) for more verbosiness 68 69B<--min-noname> This is a hack. As I have a situation where there are a few channels 70whose name I cannot find (usually 3 or 4) you can sat the number of channel that can 71be left nameless. Try using this if the grabber keep on running forever. 72 73B<--version> Show the version of the grabber. 74 75B<--help> Print a help message and exit. 76 77=head1 CAVEATS 78 79This grabber relies on the linux dvb api, and therefore does not run under windows. 80 81=head1 EXAMPLES 82 83=over 84 85=item tv_grab_it_dvb --adapter 2 --configure 86 87configures tv_grab_it_dvb using adapter number 2 88 89=item tv_grab_it_dvb --adapter 2 --quiet 90 91grabs the full data without displaying anything (useful in cron scripts) 92 93=back 94 95=head1 SEE ALSO 96 97L<xmltv(5)>. 98 99=head1 AUTHOR 100 101Davide Chiarini, davide.chiarini@gmail.com 102 103you can find some more help at http://www.htpcpoint.it/forum/ 104 105=cut 106 107 108use File::Slurp; 109use Linux::DVB; 110use Time::HiRes; 111use IO::Select; 112 113 114use XMLTV::Version '$Id: tv_grab_it_dvb.in,v 1.5 2016/11/23 19:41:36 knowledgejunkie Exp $'; 115#use XMLTV::Capabilities qw/baseline manualconfig cache/; 116use XMLTV::Description 'SkyEPG Italy'; 117use XMLTV::Supplement qw/GetSupplement/; 118use HTML::Entities; 119use HTML::Parser; 120use URI::Escape; 121use Getopt::Long; 122use Date::Manip; 123use XMLTV; 124use XMLTV::Memoize; 125use XMLTV::Ask; 126use XMLTV::Config_file; 127use XMLTV::ProgressBar; 128use XMLTV::DST; 129use XMLTV::Get_nice; 130use XMLTV::Mode; 131 132use XMLTV::Usage <<END 133$0: grab and parse sky italia epg from satellite dvb stream to XMLTV format 134To configure: $0 --configure [--adapter N] [--config-file FILE] 135To grab listings: $0 [--config-file FILE] [--output FILE] [--days N] 136 [--offset N] [--quiet] [--verbose] [--adapter N] 137 [--no-cache-summaries] 138To list available channels: $0 [--output FILE] [--quiet] [--adapter] --list-channels 139Repeat --verbose to increase verboseness. 140To show version: $0 --version 141END 142 ; 143 144# Use Log::TraceMessages if installed. 145BEGIN { 146 eval { require Log::TraceMessages }; 147 if ($@) { 148 *t = sub {}; 149 *d = sub { '' }; 150 } 151 else { 152 *t = \&Log::TraceMessages::t; 153 *d = \&Log::TraceMessages::d; 154 Log::TraceMessages::check_argv(); 155 } 156} 157 158my $DEBUG = 0; 159#if $DEBUG is 1 we dump all of the hashes when ctrl-c 160$SIG{INT} = \&closeup; 161 162# default values and global variables 163my $LANG="it"; 164my $date_today = UnixDate("today", '%Y-%m-%d'); 165 166#this is the transponder we tune to 167#polarity is: Vertical=1 Horizontal=0 168my ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (11880000, FEC_3_4, INVERSION_AUTO, 27500000, 1); 169#other possible transponders 170#tp1($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (11219000, FEC_3_4, INVERSION_AUTO, 27500000, 0); 171#tp 8 ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (11355000, FEC_3_4, INVERSION_AUTO, 27500000, 1); 172#tp 52 ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (11785000, FEC_3_4, INVERSION_AUTO, 27500000, 0); 173#tp 56 ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (11843000, FEC_3_4, INVERSION_AUTO, 27500000, 1); 174#tp 57 ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (11862000, FEC_3_4, INVERSION_AUTO, 27500000, 0); 175#-->tp 58 ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (11881000, FEC_3_4, INVERSION_AUTO, 27500000, 1); 176#tp 59 ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (11900000, FEC_3_4, INVERSION_AUTO, 27500000, 0); 177#tp 62 ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (11958000, FEC_3_4, INVERSION_AUTO, 27500000, 1); 178#tp 63 ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (11977000, FEC_3_4, INVERSION_AUTO, 27500000, 0); 179#tp 64 ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (11996000, FEC_3_4, INVERSION_AUTO, 27500000, 1); 180#tp 66 ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (12034000, FEC_3_4, INVERSION_AUTO, 27500000, 1); 181#tp 67 ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (12054000, FEC_3_4, INVERSION_AUTO, 27500000, 0); 182#tp 68 ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = (12073000, FEC_3_4, INVERSION_AUTO, 27500000, 1); 183 184 185my $MAX_ACTIVE_FILTERS = 6; 186my $TIMEOUT_FILTER = 5000; # ms 187my $read_buf_size = 2*4096; 188my $starttime = time; 189#we close the grabber after this many seconds, even if filters are still open (or stuck...) 190my $maxtime = 3600; 191 192 193my $endBAT = 0; 194#don't know why I get different results through consecutive grabs. to avoid this I grab the BAT table this many times: 195my $maxBAT = 5; 196my $endSDT = 0; 197my $id_SDT = 100000; 198my $nchannelsSDT = 0; 199my $channelsBAT = 0; 200my $sigint_stop = 0; 201 202my $fe; #dvb frontend 203 204 205#the filters in loadepg have a mask, but if I use it I don't get any data... am I missing something? 206# ([0x11, 0x4a ], [ 0x11, 0x42 ], [ 0x11, 0x46 ], [ 0x30, 0xa0, 0xfc ], [ 0x31, 0xa0, 0xfc ], [ 0x32, 0xa0, 0xfc ], [ 0x33, 0xa0, 0xfc ], 207# [ 0x34, 0xa0, 0xfc ], [ 0x35, 0xa0, 0xfc ], [ 0x36, 0xa0, 0xfc ], [ 0x37, 0xa0, 0xfc ], [ 0x40, 0xa8, 0xfc ], [ 0x41, 0xa8, 0xfc ], 208# [ 0x42, 0xa8, 0xfc ], [ 0x43, 0xa8, 0xfc ], [ 0x44, 0xa8, 0xfc ], [ 0x45, 0xa8, 0xfc ], [ 0x46, 0xa8, 0xfc ], [ 0x47, 0xa8, 0xfc ]); 209 210my %filters = ( 211 0, { pid_mask => [ 0x11, 0x4a ]}, 212 1, { pid_mask => [ 0x11, 0x42 ]}, 213 2, { pid_mask => [ 0x11, 0x46 ]}, 214 3, { pid_mask => [ 0x30, 0xa0 ]}, 215 4, { pid_mask => [ 0x31, 0xa0 ]}, 216 5, { pid_mask => [ 0x32, 0xa0 ]}, 217 6, { pid_mask => [ 0x33, 0xa0 ]}, 218 7, { pid_mask => [ 0x34, 0xa0 ]}, 219 8, { pid_mask => [ 0x35, 0xa0 ]}, 220 9, { pid_mask => [ 0x36, 0xa0 ]}, 221 10, { pid_mask => [ 0x37, 0xa0 ]}, 222 11, { pid_mask => [ 0x40, 0xa8 ]}, 223 12, { pid_mask => [ 0x41, 0xa8 ]}, 224 13, { pid_mask => [ 0x42, 0xa8 ]}, 225 14, { pid_mask => [ 0x43, 0xa8 ]}, 226 15, { pid_mask => [ 0x44, 0xa8 ]}, 227 16, { pid_mask => [ 0x45, 0xa8 ]}, 228 17, { pid_mask => [ 0x46, 0xa8 ]}, 229 18, { pid_mask => [ 0x47, 0xa8 ]}, 230); 231 232 233my %channels; #to store site-id-> xmltv_id 234my %channels_info; #we store all of the channel data we have in here 235my %display_names; #used in configuration 236my %site_ids; 237my %bouquets; 238my %titles; 239my %seen_descs; 240 241###################################################################### 242# Get options, including undocumented --cache option. 243 244my ($opt_days, 245 $opt_offset, 246 $opt_help, 247 $opt_output, 248 $opt_verbose, 249 $opt_configure, 250 $opt_config_file, 251 $opt_gui, 252 $opt_quiet, 253 $opt_list_channels, 254 $opt_adapter, 255 $opt_no_cache_summaries, 256 $opt_share, 257 $opt_min_noname, 258 ); 259 260$opt_offset = 0; # default 261$opt_quiet = 0; # default 262$opt_adapter = 0; # default 263$opt_verbose = 0; # default 264$opt_days = 99; # default 265$opt_min_noname = 3; # default 266 267GetOptions('days=i' => \$opt_days, 268 'offset=i' => \$opt_offset, 269 'help' => \$opt_help, 270 'configure' => \$opt_configure, 271 'config-file=s' => \$opt_config_file, 272 'gui:s' => \$opt_gui, 273 'output=s' => \$opt_output, 274 'quiet' => \$opt_quiet, 275 'verbose+' => \$opt_verbose, 276 'list-channels' => \$opt_list_channels, 277 'adapter=i' => \$opt_adapter, 278 'share=s' => \$opt_share, 279 'min-noname=i' => \$opt_min_noname, 280 'no-cache-summaries' => \$opt_no_cache_summaries, 281 ) 282 or usage(0); 283die "number of days (--days) must not be negative. You gave: $opt_days\n" if (defined $opt_days && $opt_days < 0); 284die "offset days (--offset) must not be negative. You gave: $opt_offset\n" if ($opt_offset < 0); 285usage(1) if $opt_help; 286 287$opt_verbose = 0 if ($opt_quiet); 288 289my $SHARE_DIR = undef; 290$SHARE_DIR = $opt_share if defined $opt_share; 291my $OUR_SHARE_DIR = (defined $SHARE_DIR) ? "$SHARE_DIR/tv_grab_it_dvb" : '.'; 292 293#this is the huffman dictionary 294my $code = load_code_table("$OUR_SHARE_DIR/sky_it.dict"); 295#this is the category db 296my $themes = load_themes("$OUR_SHARE_DIR/sky_it.themes"); 297 298#we cache descriptions 299unless ($opt_no_cache_summaries) { 300 if (-f 'summaries.cache') { 301 rename 'summaries.cache', 'oldsummaries.cache' or die $!; 302 } 303 open CACHE, ">summaries.cache" or die $! ; 304} 305 306 307#since we cannot decide what data we receive we will just throw away what we don't want 308$opt_days = $opt_days; 309my $mode = XMLTV::Mode::mode('grab', 310 $opt_list_channels => 'list-channels', 311 $opt_configure => 'configure'); 312 313XMLTV::Ask::init($opt_gui); 314 315# reads the file channel_ids, which contains the tables to convert 316# between backends' ids and XMLTV ids of channels. 317# there are two fields: xmltv_id and site_id. 318#my $str = GetSupplement( "tv_grab_it_dvb", "channel_ids" ); 319my $str = read_file( "$OUR_SHARE_DIR/channel_ids") ; 320my $CHANNEL_NAMES_FILE = "channel_ids"; 321 322my %seen; 323my $line_num = 0; 324 325foreach (split( /\n/, $str )) { 326 ++ $line_num; 327 tr/\r//d; 328 329 s/#.*//; 330 next if m/^\s*$/; 331 332 my $where = "$CHANNEL_NAMES_FILE:$line_num"; 333 my @fields = split /;/; 334 die "$where: wrong number of fields" if @fields != 2;#3; 335 my ($xmltv_id, $site_id) = @fields; 336 warn "$where: $site_id already seen\n" if $seen{$site_id}++; 337 warn "$where: XMLTV_id $xmltv_id already seen\n" if $seen{$xmltv_id}++; 338 $channels{$site_id}=$xmltv_id; 339} 340 341# File that stores which channels to download. 342my $config_file; 343$config_file= XMLTV::Config_file::filename($opt_config_file, 'tv_grab_it_dvb', $opt_quiet) unless ($mode eq 'list-channels'); 344XMLTV::Config_file::check_no_overwrite($config_file) if $mode eq 'configure'; 345 346# Arguments for XMLTV::Writer. 347my %w_args; 348if (defined $opt_output) { 349 die "cannot give --output with --configure" if $mode eq 'configure'; 350 my $fh = new IO::File(">$opt_output"); 351 die "cannot write to $opt_output: $!" if not defined $fh; 352 $w_args{OUTPUT} = $fh; 353} 354$w_args{encoding} = 'ISO-8859-1'; 355 356 357$line_num = 0; 358my $foundchannels; 359 360######################################################### 361# tune dvb 362tune($freq, $fec_inner, $inversion, $symbol_rate, $polarity) || die ("error tuning adapter $opt_adapter\n"); 363my $bar = new XMLTV::ProgressBar('getting list of channels', 3) unless ($opt_quiet); 364# find list of available channels 365# to do this we poll the first three filters 366pollfilters(4000, [0, 1, 2]); 367 368foreach (keys %channels_info) { 369 next unless (defined $channels_info{$_}{name} and defined $channels_info{$_}{sky_number}); 370 my $xmltv_id = xmltv_chanid($channels_info{$_}{name}); 371 372 $channels{$channels_info{$_}{name}}=$xmltv_id; 373 $site_ids{$xmltv_id} = $_; 374 375} 376$bar->finish() if (not $opt_quiet); 377$foundchannels=scalar(keys(%channels)); 378die ("no channels could be found\n") unless ($foundchannels); 379warn ("VERBOSE: $foundchannels channels found.\n") if ($opt_verbose); 380 381 382 383###################################################################### 384# write configuration 385if ($mode eq 'configure') { 386 open(CONF, ">$config_file") or die "cannot write to $config_file: $!"; 387 388 # Ask about each channel. 389 my @names = sort keys %channels; 390 my @qs = map { "add channel $_?" } @names; 391 my @want = ask_many_boolean(1, @qs); 392 393 foreach (@names) { 394 die if $_ =~ tr/\r\n//; 395 my $w = shift @want; 396 warn("cannot read input, stopping channel questions"), last 397 if not defined $w; 398 # No need to print to user - XMLTV::Ask is verbose enough. 399 400 # Print a config line, but comment it out if channel not wanted. 401 print CONF '#' if not $w; 402 print CONF "channel ".$channels{$_}." # $_\n"; 403 } 404 405 close CONF or warn "cannot close $config_file: $!"; 406 say("Finished configuration."); 407 408 exit(); 409} 410 411# Not configuring, must be writing some XML. 412my $w = new XMLTV::Writer(%w_args); 413 414$w->start({ 'source-info-url' => 'http://www.skylife.it', 415 'source-data-url' => 'http://www.skylife.it', 416 'generator-info-name' => 'XMLTV', 417 'generator-info-url' => 'http://www.xmltv.org', 418 }); 419 420 421 422%display_names = reverse %channels; 423if ($mode eq 'list-channels') { 424 # Write all known channels then finish. 425 foreach my $xmltv_id (sort keys %display_names) { 426 my @chaninfo; 427 my $id = $site_ids{$xmltv_id}; 428 #@chaninfo = ('display-name' => [ [ $display_names{$xmltv_id}], [ $channels_info{$id}{sky_number}], [$id]]); 429 @chaninfo = ('display-name' => [ [ $display_names{$xmltv_id}], [ $channels_info{$id}{sky_number}]]); 430 #test for icons 431 my $iconurl = 'http://guidatv.sky.it/app/guidatv/images/epgimages/channels/grid/'.$channels_info{$id}{sky_number}.'_grid.gif'; 432 push @chaninfo , (icon => [{src => $iconurl}]); 433 434 $w->write_channel({ 435 id => $xmltv_id, 436 @chaninfo 437 }); 438 } 439 $w->end; 440 441 exit; 442} 443 444 445###################################################################### 446# read configuration 447my @channels; 448$line_num = 0; 449foreach (XMLTV::Config_file::read_lines($config_file)) { 450 ++ $line_num; 451 next if not defined; 452 if (/^channel:?\s*(.*\S+)\s*$/) { 453 push @channels, $1; 454 } 455 else { 456 warn "$config_file:$line_num: bad line\n"; 457 } 458} 459 460 461 462 463 464###################################################################### 465# grabbing listings 466 467foreach my $xmltv_id (@channels) { 468 my @chaninfo; 469 my $id = $site_ids{$xmltv_id}; 470 next unless ($id);#fixme 471 @chaninfo = ('display-name' => [ [ $display_names{$xmltv_id}], [ $channels_info{$id}{sky_number}]]); 472 #@chaninfo = ('display-name' => [ [ $display_names{$xmltv_id}], [ $channels_info{$id}{sky_number}], [$id]]); 473 #test for icons 474 my $iconurl = 'http://guidatv.sky.it/app/guidatv/images/epgimages/channels/grid/'.$channels_info{$id}{sky_number}.'_grid.gif'; 475 push @chaninfo , (icon => [{src => $iconurl}]); 476 477 $w->write_channel({ 478 id => $xmltv_id, 479 @chaninfo 480 }); 481} 482 483#make a list of channels and days to grab, actually a list of stuff not to throw away 484my %to_get; 485my %not_found; #l'id e' scomparso rispetto al channel_ids 486foreach my $day ($opt_offset .. ($opt_days + $opt_offset - 1)) { 487 #date calc 488 my $data = UnixDate(&DateCalc("today","+ ".$day." days"), '%Y%m%d'); 489 die ('date calculation failed') if not defined $data; 490 foreach my $channel (@channels) { 491 if (not defined $site_ids{$channel}) { 492 warn "channel $channel non esiste=!=!=?!??\n" unless ($not_found{$channel}++); 493 next; 494 } 495 $to_get{$site_ids{$channel}.";".$data}++; 496 } 497} 498$bar = new XMLTV::ProgressBar('getting listings', ((scalar keys %filters) -2)) if not $opt_quiet; 499 500#this is where we grab the data 501pollfilters(4000, [3..18]); 502 503 504if (not $opt_no_cache_summaries and -f 'oldsummaries.cache') { 505 warn "reading summaries from cache\n" if ($opt_verbose); 506 open OLDCACHE, "<oldsummaries.cache"; 507 while (<OLDCACHE>) { 508 my ($date, $channel_id, $event_id, $desc) = split /\|/, $_; 509 if (not $seen_descs{"$date|$channel_id|$event_id"} and $to_get{"$channel_id;$date"}) { 510 print CACHE "$date|$channel_id|$event_id|$desc|\n"; 511 $seen_descs{"$date|$channel_id|$event_id"}++; 512 if ($desc ne '') { 513 $titles{$channel_id}{$event_id}->{desc}=[[$desc, $LANG] ]; 514 my %data; 515 skylife_parse_data_slow($desc, \%data); 516 foreach (keys %data) { 517 $titles{$channel_id}{$event_id}{$_}=$data{$_} if (not defined $titles{$channel_id}{$event_id}{$_}); #we might have duplicates 518 } 519 } 520 } 521 } 522 close OLDCACHE; 523} 524 525foreach my $channel_id (keys %titles) { 526 my $xmltv_id = xmltv_chanid($channels_info{$channel_id}{name}); 527 foreach my $program_id(keys %{$titles{$channel_id}}) { 528 my $programme; 529 530 $programme->{channel} = $xmltv_id; 531 foreach (keys %{$titles{$channel_id}{$program_id}}) { 532 $programme->{$_} = $titles{$channel_id}{$program_id}{$_}; 533 } 534 535 $w->write_programme($programme) if (defined $programme->{start} and defined $programme->{title}); #i think we might have some orphan summaries 536 } 537} 538 539 540 541$w->end; 542$bar->finish() if not $opt_quiet; 543close CACHE unless ($opt_no_cache_summaries); 544unlink 'oldsummaries.cache' unless ($opt_no_cache_summaries); 545##################### 546# general functions # 547##################### 548 549#################################################### 550# xmltv_chanid 551# to handle channels that are not yet in the channel_ids file 552sub xmltv_chanid { 553 my $channel_id = shift; 554 555 return unless ($channel_id); 556 557# my %chan_ids = reverse %channels; 558 559 if (defined $channels{$channel_id}) { 560 return $channels{$channel_id}; 561 } 562 else { 563 warn ("***Channel |$channel_id| is not in channel_ids, should be updated.\n") unless $opt_quiet; 564 565 #print("$channel_id\n"); 566 my $or_channel_id = $channel_id; 567 $channel_id=~ s/\W//gs; 568 569 #make up an id 570 my $id = lc($channel_id).".skyepg.dvb"; 571 $channels {$or_channel_id} = $id; 572 573 574 return $id; 575 } 576} 577 578######################################################### 579# tidy 580# decodes entities and removes some illegal chars 581sub tidy { 582 for (my $tmp=shift) { 583 s/[\000-\037]//gm; # remove control characters 584 s/[\222]/\'/gm; # messed up char 585 s/[\224]/\"/gm; # end quote 586 s/[\205]/\.\.\./gm; # ... must be something messed up in my regexps? 587 s/[\223]/\"/gm; #start quote 588 s/[\221]/\'/gm; 589 s/\\\'/\'/gm; 590 #s/�/�/gm;# s/è/�/g;# s/�/\'/g;# s/è/�/g;# s/à/�/g;# s/ì/�/g;# s/�/\.\.\./g; #mah... 591 592 593 if (s/[\200-\237]//g) { 594 if ($opt_verbose){ 595 warn ("VERBOSE: removing illegal char: |\\".ord($&)."|\n"); 596 } 597 } 598 599 # Remove leading white space 600 s/^\s*//; 601 # Remove trailing white space 602 s/\s*$//; 603 return decode_entities($_); 604 } 605} 606 607 608 609sub skylife_parse_data_slow { 610 my ($desc, $programme) = @_; 611 612 my ($cast, $country, $director, $year, $length, $subtitle, $episode, $season, $prossima, $fulldesc, $filmcat); 613 $desc=~s/\\\'/\'/igm; 614 615 if ($desc=~/(.*?)\' Stagione - Ep.(\d+?) - (.*)/) { 616 $season = $1; 617 $episode =$2; 618 $desc = $3 if ($3 ne ''); 619 } 620 elsif ($desc=~/(.*?)\' Stagione Episodio (\d+?) - (.*)/) { 621 $season = $1; 622 $episode =$2; 623 $desc = $3 if ($3 ne ''); 624 } 625 elsif ($desc=~/(.*?)\' Stagione Ep.(\d+?) -(.*)/) { 626 $season = $1; 627 $episode =$2; 628 $desc = $3 if ($3 ne ''); 629 } 630 631 if ($desc=~/(.*?) - (.*)/) { 632#fixme $subtitle = $1 if ($1 ne '' and $1 ne $programme->{title}); 633 $subtitle = $1 if ($1 ne ''); 634 $desc = $2 if ($2 ne ''); 635 636 if ($subtitle=~/(.*?)\\\' Stagione/){$season = $1;} 637 if ($subtitle=~/Ep.(\d+)/) {$episode = $1;} 638 $subtitle='' if ($season or $episode); 639 } 640 $desc=~s/^\s+//; 641 642 643 if ($desc=~/^\'(.*?)\' (.*)/) { 644 $subtitle.= ' - ' if ($subtitle); 645#fixme $subtitle= $1 if ($1 ne '' and $1 ne $programme->{title}); 646 $subtitle= $1 if ($1 ne ''); 647 $desc = $2 if ($2 ne ''); 648 } 649 650 my $strseason = ''; 651 $strseason.= 'Stagione '.$season if ($season); 652 if ($episode and $season){ 653 $strseason.= ' Episodio '.$episode ; 654 } 655 elsif ($episode) { 656 $strseason.= 'Episodio '.$episode ; 657 } 658 659 if ($strseason ne '' and $subtitle){ 660 $subtitle="$strseason - ".$subtitle ; 661 } 662 elsif ($strseason ne '') { 663 $subtitle=$strseason; 664 }; 665 666 $fulldesc = $desc; 667# if ($cat eq 'film'){ 668# if ($desc=~/(.*) (Prox:.*)$/) { 669# $desc = $1; 670# $prossima = $2; 671# } 672# } 673 674 if ($desc=~/(.*)\. (\w+)\. \((\d+)\'\) Di (.*?). Con (.*?) \(([A-Z]+) (\d+?)\)$/) { 675 $filmcat = $2; 676 $length = $3; 677 $director = $4; 678 $cast = $5; 679 $country = $6; 680 $year = $7; 681 $desc = $1 || ''; 682 } 683 elsif ($desc=~/Regia di (.*?), con (.*?); (.*?) (\d+?)\.(.*)/) { 684 $director = $1; 685 $cast = $2; 686 $country = $3; 687 $year = $4; 688 my $length = $5; 689 $desc = $6 || ''; 690 } 691 elsif ($desc=~/Regia di (.*?), con (.*?); (.*?) (\d+?) \((\d+) min\)\. (.*)/) { 692 $director = $1; 693 $cast = $2; 694 $country = $3; 695 $year = $4; 696 my $length = $5; 697 $desc = $6 || ''; 698 } 699 elsif ($desc=~/^(\d+)\. Con ([A-Z].*?)\.(.*)/) { 700 $year = $1; 701 $cast = $2; 702 $desc = $3 || ''; 703 } 704 elsif ($desc=~/^Con ([A-Z].*?)\. (.*)/) { 705 $cast = $1; 706 $desc = $2 || ''; 707 } 708 709 #tricky one 710 if ($desc=~/^con (.*?)\. (.*)/) { 711 $desc = $2; 712 $cast = $1; 713 if ($cast=~/(.*?); (.*)/) { 714 $cast = $1; 715 $country = $2; 716 } 717 } 718 719 720 if ($cast) { 721 my $lastcast; 722 ($cast, $lastcast) = split / e /, $cast; 723 my @cast = split /,/, $cast; push @cast, $lastcast if ($lastcast); 724 foreach (@cast) { 725 s/^\s+//; s/\s+$//; 726 (push @{$programme->{credits}->{actor}}, $_); 727 } 728 } 729 730# $content=~s/[\n|\r]+//gm; 731 undef $season if (defined $season and $season!~/\d+/); 732 733 $programme->{length}= $length*60 if ($length); 734 $programme->{date}= $year if ($year); 735 $programme->{'sub-title'}=[[$subtitle, $LANG] ] if ($subtitle); 736 push@{$programme->{'episode-num'}}, [$strseason, 'onscreen'] if ($strseason); 737 push@{$programme->{'episode-num'}}, [(defined $season ? ($season-1) : '').".".(defined $episode ? ($episode-1) : '').".0/1", 'xmltv_ns'] if ($strseason); 738 #push@{$programme->{category}}, [tidy($filmcat), $LANG ] if (tidy($filmcat) ne ''); 739 740 push @{$programme->{credits}->{director}}, $director if ($director); 741 push (@{$programme->{country}}, [$country, $LANG]) if ($country); 742 $programme->{desc}=[[tidy($fulldesc), $LANG ]] if ($fulldesc ne ''); 743} 744 745 746 747############################################################## 748# loads huffman dictionary to decode text data, from lukkinosat 749sub load_code_table { 750 my %ct; 751 752 warn ("VERBOSE: reading huffman dictionary table.\n") if ($opt_verbose); 753 my $filename = shift; 754 my @lines = read_file($filename) ; 755 756 foreach (@lines) { 757 chop; 758 my ($t, $c) = split /=/; 759 if (exists $ct{"$c"}) { 760 die "huffman table: code $t for $c already exists!\n"; 761 } 762 else { 763 $ct{"$c"} = "$t"; 764 } 765 } 766 return \%ct; 767} 768 769############################################################## 770# loads byte->category table, from lukkinosat 771sub load_themes { 772 my %ct; 773 774 warn ("VERBOSE: reading category table.\n") if ($opt_verbose); 775 my $filename = shift; 776 my @lines = read_file($filename) ; 777 778 foreach (@lines) { 779 chop; 780 my ($t, $c) = split /=/; 781 $t=~/..(..)/; $t=hex($1); 782 if (exists $ct{"$t"}) { 783 die "category table: code $t for $c already exists!\n"; 784 } 785 else { 786 $ct{"$t"} = "$c"; 787 } 788 } 789 return \%ct; 790} 791 792############################################################## 793# huffman decoding 794sub dehuff { 795 my $string = shift; 796 my $decode = shift; 797 798 799 my $string2= unpack('B*', $string); #not b*!!! 800 #discard first two bits 801 $string2=~/^..(.*)$/; 802 $string2=$1; 803 804 my $ret = ''; my $c = ''; 805 for (split//, $string2){ 806 $c .= $_; 807 next unless (exists $decode->{$c}); 808 last if ($decode->{$c} eq '_eos'); 809 810 $ret .= $decode->{$c}; 811 $c = ''; 812 } 813 814 return $ret; 815} 816 817########################################################################################## 818#all of the tuning stuff, diseqc, and so on is mostly a port of the according parts in szap 819sub tune { 820 my ($freq, $fec_inner, $inversion, $symbol_rate, $polarity) = @_; 821 my $ifreq; 822 823 #this comes from szap, not sure if it will ever be useful here 824 my %lnb_types=( 825 'UNIVERSAL'=>{ 826 description=> "Europe\n"."10800 to 11800 MHz and 11600 to 12700 Mhz\n"."Dual LO, loband 9750, hiband 10600 MHz", 827 low_val => 9750, 828 high_val => 10600, 829 switch_val => 11700 830 }, 831 'DBS'=>{ 832 description=> "Expressvu, North America\n"."12200 to 12700 MHz\n"."Single LO, 11250 MHz", 833 low_val => 11250, 834 high_val => 0, 835 switch_val => 0 836 }, 837 'STANDARD'=>{ 838 description=> "10945 to 11450 Mhz\n"."Single LO, 10000 Mhz\n", 839 low_val => 10000, 840 high_val => 0, 841 switch_val => 0 842 }, 843 'ENHANCED'=>{ 844 description=> "Astra\n"."10700 to 11700 MHz\n"."Single LO, 9750 MHz", 845 low_val => 9750, 846 high_val => 0, 847 switch_val => 0 848 }, 849 'C-BAND'=>{ 850 description=> "Big Dish\n"."3700 to 4200 MHz\n"."Single LO, 5150 Mhz", 851 low_val => 5150, 852 high_val => 0, 853 switch_val => 0 854 } 855 ); 856 857 my %lnb_type=%{$lnb_types{'UNIVERSAL'}}; 858 $lnb_type{low_val} *= 1000; # convert to kiloherz */ 859 $lnb_type{high_val} *= 1000;# convert to kiloherz */ 860 $lnb_type{switch_val} *= 1000; # convert to kiloherz */ 861 862 my $hiband = 0; 863 $hiband = 1 if ($lnb_type{switch_val} && $lnb_type{high_val} && $freq >= $lnb_type{switch_val}); 864 865 my $sat_no = 0; #not sure what this is yet 866 867 if ($hiband) {$ifreq = $freq - $lnb_type{high_val};} 868 else { 869 if ($freq < $lnb_type{low_val}) { 870 $ifreq = $lnb_type{low_val} - $freq; 871 } 872 else {$ifreq = $freq - $lnb_type{low_val};} 873 } 874 875 876 warn ("VERBOSE: starting tuning process, adapter $opt_adapter.\n") if ($opt_verbose); 877 $fe = new Linux::DVB::Frontend "/dev/dvb/adapter$opt_adapter/frontend0", 1; 878 die("errore nell'aprire frontend!!\n") if (not defined $fe); 879 $fe->blocking (1); 880 881 if ($opt_verbose > 1) { 882 warn "VERBOSE: DVB: adapter number $opt_adapter\n"; 883 warn "VERBOSE: DVB: adapter name: ".$fe->{name}."\n"; 884 warn "VERBOSE: DVB: ber: ".$fe->read_ber." snr: ".$fe->read_snr." signal strength: ".$fe->signal_strength."\n"; 885 } 886 887 if (diseqc($sat_no, $polarity, $hiband)){ 888 if (do_tune($ifreq, $symbol_rate)) { 889 my $status; 890 for (0..10) { 891 $status = print_frontend_status($fe->read_status); 892 warn "status: $status \n" if ($opt_verbose > 1); 893 last if ($status=~/HAS_LOCK/); 894 sleep(1); 895 } 896 die "DVB: can't tune!\n" unless ($status=~/HAS_LOCK/); 897 } 898 else { 899 return 0; 900 } 901 } 902 903 return 1; 904} 905 906 907sub do_tune { 908 my ($ifreq, $sr) = @_; 909 910 die("DVB: FE_SET_FRONTEND failed") unless 911 ($fe->set ( 912 fec_inner => FEC_AUTO, 913 frequency => $ifreq, 914 inversion => INVERSION_AUTO, 915 symbol_rate => $sr)); 916 917 return 1; 918} 919 920#this whole process is explained in the linux dvb api 921sub diseqc_send_msg { 922 my ($voltage, $cmd, $tone, $mini) = @_; 923 924 die("DVB: FE_SET_TONE failed") if ($fe->diseqc_tone(0) == -1); 925 die("DVB: FE_SET_VOLTAGE failed") if ($fe->diseqc_voltage($voltage) == -1); 926 Time::HiRes::usleep (15*1000); 927 928 die("DVB: FE_DISEQC_SEND_MASTER_CMD failed") if ($fe->diseqc_cmd($cmd->{msg}) == -1); 929 Time::HiRes::usleep ($cmd->{wait}*1000) if ($cmd->{wait}); 930 Time::HiRes::usleep (15*1000); 931 932 die("DVB: FE_DISEQC_SEND_BURST failed") if ($fe->diseqc_send_burst($mini) == -1); 933 Time::HiRes::usleep (15*1000); 934 die("DVB: FE_SET_TONE failed") if ($fe->diseqc_tone($tone) == -1); 935 936 return 1; 937} 938 939 940sub diseqc { 941 my ($sat_no, $pol_vert, $hi_band) = @_; 942 943 my $cmd; 944 @{$cmd->{msg}} = (0xe0, 0x10, 0x38, 0xf0); 945 $cmd->{msg_len} = 4; 946 947 $cmd->{msg}->[3] = 0xf0 | ((($sat_no * 4) & 0x0f) | ($hi_band ? 1 : 0) | ($pol_vert ? 0 : 2)); 948 949 diseqc_send_msg($pol_vert ? 13 : 18, 950 $cmd, $hi_band ? 1 : 0, 951 ($sat_no / 4) % 2 ? 1 : 0); 952 953 return 1; 954} 955# end dvb tuning stuff 956 957 958########################################################################################## 959# we pass this sub: timeout for reading data; the id of the filters we want to start 960sub pollfilters{ 961 my ($timeout, $filternums) = @_; 962 963 my $MAX_FILTERS = ($MAX_ACTIVE_FILTERS > scalar @{$filternums} ? scalar @{$filternums} : $MAX_ACTIVE_FILTERS); 964 965 my $sel = new IO::Select; 966 967 warn "VERBOSE: Starting $MAX_FILTERS filters\n" if ($opt_verbose > 1); 968 for (0..($MAX_FILTERS-1)) { 969 start_filter($sel, $filternums->[$_]); 970 } 971 972 warn "VERBOSE: Starting polling\n" if ($opt_verbose > 1); 973 while (my @ready = $sel->can_read($timeout)) { 974 foreach my $fd (@ready) { 975 warn print_filters_status() if ($opt_verbose > 2); 976 my $buf=""; 977 my $filter = get_filter_no($fd); 978 next if (not defined $filter); 979 sysread($fd, $buf, $read_buf_size); 980 if (parsebuf($filter, $buf)) { #parsebuf returns 1 if filters needs to be stopped 981 next unless($filters{$filter}->{finished}); 982 $filters{$filter}->{demux}->stop; 983 $sel->remove($filters{$filter}->{demux}->fh); 984 $filters{$filter}->{active}=0; 985 update $bar if (not $opt_quiet); 986 my $all_done = 1; 987 my $active_filters = 0; 988 #we start another filter 989 checktime(); 990 foreach my $filternum (0..(scalar @{$filternums}-1)){ 991 $active_filters++ if($filters{$filternums->[$filternum]}->{active}); 992 last if ($active_filters>=($MAX_FILTERS-1)); 993 next if($filters{$filternums->[$filternum]}->{finished}); 994 next if($filters{$filternums->[$filternum]}->{active}); 995 $all_done = 0; 996 start_filter($sel, $filternums->[$filternum]); 997 checktime(); 998 last; 999 } 1000 last if ($all_done); 1001 } 1002 } 1003 } 1004 warn print_filters_status() if ($opt_verbose > 2); 1005} 1006 1007sub start_filter { 1008 my $flags = DMX_CHECK_CRC | DMX_IMMEDIATE_START; 1009 my ($sel, $filter_num) = @_; 1010 1011 warn "VERBOSE: DVB: creating filter $filters{$filter_num}->{pid_mask}->[0], $filters{$filter_num}->{pid_mask}->[1]\n" if ($opt_verbose > 1); 1012 $filters{$filter_num}->{demux} = new Linux::DVB::Demux "/dev/dvb/adapter$opt_adapter/demux0"; 1013 die("Error creating demux filter!\n") if (not defined $filters{$filter_num}->{demux}); 1014 die("Error setting demux buffer!\n") unless $filters{$filter_num}->{demux}->buffer($read_buf_size); 1015 die("Error setting filter\n") unless $filters{$filter_num}->{demux}->sct_filter ($filters{$filter_num}->{pid_mask}->[0], $filters{$filter_num}->{pid_mask}->[1], $filters{$filter_num}->{pid_mask}->[2], $TIMEOUT_FILTER, $flags); 1016 $filters{$filter_num}->{demux}->start || die ("Error starting filter\n"); 1017 $sel->add($filters{$filter_num}->{demux}->fh) || die ("Error selecting demux filehandle\n");; 1018 1019 $filters{$filter_num}->{active}=1; 1020 1021 warn "VERBOSE: DVB: filter created ok\n" if ($opt_verbose > 1); 1022 1023 return 1; 1024} 1025 1026########################################################### 1027# dvb stream parsing subs 1028# most of this is a port of lukkinosat's loadepg 1029 1030sub parsebuf { 1031 warn "Starting parsing buffer\n" if ($opt_verbose > 2); 1032 my ($filter, $buf) = @_; 1033 1034 my $type = substr($buf, 0, 1); 1035 1036 if (length $buf < 3) { 1037 return; 1038 } 1039 1040 if ($type eq "\x4a" or $type eq "\x46" or $type eq "\x42"){# (/\x4a|\x46|\x42/){ 1041 warn "Parsing data for channels skybox\n" if ($opt_verbose > 2); 1042 return parsechannels($filter, $buf); 1043 } 1044 elsif ($type eq "\xa0" or $type eq "\xa1" or $type eq "\xa2" or $type eq "\xa3"){#(/\xa0|\xa1|\xa2|\xa3/) { 1045 warn "Parsing data for titles skybox\n" if ($opt_verbose > 2); 1046 return parsetitles($filter, $buf); 1047 } 1048 elsif ($type eq "\xa8" or $type eq "\xa9" or $type eq "\xaa" or $type eq "\xab"){#/\xa8|\xa9|\xaa|\xab/) { 1049 warn "Parsing data for summaries skybox\n" if ($opt_verbose > 2); 1050 return parsesummaries($filter, $buf); 1051 } 1052 elsif ($type eq "\x4e"){#/\x4e/) { #now /next 1053 #my $si_decoded_hashref = Linux::DVB::Decode::si $buf; 1054 #print Data::Dump::dump $si_decoded_hashref; 1055 #return; 1056 } 1057 elsif ($type eq "\xa5" or $type eq "\xa6" or $type eq "\xa7") { 1058 #TODO what are this packets?? 1059 return; 1060 1061 } 1062 else { 1063 warn "Unexpected data type ".ord($type)."\n" if ($opt_verbose > 1); 1064 return; 1065 } 1066 1067 #print $buf; 1068 1069 return; 1070} 1071 1072sub parsechannels { 1073 my ($filterid, $data) = @_; 1074 1075 my %types = ("\x01" => 'video channel', 1076 "\x02" => 'audio channel', 1077 "\x05" => 'other', 1078 "\x19" => 'skyHD'); 1079 1080 my @bytes = split //, $data; 1081 1082 my $section_number = ord($bytes[6]); 1083 my $last_section_number = ord($bytes[7]); 1084 1085 # SDT 1086 if ($data=~/^\x42/ or $data=~/^\x46/) { 1087 1088 return unless ($endBAT > $maxBAT); 1089 warn ("VERBOSE: DVB: Parsing SDT\n") if ($opt_verbose > 2); 1090 $endSDT = 1 if (checkchannels()); 1091 1092 if( $endSDT ) { 1093 $filters{$filterid}->{finished}=1; 1094 warn (" ******************* END SDT table\n") if ($opt_verbose > 3); 1095 return 1; 1096 } 1097 1098 my $tid = ( ord($bytes[3]) << 8 ) | ord($bytes[4]); 1099 my $nid = ( ord($bytes[8]) << 8 ) | ord($bytes[9]); 1100 my $p = 11; 1101 my ($descriptor_tag, $descriptor_length, $service_name_length, $service_provider_name_length); 1102 1103 warn ("tid $tid, nid $nid\n") if ($opt_verbose > 4); 1104 1105 while ($p < (length ($data)-4)) { 1106 my $descriptors_loop_length = ( ( ord($bytes[$p+3]) & 0x0f ) << 8 ) | ord($bytes[$p+4]); 1107 my $sid = ( ord($bytes[$p]) << 8 ) | ord($bytes[$p+1]); 1108 die if (not defined $sid); 1109 1110 warn ("descriptors_loop_length $descriptors_loop_length, sid $sid\n") if ($opt_verbose > 4); 1111 1112 my $i = $p + 5; 1113 my $loop = 0; 1114 1115 while($loop < $descriptors_loop_length ) { 1116 if ($i+$descriptors_loop_length > (length ($data)+12)) { 1117 warn "Loop length is greater than data length? (".($i+$descriptors_loop_length).")\n" if ($opt_verbose > 3); 1118 return; 1119 } 1120 1121 my @bytes2 = split //, substr ($data, $i, $descriptors_loop_length); 1122 $descriptor_length = ord($bytes2[1]); 1123 #descriptor_tag 1124 if ($bytes2[0] eq "\x48") { 1125 $service_provider_name_length = ord($bytes2[3]); 1126 $service_name_length = ord($bytes2[4+$service_provider_name_length]) - 1; 1127 #warn ("service_provider_name_length $service_provider_name_length, service_name_length $service_name_length, descriptor length $descriptor_length\n") if ($opt_verbose > 3); 1128 my $name = substr ($data, $i+6+$service_provider_name_length, $service_name_length ); 1129 my $provider = substr ($data, $i+5, $service_provider_name_length -1); 1130 1131 1132 my $channel_id = find_channel_id($sid, $tid); 1133 warn ("provider |$provider| nome |$name|\n") if ($opt_verbose > 3); 1134 $channels_info{$channel_id}{name}=$name; 1135 $channels_info{$channel_id}{tid}=$tid; 1136 $channels_info{$channel_id}{nid}=$nid; 1137 $channels_info{$channel_id}{sid}=$sid; 1138 $channels_info{$channel_id}{provider}=$provider; 1139 } 1140 elsif ($bytes2[0] eq "\xc0" ) { 1141 #this channels have no epg available 1142 $service_name_length = $descriptor_length - 1; 1143 my $name = substr ($data, $i+3, $service_name_length ); 1144 my $channel_id = find_channel_id($sid, $tid); 1145 warn ("nome |$name|\n") if ($opt_verbose > 3); 1146 $channels_info{$channel_id}{name}=$name; 1147 $channels_info{$channel_id}{tid}=$tid; 1148 $channels_info{$channel_id}{nid}=$nid; 1149 $channels_info{$channel_id}{sid}=$sid; 1150 } 1151 1152 1153 1154 1155 $i += ( $descriptor_length + 2 ); 1156 $loop += ( $descriptor_length + 2 ); 1157 } 1158 $p += ( $descriptors_loop_length + 5 ); 1159 } 1160 } 1161 elsif ($data=~/^\x4a/) { 1162 #bat table 1163 if( $endBAT > $maxBAT ) { 1164 #$filters{$filterid}->{finished}=1; 1165 warn "------------------------- END BAT -------------------\n" if ($opt_verbose > 3);; 1166 return; 1167 } 1168 1169 warn ("Parsing BAT TABLE\n") if ($opt_verbose > 3); 1170 warn ("BAT section number $section_number / $last_section_number\n") if ($opt_verbose > 3); 1171 1172 my $bouquet_id = ( ord($bytes[3]) << 8 ) | ord($bytes[4]); 1173 my $bouquet_descriptors_length = ( ( ord($bytes[8]) & 0x0f ) << 8 ) | ord($bytes[9]); 1174 my $transport_stream_loop_length = ( ( ord($bytes[$bouquet_descriptors_length+10]) & 0x0f ) << 8 ) | ord($bytes[$bouquet_descriptors_length+11]); 1175 my $p1 = ( $bouquet_descriptors_length + 12 ); 1176 1177 $bouquets{$bouquet_id}{last_section_number}= $last_section_number; 1178 $bouquets{$bouquet_id}{sections}{$section_number}++; 1179 1180 my $bouquet_descriptor = substr ($data, 12, $bouquet_descriptors_length); 1181 $bouquets{$bouquet_id}{descriptor}=$bouquet_descriptor; 1182 warn ("bouquet_id $bouquet_id, bouquet_descriptors_length $bouquet_descriptors_length, descriptor transport_stream_loop_length $transport_stream_loop_length\n") if ($opt_verbose > 3); 1183 1184 while( $transport_stream_loop_length > 0 ) { 1185 my $tid = ( ord($bytes[$p1]) << 8 ) | ord($bytes[$p1+1]); 1186 my $nid = ( ord($bytes[$p1+2]) << 8 ) | ord($bytes[$p1+3]); 1187 1188 my $transport_descriptors_length = ( ( ord($bytes[$p1+4]) & 0x0f ) << 8 ) | ord($bytes[$p1+5]); 1189 my $p2 = ( $p1 + 6 ); 1190 $p1 += ( $transport_descriptors_length + 6 ); 1191 $transport_stream_loop_length -= ( $transport_descriptors_length + 6 ); 1192 1193 warn("tid $tid, nid $nid, transport_descriptors_length $transport_descriptors_length, transport_stream_loop_length $transport_stream_loop_length\n") if ($opt_verbose > 3); 1194 1195 while( $transport_descriptors_length > 0 ) { 1196 my $descriptor_tag = $bytes[$p2]; 1197 my $descriptor_length = ord($bytes[$p2+1]); 1198 my $p3 = ( $p2 + 2 ); 1199 $p2 += ( $descriptor_length + 2 ); 1200 $transport_descriptors_length -= ( $descriptor_length + 2 ); 1201 1202 ################################################### 1203 if ($descriptor_tag eq "\xb1" ) { 1204 $p3+=2; 1205 $descriptor_length-=2; 1206 1207 while( $descriptor_length > 0 ) { 1208 if( $bytes[$p3+2] eq "\x01" or $bytes[$p3+2] eq "\x02" or $bytes[$p3+2] eq "\x05" or $bytes[$p3+2] eq "\x10") { 1209 my $sid = ( ord($bytes[$p3]) << 8 ) | ord($bytes[$p3+1]); 1210 my $channel_id = ( ord($bytes[$p3+3]) << 8 ) | ord($bytes[$p3+4]); 1211 my $sky_number = ( ord($bytes[$p3+5]) << 8 ) | ord($bytes[$p3+6]); 1212 my $type = $bytes[$p3+2]; 1213 1214 1215 # if ($sky_number > 99 and $sky_number < 1000) { 1216 warn ("sid $sid, tid $tid, nid $nid, channel_id $channel_id, sky_number $sky_number type ".$types{$type}."\n") if ($opt_verbose > 3); 1217 $channels_info{$channel_id}{nid}=$nid; 1218 $channels_info{$channel_id}{tid}=$tid; 1219 $channels_info{$channel_id}{sid}=$sid; 1220 $channels_info{$channel_id}{sky_number}=$sky_number; 1221 $channels_info{$channel_id}{type}=$type; 1222 $channels_info{$channel_id}{type_txt}=$types{$type}; 1223 #} 1224 1225 } 1226 else { 1227 warn ("unknown type ".ord($bytes[$p3+2])."\n") if ($opt_verbose > 3); 1228 } 1229 $p3 += 9; 1230 $descriptor_length -= 9; 1231 1232 } 1233 } 1234 else { 1235 warn ("unknown descriptor tag ".ord($descriptor_tag)."?!?!?\n") if ($opt_verbose > 3); 1236 } 1237 } 1238 1239 1240 } 1241 #check that we received all of the bouquet sections 1242 my $ok = 1; 1243 foreach my $b (keys %bouquets) { 1244 next unless (exists $bouquets{$b}{last_section_number}); 1245 for my $s(0..$bouquets{$b}{last_section_number}){ 1246 $ok = 0 unless ($bouquets{$b}{sections}{$s}); 1247 } 1248 } 1249 my @tmp = keys %bouquets; 1250 $endBAT+=$ok if ($#tmp> 1); 1251 } 1252 1253 return; 1254} 1255 1256sub parsetitles { 1257 my ($filterid, $data) = @_; 1258 1259 if (length($data)<20) { 1260 warn "data < 20 \n" if ($opt_verbose > 3); 1261 return; 1262 } 1263 1264 #if we see this sequence a second time it means the filters has started repeating data and we can stop it 1265 my $testdata = $data; 1266 if (exists $filters{$filterid}->{startdata} and defined $filters{$filterid}->{startdata}) { 1267 if ($testdata eq $filters{$filterid}->{startdata} or $sigint_stop) { 1268 $filters{$filterid}->{finished}=1; 1269 return 1; 1270 } 1271 } 1272 else { 1273 $filters{$filterid}->{startdata}=$testdata; 1274 } 1275 1276 my @bytes = split //, $data; 1277 my $tid = ( ord($bytes[3]) << 8 ) | ord($bytes[4]); 1278 1279 my $channel_id = ( ord($bytes[3]) << 8 ) | ord($bytes[4]); 1280 my $mjd_time = ( ord($bytes[8]) << 8 ) | ord($bytes[9]); 1281 1282 my ($mday,$mon,$year) = Linux::DVB::Decode::date $mjd_time; 1283 $mon='0'.$mon if ($mon<10); 1284 $mday='0'.$mday if ($mday<10); 1285 warn "filter $filterid channel_id $channel_id mjd_time $mjd_time $mday,$mon,$year\n" if ($opt_verbose > 3); 1286 1287 #outside --days scope 1288#FIXME return unless ($to_get{"$channel_id;$year$mon$mday"}); 1289 1290 if ($mjd_time>0 and $channel_id>0) { 1291 my $p = 10; 1292 1293 while ($p < (length ($data)-4)) { 1294 my $event_id = ( ord($bytes[$p]) << 8 ) | ord($bytes[$p+1]); 1295 my $len1 = ( (ord($bytes[$p+2]) & 0x0f) << 8 ) | ord($bytes[$p+3]); 1296 1297 if (($p+4)> $#bytes) { 1298 return; 1299 } 1300 if ( ord($bytes[$p+4]) != 0xb5 ) { 1301 warn ("errore gettitles, data error signature\n") if ($opt_verbose > 3); 1302 return 1; 1303 } 1304 if ($len1 > length($data)) { 1305 warn ("errore gettitles, data length\n") if ($opt_verbose > 3); 1306 return 1; 1307 } 1308 1309 $p += 4; 1310 my $len2 = ord($bytes[$p+1]) -7; 1311 my $start_time = ( ( $mjd_time - 40587 ) * 86400 ) + ( ( ord($bytes[$p+2]) << 9 ) | ( ord($bytes[$p+3]) << 1 ) ); 1312 my $duration = ( ( ord($bytes[$p+4]) << 9 ) | ( ord($bytes[$p+5]) << 1 ) ); 1313 my $genre_ID = ord($bytes[$p+6]); 1314 my $len_data = $len2; 1315 1316 my $title = substr ($data, $p+9, ($len2)); 1317 warn "chanid $channel_id event_id $event_id start ".xmltv_date($start_time)." duration ".printduration($duration)." title \"".dehuff($title, $code)."\" genre_ID $genre_ID(". 1318 $themes->{$genre_ID}.")\n" if ($opt_verbose > 3); 1319 1320 $titles{$channel_id}{$event_id}->{start}=xmltv_date($start_time); 1321 $titles{$channel_id}{$event_id}->{stop}=xmltv_date($start_time+$duration); 1322 $titles{$channel_id}{$event_id}->{title}=[[tidy(dehuff($title, $code)), $LANG] ]; 1323 #$titles{$channel_id}{$event_id}->{desc}=[["chanid $channel_id evid $event_id title ".dehuff($title, $code), $LANG] ]; 1324 $titles{$channel_id}{$event_id}->{category}=[[tidy($themes->{$genre_ID}), $LANG ]] if ($themes->{$genre_ID}); 1325 1326 $p += $len1; 1327 } 1328 } 1329 return; 1330} 1331 1332sub parsesummaries { 1333 my ($filterid, $data) = @_; 1334 1335 if (length($data)<20) { 1336 return; 1337 } 1338 1339 #we stop the filter if we've already seen this packet 1340 my $testdata = $data; 1341 if (exists $filters{$filterid}->{startdata} and defined $filters{$filterid}->{startdata}) { 1342 if ($testdata eq $filters{$filterid}->{startdata} or $sigint_stop) { 1343 $filters{$filterid}->{finished}=1; 1344 warn "filter $filterid da stoppare \n" if ($opt_verbose > 2); 1345 1346 return 1; 1347 } 1348 } 1349 else { 1350 $filters{$filterid}->{startdata}=$testdata; 1351 } 1352 1353 my @bytes = split //, $data; 1354 1355 my $channel_id = ( ord($bytes[3]) << 8 ) | ord($bytes[4]); 1356 my $mjd_time = ( ord($bytes[8]) << 8 ) | ord($bytes[9]); 1357 1358 my ($mday,$mon,$year) = Linux::DVB::Decode::date $mjd_time; 1359 $mon='0'.$mon if ($mon<10); 1360 $mday='0'.$mday if ($mday<10); 1361 warn "filter $filterid channel_id $channel_id mjd_time $mjd_time $mday,$mon,$year\n" if ($opt_verbose > 3); 1362 1363 #outside --days scope 1364 #FIXME return unless ($to_get{"$channel_id;$year$mon$mday"}); 1365 1366 if ($mjd_time>0 and $channel_id>0) { 1367 my $p = 10; 1368 1369 while ($p < (length ($data)-4)) { 1370 my $event_id = ( ord($bytes[$p]) << 8 ) | ord($bytes[$p+1]); 1371 my $len1 = ( (ord($bytes[$p+2]) & 0x0f) << 8 ) | ord($bytes[$p+3]); 1372 if (($p+4)> $#bytes) { 1373 return; 1374 } 1375 if ( ord($bytes[$p+4]) != 0xb9 ) { 1376 warn ("errore gettitles, data error signature\n") if ($opt_verbose > 3); 1377 return 1; 1378 } 1379 if ($len1 > length($data)) { 1380 warn ("errore gettitles, data length\n") if ($opt_verbose > 3); 1381 return 1; 1382 } 1383 1384 $p += 4; 1385 my $len2 = ord($bytes[$p+1]); 1386 my $len_data = $len2; 1387 my $title = substr ($data, $p+2, ($len2)); 1388 my $desc = tidy(dehuff($title, $code)); 1389 warn "chanid $channel_id event_id $event_id summ $desc \n" if ($opt_verbose > 3); 1390 unless ($opt_no_cache_summaries){ 1391 print CACHE "$year$mon$mday|$channel_id|$event_id|$desc|\n" unless($seen_descs{"$year$mon$mday|$channel_id|$event_id"}); 1392 $seen_descs{"$year$mon$mday|$channel_id|$event_id"}++; 1393 } 1394 1395 $titles{$channel_id}{$event_id}->{desc}=[[$desc, $LANG] ] if ($desc ne ''); 1396 my %data; 1397 skylife_parse_data_slow($desc, \%data); 1398 foreach (keys %data) { 1399 $titles{$channel_id}{$event_id}{$_}=$data{$_} if (not defined $titles{$channel_id}{$event_id}{$_}); #we might have duplicates 1400 } 1401 $p += $len1; 1402 } 1403 } 1404 return; 1405} 1406 1407########################################################################################## 1408sub print_frontend_status { 1409 my $status = shift; 1410 1411 my $str; 1412 $str.= "FE_HAS_SIGNAL " if ($status & FE_HAS_SIGNAL); 1413 $str.= "FE_HAS_CARRIER " if ($status & FE_HAS_CARRIER); 1414 $str.= "FE_HAS_VITERBI " if ($status & FE_HAS_VITERBI); 1415 $str.= "FE_HAS_SYNC " if ($status & FE_HAS_SYNC); 1416 $str.= "FE_HAS_LOCK " if ($status & FE_HAS_LOCK); 1417 $str.= "FE_TIMEDOUT " if ($status & FE_TIMEDOUT); 1418 $str.= "FE_REINIT " if ($status & FE_REINIT); 1419 return $str; 1420} 1421 1422sub print_filters_status { 1423 my $str; 1424 1425 foreach (0..((scalar keys %filters)-1)) { 1426 $str.=$_; 1427 $str.= ($filters{$_}->{active} ? 'A' : 'X'); 1428 $str.= (exists $filters{$_}->{startdata} ? 'D' : ' '); 1429 $str.= (exists $filters{$_}->{finished} ? 'F' : ' '); 1430 $str.= ' |'; 1431 } 1432 1433 return $str."\n"; 1434} 1435 1436sub get_filter_no { 1437 my $f = shift; 1438 1439 warn "VERBOSE: DEMUX fh: looking for filter $f\n" if ($opt_verbose > 4); 1440 1441 foreach (keys %filters) { 1442 if (defined $filters{$_}->{demux}) { 1443 if ($f eq $filters{$_}->{demux}->fh) { 1444 return $_; 1445 } 1446 } 1447 } 1448 1449 warn "VERBOSE: DEMUX fh: ...not found!\n" if ($opt_verbose > 3); 1450 return undef; 1451} 1452 1453sub xmltv_date { 1454 my $epoch = shift; 1455 1456 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($epoch); 1457 my $month = $mon + 1; 1458 $month='0'.$month if ($month<10); 1459 $mday='0'.$mday if ($mday<10); 1460 $hour='0'.$hour if ($hour<10); 1461 $min='0'.$min if ($min<10); 1462 my $YYYY = $year + 1900; 1463 1464 return utc_offset($YYYY.$month.$mday.$hour.$min."00", '+0100'); 1465 1466} 1467 1468sub printduration { 1469 my $seconds = shift; 1470 my @parts = gmtime($seconds); 1471 my $str = sprintf("%2dh%2dm",@parts[2,1,0]); 1472 1473 return $str; 1474} 1475 1476sub checktime { 1477 my $nowtime = time; 1478 1479 if (($nowtime - $starttime) > $maxtime) { 1480 warn "timeout, closing up\n" unless ($opt_quiet); 1481 $DEBUG = 0; 1482 closeup(); 1483 } 1484 else { 1485 return 1; 1486 } 1487} 1488 1489sub closeup { 1490 $SIG{INT} = \&closeup; # See ``Writing A Signal Handler'' 1491 1492 if (not $DEBUG) { 1493 warn "caught sigint, finishing xml\n" unless ($opt_quiet); 1494 $sigint_stop = 1; 1495 return; 1496 } 1497 1498 use Data::Dump; 1499 print "fe ############################################\n"; 1500 print Data::Dump::dump $fe->get; 1501 print "############################################\n"; 1502 1503 print "bouquets ############################################\n"; 1504 print Data::Dump::dump %bouquets; 1505 print "############################################\n"; 1506 1507 print "channels ############################################\n"; 1508 print Data::Dump::dump %channels; 1509 print "############################################\n"; 1510 1511 print "channels_info ############################################\n"; 1512 print Data::Dump::dump %channels_info; 1513 print "############################################\n"; 1514 1515 print "display_names ############################################\n"; 1516 print Data::Dump::dump %display_names; 1517 print "############################################\n"; 1518 1519 print "site_ids ############################################\n"; 1520 print Data::Dump::dump %site_ids; 1521 print "############################################\n"; 1522 1523 print "titles ############################################\n"; 1524 print Data::Dump::dump %titles; 1525 print "############################################\n"; 1526 1527 1528 exit; 1529} 1530 1531sub checkchannels2 { 1532 foreach (keys %channels_info) { 1533 return 0 if (not defined $channels_info{$_}{name}); 1534 } 1535 return 1; 1536} 1537 1538sub checkchannels { 1539 my @k = keys %channels_info; 1540 my $count = $#k; 1541 my $count_noname = 0; 1542 my @nonames; 1543 foreach (keys %channels_info) { 1544 $count_noname++ if (not defined $channels_info{$_}{name}); 1545 push @nonames, $_ if (not defined $channels_info{$_}{name}); 1546 } 1547 warn "checkchannels, $count_noname/$count without name\n" if ($opt_verbose>2); 1548 warn "noname: @nonames\n" if ($count_noname < 10 and $opt_verbose>2); 1549 return 1 if ($count_noname < $opt_min_noname); 1550 return 0 if ($count_noname > 0); 1551 1552 1553 return 1; 1554} 1555 1556sub find_channel_id { 1557 my ($sid, $tid) = @_; 1558 1559 foreach (keys %channels_info) { 1560 return $_ if ($channels_info{$_}{sid}==$sid and $channels_info{$_}{tid}==$tid); 1561 } 1562 1563 return "$tid$sid"; 1564} 1565