1#!/usr/local/bin/perl -w 2 3=pod 4 5=head1 NAME 6 7tv_grab_ee - Grab TV listings for Estonia. 8 9=head1 SYNOPSIS 10 11tv_grab_ee --help 12 13tv_grab_ee --configure [--config-file FILE] [--gui OPTION] 14 15tv_grab_ee [--config-file FILE] 16 [--days N] [--offset N] 17 [--output FILE] [--quiet] [--debug] 18 19tv_grab_ee --list-channels [--config-file FILE] 20 [--output FILE] [--quiet] [--debug] 21 22tv_grab_ee --capabilities 23 24tv_grab_ee --version 25 26=head1 DESCRIPTION 27 28Output TV listings in XMLTV format for many stations available in Estonia. 29The data comes from www.kava.ee. 30 31First you must run B<tv_grab_ee --configure> to choose which stations 32you want to receive. 33 34Then running B<tv_grab_ee> with no arguments will get a listings in XML 35format for the stations you chose for available days including today. 36 37=head1 OPTIONS 38 39B<--configure> Prompt for which stations to download and write the 40configuration file. 41 42B<--config-file FILE> Set the name of the configuration file, the 43default is B<~/.xmltv/tv_grab_ee.conf>. This is the file written by 44B<--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> When grabbing, write output to FILE rather than 52standard output. 53 54B<--days N> When grabbing, grab N days rather than all available days. 55 56B<--offset N> Start grabbing at today + N days. N may be negative. 57 58B<--quiet> Suppress the progress-bar normally shown on standard error. 59 60B<--debug> Provide more information on progress to stderr to help in 61debugging. 62 63B<--list-channels> Write output giving <channel> elements for every 64channel available (ignoring the config file), but no programmes. 65 66B<--capabilities> Show which capabilities the grabber supports. For more 67information, see L<http://wiki.xmltv.org/index.php/XmltvCapabilities> 68 69B<--version> Show the version of the grabber. 70 71B<--help> Print a help message and exit. 72 73=head1 ERROR HANDLING 74 75If the grabber fails to download data for some channel on a specific day, 76it will print an errormessage to STDERR and then continue with the other 77channels and days. The grabber will exit with a status code of 1 to indicate 78that the data is incomplete. 79 80=head1 ENVIRONMENT VARIABLES 81 82The environment variable HOME can be set to change where configuration 83files are stored. All configuration is stored in $HOME/.xmltv/. On Windows, 84it might be necessary to set HOME to a path without spaces in it. 85 86=head1 SUPPORTED CHANNELS 87 88For information on supported channels, see http://www.kava.ee/ 89 90=head1 AUTHOR 91 92Cougar < cougar at random.ee >. This documentation and parts of the code 93based on various other tv_grabbers from the XMLTV-project. 94 95=head1 SEE ALSO 96 97L<xmltv(5)>. 98 99=cut 100 101my $default_root_url = 'http://xmltv.kava.ee/files'; 102my $default_cachedir = get_default_cachedir(); 103my $default_reformatxmltv = 'yes'; 104 105use strict; 106 107use XMLTV; 108use XMLTV::ProgressBar; 109use XMLTV::Options qw/ParseOptions/; 110use XMLTV::Configure::Writer; 111use XMLTV::Memoize; XMLTV::Memoize::check_argv 'get_nice'; 112 113use XML::LibXML; 114use Date::Manip; 115use Compress::Zlib; 116use File::Path; 117use File::Basename; 118use XMLTV::Get_nice qw(get_nice); 119 120my $usecache; 121 122BEGIN { 123 eval { require HTTP::Cache::Transparent }; 124 if ($@) { 125 $usecache = 0; 126 } else { 127 $usecache = 1; 128 } 129} 130 131sub t; 132sub reformat_programmes (@); 133 134my $warnings = 0; 135my $bar = undef; 136 137my ($opt, $conf) = ParseOptions({ 138 grabber_name => "tv_grab_ee", 139 capabilities => [qw/baseline manualconfig tkconfig apiconfig cache preferredmethod/], 140 stage_sub => \&config_stage, 141 listchannels_sub => \&list_channels, 142 load_old_config_sub => \&load_old_config, 143 version => '$Id: tv_grab_ee,v 1.19 2010/10/01 17:15:21 dekarl Exp $', 144 description => "Estonia (www.kava.ee)", 145 defaults => { days => -999 }, # all days 146 preferredmethod => 'allatonce', 147}); 148 149if (not defined ($conf->{'root-url'})) { 150 print STDERR "No root-url defined.\n" . 151 "Please run the grabber with --configure.\n"; 152 exit(1); 153} 154 155my $reformatxmltv; 156 157if (!defined ($conf->{'reformat-xmltv'})) { 158 $reformatxmltv = $default_reformatxmltv; 159} else { 160 if ($conf->{'reformat-xmltv'} =~ /(y|yes|j|jah|1|on)/i) { 161 $reformatxmltv = 1; 162 } elsif ($conf->{'reformat-xmltv'} =~ /(n|no|e|ei|0|off)/i) { 163 $reformatxmltv = 0; 164 } else { 165 print STDERR "Illegal reformat-xmltv value\n" . 166 "Please run the grabber with --configure.\n"; 167 exit(1); 168 } 169} 170 171if ($usecache && not defined ($conf->{'cachedir'})) { 172 print STDERR "No cachedir defined.\n" . 173 "Please run the grabber with --configure.\n"; 174 exit(1); 175} 176 177init_cachedir($conf->{cachedir}->[0]) if ($usecache); 178 179if ($usecache) { 180 HTTP::Cache::Transparent::init({ 181 BasePath => $conf->{cachedir}->[0], 182 NoUpdate => 15 * 60, 183 Verbose => $opt->{debug}, 184 }); 185} 186 187my ($encoding, $credits, $ch, $progs) = fetch_channels($conf); 188 189$bar = new XMLTV::ProgressBar({ 190 name => 'downloading listings', 191 count => scalar(@{$conf->{channel}}), 192}) if (not $opt->{quiet}) && (not $opt->{debug}); 193 194my @alldata; 195 196foreach my $channel_id (@{$conf->{channel}}) { 197 if (exists $ch->{$channel_id}) { 198 (my $id = $channel_id) =~ s/^(\d\d).*/$1/; 199 t "$channel_id -> $id"; 200 my $dataurl = $conf->{'root-url'}->[0] . '/' . $id . '_channeldata.xml'; 201 my $xmlstr = get_nice($dataurl) or warning('Failed to fetch ' . $dataurl); 202 if (defined $xmlstr) { 203 # remove illegal '<desc lang="et"> </desc>' 204 $xmlstr =~ s/<desc lang=[^>]+>\s+<\/desc>//g; 205 # correct invalid channel ID 206 $xmlstr =~ s/channel=\"\d+\.xmltv\.kava\.ee\"/channel="$channel_id"/g; 207 my $data = XMLTV::parse($xmlstr); 208 $data->[1]{'generator-info-name'} = '$Id: tv_grab_ee,v 1.19 2010/10/01 17:15:21 dekarl Exp $'; 209 $data->[1]{'generator-info-url'} = 'mailto:cougar@random.ee'; 210 push @alldata, $data; 211 } 212 } else { 213 warning('Missing channel: ' . $channel_id); 214 } 215 $bar->update() if defined $bar; 216} 217$bar->finish() if defined $bar; 218 219my %w_args; 220 221if (($opt->{offset} != 0) || ($opt->{days} != -999)) { 222 $w_args{offset} = $opt->{offset}; 223 $w_args{days} = ($opt->{days} == -999) ? 100 : $opt->{days}; 224 $w_args{cutoff} = '000000'; 225} 226 227my $data; 228 229if ($reformatxmltv) { 230 my $olddata = XMLTV::cat(@alldata); 231 $data = reformat_programmes(@$olddata); 232} else { 233 $data = XMLTV::cat(@alldata); 234} 235 236$bar = new XMLTV::ProgressBar({ 237 name => 'writing XMLTV', 238 count => 1, 239 }) if (not $opt->{quiet}) && (not $opt->{debug}); 240 241XMLTV::write_data($data, %w_args); 242 243$bar->update() if defined $bar; 244$bar->finish() if defined $bar; 245 246# Signal that something went wrong if there were warnings. 247exit(1) if $warnings; 248 249# All data fetched ok. 250t 'Exiting without warnings.'; 251exit(0); 252 253############################################################################## 254 255sub t 256{ 257 my ($message) = @_; 258 print STDERR $message . "\n" if $opt->{debug}; 259} 260 261sub warning 262{ 263 my ($message) = @_; 264 print STDERR $message . "\n"; 265 $warnings++; 266} 267 268sub fetch_channels 269{ 270 my ($conf) = @_; 271 272 t 'Fetching channels'; 273 my $compressed = get_nice($conf->{'root-url'}->[0] . '/channels.xml.gz') 274 or die 'Failed to fetch ' . $conf->{'root-url'}->[0] . '/channels.xml.gz'; 275 my $xmlstr = Compress::Zlib::memGunzip(\$compressed); 276 my $data = XMLTV::parse($xmlstr); 277 $data->[1]{'generator-info-name'} = '$Id: tv_grab_ee,v 1.19 2010/10/01 17:15:21 dekarl Exp $'; 278 $data->[1]{'generator-info-url'} = 'mailto:cougar@random.ee'; 279 return @$data; 280} 281 282sub list_channels 283{ 284 my ($conf, $opt) = @_; 285 286 my ($encoding, $credits, $ch, $progs) = fetch_channels($conf); 287 288 my $result; 289 290 my %w_args; 291 $w_args{encoding} = $encoding; 292 $w_args{OUTPUT} = \$result; 293 294 my $writer = new XMLTV::Writer(%w_args); 295 $writer->start($credits); 296 foreach (sort keys %$ch) { 297 $writer->write_channel($ch->{$_}); 298 } 299 $writer->end(); 300 return $result; 301} 302 303sub config_stage 304{ 305 my ($stage, $conf) = @_; 306 307 if ($stage eq 'start') { 308 return config_stage_start($stage, $conf); 309 } else { 310 die "Unknown stage $stage"; 311 } 312} 313 314sub config_stage_start 315{ 316 my ($stage, $conf) = @_; 317 318 die "Unknown stage $stage" if $stage ne "start"; 319 320 my $result; 321 my $writer = new XMLTV::Configure::Writer(OUTPUT => \$result, 322 encoding => 'utf-8'); 323 $writer->start({grabber => 'tv_grab_ee'}); 324 $writer->write_string({ 325 id => 'root-url', 326 title => [ 327 [ 'Root URL for grabbing data', 'en' ], 328 [ 'Kavade kataloogi URL', 'et' ] 329 ], 330 description => [ 331 [ 'This URL describes root directory ' . 332 'where channels file and all ' . 333 'channel data can be found.', 'en' ], 334 [ 'Selles kataloogis peavad asuma ' . 335 'kanaleid kirjeldav fail ning ' . 336 'kõikide kanalite telekavad.', 'et' ] 337 ], 338 default => $default_root_url, 339 }); 340 $writer->write_string({ 341 id => 'cachedir', 342 title => [ 343 [ 'Directory to store the cache in', 'en' ], 344 [ 'Puhverdamise kataloog', 'et' ] 345 ], 346 description => [ 347 [ 'Please specify where to cache ' . 348 'already downloaded data ', 'en' ], 349 [ 'Sellesse kataloogi tehakse kohalik ' . 350 'puhver (cache) juba eelnevalt ' . 351 'tõmmatud failide hoidmiseks', 'et' ] 352 ], 353 default => $default_cachedir, 354 }) if ($usecache); 355 $writer->write_string({ 356 id => 'reformat-xmltv', 357 title => [ 358 [ 'Reformat original XMLTV', 'en' ], 359 [ 'Algse XMLTV muutmine', 'et' ] 360 ], 361 description => [ 362 [ 'Original XMLTV data is very general ' . 363 'and often inconsistent. This option ' . 364 'enables XMLTV postprocessing and ' . 365 'reformatting in grabber. Update grabber ' . 366 'more often when enabled.', 'en' ], 367 [ 'Algne XMLTV fail ei ole eriti detailne. ' . 368 'Tõmbaja võib seda ise edasi töödelda ' . 369 'ning formaadis olevaid pisivigu ' . 370 'parandada. Selle lubamisel tuleks tõmbajat ' . 371 'tihemini uuendada.', 'et' ] 372 ], 373 default => $default_reformatxmltv, 374 }); 375 376 $writer->end('select-channels'); 377 378 return $result; 379} 380 381sub load_old_config 382{ 383 my ($config_file) = @_; 384 385 my %chanmap = ( 386 '10' => '11', # ETV 387 '12' => '13', # TV 3 388 '13' => '12', # Kanal 2 389 '14' => '131', # STV 390 '15' => '15', # YLE 1 391 '16' => '16', # YLE 2 392 '17' => '17', # MTV 3 393 '20' => '18', # Nelonen 394 '22' => '54', # PRO 7 395 '23' => '105', # NTV+ Vene 396 '24' => '53', # RTL2 397 '25' => '50', # RTL 398 '27' => '28', # PBK 399 '29' => '14', # TV1000 Eesti 400 '32' => '46', # Viasat Explorer 401 '35' => '27', # TV3+ 402 '36' => '41', # Discovery Channel 403 '37' => '125', # NTV Discovery 404 '38' => '44', # Discovery Travel&Living 405 '39' => '42', # Discovery Civilisation 406 '40' => '43', # Discovery Science 407 '41' => '22', # National Geographic 408 '42' => '45', # Viasat History 409 '43' => '59', # Arte 410 '44' => '60', # Eurosport 411 '45' => '70', # MTV 412 '46' => '72', # VH1 413 '47' => '73', # Viva 414 '48' => '74', # Mezzo 415 '49' => '128', # NTV Sport 416 '50' => '123', # NTV Jalgpall 417 ); 418 419 t 'Loading old config format'; 420 my @lines = XMLTV::Config_file::read_lines($config_file); 421 422 my $conf = {}; 423 $conf->{'root-url'}->[0] = $default_root_url; 424 $conf->{'cachedir'}->[0] = $default_cachedir if ($usecache); 425 $conf->{'channel'} = []; 426 $conf->{'no_channel'} = []; 427 428 foreach my $line (@lines) { 429 next unless defined $line; 430 if ($line !~ /^(#?)channel (\d+)\.tv\.delfi\.ee /) { 431 t 'Illegal config line "' . $line . '"'; 432 next; 433 } 434 my $status = $1; 435 my $oldchan = $2; 436 if (! defined $chanmap{$oldchan}) { 437 t 'Unknown channel ' . $2 . ' from "' . $line . '"'; 438 next; 439 } 440 if ($status eq '') { 441 push @{$conf->{'channel'}}, "$oldchan.xmltv.kava.ee"; 442 t 'Converting ' . $line . ' -> ' . "channel=$oldchan.xmltv.kava.ee"; 443 } else { 444 push @{$conf->{'no_channel'}}, "$oldchan.xmltv.kava.ee"; 445 t 'Converting ' . $line . ' -> ' . "channel!$oldchan.xmltv.kava.ee"; 446 } 447 } 448 return $conf; 449} 450 451sub get_default_cachedir 452{ 453 my $winhome = $ENV{HOMEDRIVE} . $ENV{HOMEPATH} 454 if defined($ENV{HOMEDRIVE}) and defined($ENV{HOMEPATH}); 455 456 my $home = $ENV{HOME} || $winhome || "."; 457 458 return "$home/.xmltv/cache"; 459} 460 461sub init_cachedir 462{ 463 my ($path) = @_; 464 if (not -d $path) { 465 mkpath($path) or die "Failed to create cache-directory $path: $@"; 466 } 467} 468 469############################################################################## 470# Optional function to parse, reformat and extract useful information 471# from simple XMLTV data 472############################################################################## 473 474sub reformat_programmes (@) 475{ 476 my ($encoding, $credits, $channels, $programmes) = @_; 477 478 my $stripgenres = 'animasari|dokkaader|dokumentaalfilm|dokumentaalsari|draamafilm|draamasari|ffriigisari|komöödiasari|kriminaalsari|kriminull|mängufilm|multifilm|muusikadokumentaal|noortesaade|noortesari|õudusfilm|perefilm|põnevus|põnevusfilm|romantiline draama|romantiline komöödia|seiklus'; 479 480 my @newprogrammes; 481 482 $bar = new XMLTV::ProgressBar({ 483 name => 'reformatting XMLTV', 484 count => scalar(@{$programmes}), 485 }) if (not $opt->{quiet}) && (not $opt->{debug}); 486 487 foreach (@$programmes) { 488 my $genre = ""; 489 my @titles; 490 my @descs; 491 my @categories; 492 my @subtitles; 493 my @episodenum; 494 my $date; 495 my @country; 496 my @subtitlez; 497 my @languages; 498 my %video; 499 my %audio; 500 my $ismovie = 0; 501 my $isnew = 0; 502 my $repeat = 0; 503 504 # $_->{'title'} should always exist 505 foreach (@{$_->{'title'}}) { 506 my ($title, $lang) = @$_; 507 my $subtitle; 508 509 # FST: Vene keel turistidele 510 # TV2: Himpulat: Sinine 511 if ($title =~ /^(?:FST|TV2): (.*)$/) { 512 $title = $1; 513 } 514 515 if ($title =~ /^(.*)\s+($stripgenres)$/) { 516 $title = $1; 517 $genre = $2; 518 } 519 520 # Multifilm Simpsonid: Öised varastajad 521 # Mängufilm: Kadunud 60 sekundiga (Gone in 60 seconds ) 522 if ($title =~ /^($stripgenres):?\s+(.*)$/i) { 523 $genre = $1; 524 $title = $2; 525 } 526 527 if ($title =~ /^Mf:\s(.*)$/) { 528 $title = $1; 529 $ismovie = 1; 530 } 531 532 if ($title =~ /^(.*)\*$/) { 533 $title = $1; 534 $repeat = 1; 535 } 536 537 # Black Hawk Down ( Black Hawk Down, USA 2001 ) 538 if ($title =~ /\s+(\d{4}) ?\)\.?$/) { 539 $date = $1; 540 } 541 if ($title =~ /(?:, |\()((USA|\u\w[\u\w\l\w]+)(?:[\-\/]\u\w[\u\w\l\w]+)*) \d{4} ?\)\.?$/) { 542 foreach (split(/\//, $1)) { 543 push (@country, [ $_, $lang ]); 544 } 545 } 546 547 if ($title =~ /^((?:[^:\(]+)|(?:C.S.I.:[^:]+)): ([\p{IsUpper}][^:]*)$/) { 548 # C.S.I.: Kriminalistid: Sundlus 549 $title = $1; 550 $subtitle = $2; 551 } elsif ($title =~ /^(.*)(?:\*:)\s*(.*)$/) { 552 # Lastetaltsutaja*: McCafferty pere 553 $title = $1; 554 $subtitle = $2; 555 $repeat = 1; 556 } elsif ($title =~ /^([^:\(]+):\s+([^:]*)$/) { 557 # !!! Lend 285 kaaperdamine (Hijacked: Flight 285, USA 1996) 558 # RD: 101 inimkehast eemaldatud eset* 559 # Ffriigisari Star Trek: Uus põlvkond: Laps (Star Trek: The Next Generation, USA 1988) 560 # Noortesaade 15:15 561 $title = $1; 562 $subtitle = $2; 563 } 564 565 if ($title =~ /^(.*)\*$/) { 566 $title = $1; 567 $repeat = 1; 568 } 569 570 if ($title =~ /^(.*)(?:[,:] | ,)(\d+)([\/\-])(\d+)\.?$/) { 571 # 10 otsustavat aastat, 4/16 572 # Dokumentaalsari Elu kosmoses, 1-8 573 # Armastuse teed: 183/220 574 if (($3 ne "-") || (($2 + 1) < $4)) { 575 # mach if not multiple series 576 $title = $1; 577 @episodenum = [ sprintf(". %d/%d .", $2 - 1, $4), 'xmltv_ns']; 578 } 579 } elsif ($title =~ /^(.*)(?:, | ,)(\d+)([\/\-])(\d+)((\.?)|(\s*\(.*))$/) { 580 # Noortesari Punk`d, 5/8 (USA 2003) 581 # Noortesari Punk`d, 6-8 (USA 2003) 582 if (($3 ne "-") || (($2 + 1) < $4)) { 583 # skip: Õnne 13, 53-54 (ETV 1997) 584 $title = $1 . $5; 585 @episodenum = [ sprintf(". %d/%d .", $2 - 1, $4), 'xmltv_ns']; 586 } 587 } elsif ($title =~ /^(.*)(?:, | ,)(\d+)([\/\-])(\d+):\s(.*)$/) { 588 # Kriminaalsari Alice Nevers - naine kohtumõistjaks, 1-4: Kohtumõistjad ... 589 if (($3 ne "-") || (($2 + 1) < $4)) { 590 # mach if not multiple series 591 $title = $1; 592 if (defined $subtitle) { 593 $title .= $5; 594 } else { 595 $subtitle = $5; 596 } 597 @episodenum = [ sprintf(". %d/%d .", $2 - 1, $4), 'xmltv_ns']; 598 } 599 } elsif ($title =~ /^(.*), (\d+)\.?$/) { 600 $title = $1; 601 @episodenum = [ sprintf(". %d .", $2 - 1), 'xmltv_ns']; 602 } 603 if ($title =~ /^(.*)\. Sari\.$/) { 604 $title = $1; 605 @episodenum = [ '. . .', 'xmltv_ns']; 606 } 607 if (defined $subtitle) { 608 if ($subtitle =~ /^(.*)\s+(\d+)\/(\d+)\.?$/) { 609 # <sub-title>Tere tulemast koju, Rose 1/2</sub-title> 610 $subtitle = $1; 611 @episodenum = [ sprintf(". %d/%d .", $2 - 1, $3), 'xmltv_ns']; 612 } elsif ($subtitle =~ /^(.*)(?:, | ,)(\d+)\/(\d+)\.?$/) { 613 $subtitle = $1; 614 @episodenum = [ sprintf(". %d/%d .", $2 - 1, $3), 'xmltv_ns']; 615 } elsif ($subtitle =~ /^(.*)(?:, | ,)(\d+)\/(\d+)((\.?)|(\(.*))$/) { 616 @episodenum = [ sprintf(". %d/%d .", $2 - 1, $3), 'xmltv_ns']; 617 } elsif ($subtitle =~ /^(.*), (\d+)\.?$/) { 618 $subtitle = $1; 619 @episodenum = [ sprintf(". %d .", $2 - 1), 'xmltv_ns']; 620 } 621 if ($subtitle =~ /^(.*)\*$/) { 622 $subtitle = $1; 623 $repeat = 1; 624 } 625 push (@subtitles, [ $subtitle, $lang ]); 626 } 627 628 if ($title =~ /^(.*)\*$/) { 629 $title = $1; 630 $repeat = 1; 631 } 632 633 if ($title =~ /^(.*) \(([[:alpha:]]+) keeles\)\.?$/) { 634 push (@languages, $2 , 'et'); 635 } 636 637 push (@titles, [ $title, $lang ]); 638 } 639 640 # it is not needed to check $_->{'desc'} existence 641 foreach (@{$_->{'desc'}}) { 642 my ($desc, $lang) = @$_; 643 644 $desc =~ s/^ //g; 645 $desc =~ s/ $//g; 646 647 if ($desc =~ /^(.*)\s+Stereo\.?(.*)$/) { 648 $desc = $1 . $2; 649 $audio{'stereo'} = 'stereo'; 650 } elsif ($desc =~ /^(.*)\s+Stereo surround\.?(.*)$/) { 651 $desc = $1 . $2; 652 $audio{'stereo'} = 'surround'; 653 } elsif ($desc =~ /^Stereo\.?$/) { 654 $desc = ''; 655 $audio{'stereo'} = 'stereo'; 656 } 657 658 if ($desc =~ /^(.*)\s+Uusinta\.?(.*)$/) { 659 $desc = $1 . $2; 660 $isnew = 1; 661 } 662 663 if ($desc =~ /^(.*)\s16:9\.?(.*)$/) { 664 $desc = $1 . $2; 665 $video{'aspect'} = '16:9'; 666 } 667 668 if ($desc =~ /^(.*)\s+Kordus$/) { 669 $desc = $1; 670 $repeat = 1; 671 } elsif ($desc =~ /^(.*)\s+Kordus\.(.*)$/) { 672 $desc = $1 . $2; 673 $repeat = 1; 674 } 675 676 if ($desc =~ /^Osa (\d+)\/(\d+):\s+([[:^punct:]]+[[:punct:]])\s(.*)$/) { 677 # Osa 3/5: Marseille ja Provence. Dokumentaalsari Prantsusmaas... 678 # Osa 2/5: Lyon ja selle ümbrus. Dokumentaalsari ... 679 push (@subtitles, [ $3, $lang ]); 680 $desc = $4; 681 @episodenum = [ sprintf(". %d/%d .", $1 - 1, $2), 'xmltv_ns']; 682 } elsif ($desc =~ /^Osa (\d+):\s+([[:^punct:]]+[[:punct:]])\s(.*)$/) { 683 # Osa 1: Runolaulust kirikulauluni. Soome muusika ... 684 push (@subtitles, [ $2, $lang ]); 685 $desc = $3; 686 @episodenum = [ sprintf(". %d .", $1 - 1), 'xmltv_ns']; 687 } elsif ($desc =~ /^Osa (\d+)\/(\d+)\.\s+(.*)$/) { 688 # Osa 3/12. Pääosissa Mari Perankoski ... 689 $desc = $3; 690 @episodenum = [ sprintf(". %d/%d .", $1 - 1, $2), 'xmltv_ns']; 691 } elsif ($desc =~ /^Osa (\d+)\.\s+(.*)$/) { 692 # Osa 3. Novembris 2005 filmitud ... 693 $desc = $2; 694 @episodenum = [ sprintf(". %d .", $1 - 1), 'xmltv_ns']; 695 } elsif ($desc =~ /^(\d+)\/(\d+)[\s:\.\,]+(.*)/) { 696 # 1/4: Miks me valetame?... 697 $desc = $3; 698 @episodenum = [ sprintf(". %d/%d .", $1 - 1, $2), 'xmltv_ns']; 699 } elsif ($desc =~ /^(.*)\s+Osa (\d+)\/(\d+)\.?(.*)$/) { 700 # ... liikaa. Osa 5/6. Tuotanto ... 701 $desc = $1 . $4; 702 @episodenum = [ sprintf(". %d/%d .", $2 - 1, $3), 'xmltv_ns']; 703 } elsif ($desc =~ /^([[:^punct:]]+[[:punct:]])\s+Osa (\d+)\.\s*(.*)$/) { 704 # Õhk. Osa 2. Miks lennuk lendab 705 unless (@subtitles) { 706 my $subtitle = $1; 707 $desc = $3; 708 @episodenum = [ sprintf(". %d .", $2 - 1), 'xmltv_ns']; 709 $subtitle =~ s/\.$//; 710 push (@subtitles, [ $subtitle, $lang ]); 711 } 712 } 713 714 if ($desc =~ /Tekstitys Teksti-tv:n/) { 715 push (@subtitlez, { 'type' => 'teletext' }); 716 } 717 718 push (@descs, [ $desc, $lang ]) if ($desc ne ""); 719 } 720 721 foreach (@{$_->{'category'}}) { 722 my ($category, $lang) = @$_; 723 $category = uc(substr($category, 0, 1)) . lc(substr($category, 1)); 724 push (@categories, [ $category, $lang ]); 725 } 726 727 if ($ismovie && ! @categories) { 728 push (@categories, [ 'Movie', 'en' ]); 729 push (@categories, [ 'Filmid', 'et' ]); 730 } elsif (@episodenum && ! @categories) { 731 push (@categories, [ 'Serial', 'en' ]); 732 push (@categories, [ 'Telesarjad', 'et' ]); 733 } 734 735 $_->{'title'} = \@titles if @titles; 736 if (@descs) { 737 $_->{'desc'} = \@descs; 738 } else { 739 delete $_->{'desc'}; 740 } 741 $_->{'sub-title'} = \@subtitles if @subtitles; 742 $_->{'category'} = \@categories if @categories; 743 $_->{'episode-num'} = \@episodenum if @episodenum; 744 $_->{'date'} = $date if (defined $date); 745 $_->{'country'} = \@country if @country; 746 $_->{'language'} = \@languages if @languages; 747 $_->{'previously-shown'} = {'channel' => $_->{'channel'}} if ($repeat); 748 $_->{'audio'} = \%audio if %audio; 749 $_->{'video'} = \%video if %video; 750 $_->{'subtitles'} = \@subtitlez if @subtitlez; 751 $_->{'new'} = 'presence' if ($isnew); 752 push @newprogrammes, $_; 753 $bar->update() if defined $bar; 754 } 755 $bar->finish() if defined $bar; 756 757 return [$encoding, $credits, $channels, \@newprogrammes]; 758} 759 760__END__ 761 762TODO list: 763 - extract credits 764