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