Context Navigation

reconciler_mk2

Revision 1414, 80.7 kB (checked in by max, 5 days ago)
reconciler: Add exception for "Once Upon a Time"
Property svn:executable set to ``*

Line
1	#!/usr/bin/env perl
2	#
3	# "reconciler mk2": shepherd XMLTV data reconciler
4	# * to be used as a postprocessor for XMLTV data
5	# * takes the output from multiple XMLTV sources and combines them
6	# (hopefully taking the best data from each)
7	# * can be used in conjunction with 'shepherd' XMLTV reconciler or standalone (pipe-through)
8	# * can be used in conjunction with 'shepherd' channels.conf channels_file (but not necessary
9	# if input XMLTV grabbers populate <channel>..</channel> section properly
10	# * no configuration necessary
11	#
12	# changelog:
13	# 0.01 07oct06 initial version
14	# 0.02 11oct06 complete rewrite, new algorithms, seperate out from shepherd
15	# 0.03 15oct06 first committed
16	# 0.04 17oct06 bug fix: use our own parse_xmltv_date, Date::Manip seems broken
17	# bug fix: correctly parse some XMLTV rare fields
18	# 0.05 17oct06 enhancement: compress logfiles automatically since they are quite large
19	# 0.06 17oct06 enhancement: name mapping based on previously learnt names
20	# 0.07 19oct06 turn down debugging
21	# 0.08 20oct06 improved preference-title rewriter, more debugging to logfile
22	# 0.09 24oct06 --preftitle support
23	# 0.15 26nov06 reworked the title translations a bit
24	# - now only stores preferred titles when it has seen more than once
25	# - keeps last 30 days titles (indexed by time-of-day/day-of-week)
26	# as back history for alternate titles when switching grabbers
27
28	#
29	# reconciles programme listings using the following logic:
30	# sort programmes into per-channel and per-timeslot
31	# for each channel:
32	# 1. for programmes with a common start & stop time, evaluate them to see
33	# if they are the same programme using fuzzy title matching.
34	# use "majority voting" to decide which programme wins if titles differ.
35	# 2. for programmes that start within 10 minutes of each other, try to
36	# see if they are the same programme (fuzzy title matching), merging
37	# data between them
38	# 3. as a tie-breaker, prefer data based on order of grabber data we are
39	# fed. i.e. first data file takes preference over second data file, etc.
40	#
41	# other features:
42	# - will automatically split titles with "title: subtitle" into "title" and
43	# "subtitle" (controlled via $reclogic{max_length_for_colon_title_split} and
44	# $reclogic{min_title_for_colon_title_split})
45	# - will try to match "same titles" (including fuzzy title matching) for
46	# duplicate programmes within 10 minutes (or whatever
47	# $reclogic{fuzzy_match_title_time_window} is set to)
48	# - will automatically move start/stop times (up to a max of 5 minutes or whatever
49	# $reclogic{max_prog_length_for_rejig} is set to) whenever programming
50	# overlaps occur. logic for when-to-delete versus when-to-cutoff are
51	# controlled via $reclogic{min_prog_length_for_delete_cutoff} and
52	# $reclogic{delete_window_smaller_than_prog_window_threshold}
53	# - will remove all timezones from data (can be disabled by removing setting
54	# $reclogic{always_rewrite_start_stop_without_timezone}
55
56
57	# processing uses the following tables:
58	#
59	# order in which we read datafiles:
60	# number of datafiles: $in->{num_datafiles);
61	# order of datafiles: $in->{datafile_order}->[n] = $proggy;
62	# map datafile-to-grabber: $in->{datafile}->{$datafile} = $proggy;
63	# map grabber-to-datafile: $in->{data}->{$proggy}->{file} = $datafile;
64	# grabber version: $in->{data}->{$proggy}->{version} = $version;
65	#
66	# channels list:
67	# channel list: $in->{channels}->{$chan}->{lang}->{$lang} = $desc
68	#
69	# programme tables:
70	# $in->{tree}->{$chan}->{"start:stop"}->{progs}->[n]
71	# $in->{tree}->{$chan}->{"start:stop"}->{numprogs}
72	# $in->{total_progs}->{$chan}
73	# $in->{total_progs_in}->{$chan}, $in->{total_progs_out}->{$chan}
74	#
75	# misc tables:
76	# encoding we are using: $in->{encoding}
77	# where we sourced data from: $in->{sources}
78	# duplicate checking: $in->{dupcheck}->{$source}->{$prog_chan}->{$prog_key}
79	# channel list: $in->{channels}->{$chan}->{$lang} = $desc
80	#
81	# used translations $in->{used_translations}->{$xlate_to}->{num}=count
82	# $in->{used_translations}->{$xlate_to}->{from}->{$xlate_from}=count
83
84	# history of title preferences uses the following (cache-based) data:
85	# $title_xlate_table->{"$primary_title"}->{seen_in_primary} = count
86	# $title_xlate_table->{"$primary_title"}->{last_seen_in_primary} = time
87	# $title_xlate_table->{"$primary_title"}->{translated} = count
88	# $title_xlate_table->{"$primary_title"}->{translation} = title
89	# $title_xlate_table->{"$primary_title"}->{alternate}->{"$alt_title"}->{secondary}->{"$source"} = count
90	# $title_xlate_table->{"$primary_title"}->{alternate}->{"$alt_title"}->{last_seen_in_secondary} = time
91	# $title_xlate_table->{"$primary_title"}->{same}->{"$source"} = count
92
93	use strict;
94	use warnings;
95	$\| = 1;
96	BEGIN { *CORE::GLOBAL::die = \&my_die; }
97
98	my $progname = "reconciler_mk2";
99	my $version = "0.48";
100
101	use LWP::UserAgent;
102	use XMLTV;
103	use POSIX qw(strftime mktime);
104	use Getopt::Long;
105	use Data::Dumper;
106	use Compress::Zlib;
107	use Storable;
108
109	#### reconciler settings ####
110	my %reclogic;
111
112	### *******************************************************************************
113	### * NOTE: all of these can be overridden through a (site local) config file *
114	### *******************************************************************************
115	### Doing that is HIGHLY PREFERABLE to CHANGING THIS FILE!
116	### remember that Shepherd may upgrade this automatically from time-to-time,
117	### causing any changes here to be LOST!
118
119	#
120	# reconciler logic settings
121	#
122
123	# delete_window_smaller_than_prog_window_threshold:
124	$reclogic{delete_window_smaller_than_prog_window_threshold} = (5*60); # 5 mins each side
125
126	# min_prog_length_for_delete_cutoff:
127	$reclogic{min_prog_length_for_delete_cutoff} = (10*60); # prog needs to be at least 10 mins if we're cutting back
128
129	# max_prog_length_for_rejig:
130	$reclogic{max_prog_length_for_rejig} = (10*60); # allow programme times to be changed by at-most 10 mins
131
132	$reclogic{fuzzy_match_title_time_window} = (20*60); # attempt title matches within +/- 20 min window
133
134	# always rewrite XMLTV 'start' & 'stop', removing timezone
135	$reclogic{always_rewrite_start_stop_without_timezone} = 1;
136
137	# add channels from data sources that we don't have in our channels.conf
138	$reclogic{always_add_new_channels} = 0; # don't
139
140	# if its on a freetv channel without a subtitle and a possible series
141	# (not a movie (less then or equal to $reclogic{max_length_for_colon_title_split} minutes)) and
142	# there is a ": " in title, split title into "title: subtitle"
143	# if each of title/subtitle will be at least $reclogic{min_title_for_colon_title_split} characters
144	$reclogic{max_length_for_colon_title_split} = (70*60);
145	$reclogic{min_title_for_colon_title_split} = 5;
146
147	# sanity check: don't accept insanely long programmes
148	$reclogic{max_programme_length} = (12 * 60 * 60); # 12 hours
149	$reclogic{max_programme_length_opt_channels} = (18 * 60 * 60); # 18 hours
150
151	# skip title translation for these categories and at least this long
152	@{$reclogic{title_xlate_skip_categories}} = ("sports");
153	$reclogic{title_xlate_skip_categories_min_programme_length} = (70 * 60); # 70 minutes
154
155	# store a preferred title only if we have at least 1 alternative
156	$reclogic{title_xlate_table_min_alt_progs} = 1;
157
158	# keep up to 30 days of title history
159	$reclogic{title_history} = 30;
160
161	# matching of history titles requires programme start within 20 minutes and duration within 10%
162	$reclogic{title_history_start_fuzzy_match_window} = (20*60); # seconds
163	$reclogic{title_history_duration_fuzzy_match_percent} = 10; # percent
164
165
166
167	#
168	# warning messages
169	#
170
171	$reclogic{warn_on_encoding_differences} = 0; # don't warn on encoding differences between XMLTV files
172	$reclogic{warn_on_no_title} = 1; # do warn on programme with no title
173	$reclogic{warn_on_no_channel} = 1; # do warn on programme with no channel
174	$reclogic{warn_on_unknown_channel} = 1; # do warn on programme with unknown channel
175	$reclogic{warn_on_invalid_time_in_prog} = 1; # do warn on programme with bad time format
176	$reclogic{warn_on_overlapping_programmes_always} = 0; # don't warn on all overlapping programmes from same source
177	$reclogic{warn_on_overlapping_programmes_for_different_title} = 1; # do warn on overlapping programmes from same source with different names
178	$reclogic{warn_on_invalid_time_in_prog} = 1; # do warn on a programme with a duration that is too long
179	$reclogic{warn_on_tba_prog} = 1; # do warn on encountering To Be Advised shows
180
181	#
182	# debug messages
183	#
184
185	$reclogic{debug_parse_time} = 0; # don't show debugging when parsing input time
186	$reclogic{debug_reconcile} = 0; # don't show reconciler logic
187	$reclogic{debug_reconcile_pass1} = 0; # don't show verbose pass 1 reconciler logic
188	$reclogic{debug_reconcile_pass2} = 0; # don't show verbose pass 2 reconciler logic
189	$reclogic{debug_add_logic} = 0; # don't show add logic debugging messages
190	$reclogic{debug_add_logic_verbose} = 0; # don't show add logic verbose debugging messages
191	$reclogic{debug_add_logic_name_xlate} = 0; # don't show add logic title translation messages
192	$reclogic{debug_delete_logic} = 0; # don't show delete logic debugging messages
193	$reclogic{debug_show_nonmatching_title_alternatives} = 0; # don't show non-matching alternative debugging messages
194	$reclogic{debug_find_prog_to_add} = 0; # don't show add_multiple logic debugging messages
195	$reclogic{debug_find_prog_to_add_verbose} = 0; # don't show add_multiple logic verbose debugging messages
196	$reclogic{debug_print_programme_list} = 0; # don't show programme listings while writing
197	$reclogic{debug_subtitle_derived_from_title} = 0; # don't show subtitles mapped from titles
198
199	#### end reconciler settings ####
200
201
202	#
203	# some initial cruft
204	#
205
206	my $script_start_time = time;
207	my %stats;
208	my $datafile;
209	my $channels, my $opt_channels;
210	my $in = { };
211	$in->{encoding} = 'ISO-8859-1';
212	my $out = { };
213	my $w;
214	my $gmt_offset;
215
216	my $setting_override;
217	my %cli_override;
218	my $title_xlate_table; # cached
219	my $title_history; # cached
220
221	my %amp = ( nbsp => ' ', qw{ amp & lt < gt > apos ' quot " } );
222
223
224	#
225	# parse command line
226	#
227
228	my $opt = { };
229	$opt->{output_file} = "output.xmltv";
230	$opt->{old_config_file} = $progname.".config";
231	$opt->{config_file} = $progname.".storable.config";
232	$opt->{log_file} = $progname.".log";
233	$opt->{alt_title_file} = $progname.".alt_title.log";
234	$opt->{lang} = "en";
235
236	GetOptions(
237	'region=i' => \$opt->{region}, # silently ignored
238	'days=i' => \$opt->{days}, # silently ignored
239	'offset=i' => \$opt->{offset}, # silently ignored
240	'timezone=s' => \$opt->{timezone}, # silently ignored
241
242	'channels_file=s' => \$opt->{channels_file},
243	'preftitle=s' => \$opt->{preftitle},
244	'old-config-file=s' => \$opt->{old_config_file},
245	'config-file=s' => \$opt->{config_file},
246	'log=s' => \$opt->{log_file},
247	'alt-title-file=s' => \$opt->{alt_title_file},
248	'output=s' => \$opt->{output_file},
249	'debug+' => \$opt->{debug},
250	'lang=s' => \$opt->{lang},
251	'option=s' => \%cli_override,
252
253	'no-log' => \$opt->{nolog},
254
255	'print_listing' => \$reclogic{debug_print_programme_list},
256	'dump_config' => \$opt->{dump_config},
257
258	'help' => \$opt->{help},
259	'verbose' => \$opt->{help},
260	'list_options' => \$opt->{help},
261	'version' => \$opt->{version},
262	'ready' => \$opt->{ready},
263	'desc' => \$opt->{desc},
264	'v' => \$opt->{version});
265
266	printf "%s v%s\n",$progname,$version;
267
268	if ($opt->{version} \|\| $opt->{desc} \|\| $opt->{help} \|\| $opt->{ready} \|\| $opt->{configure} \|\| $opt->{output_file} eq "") {
269	printf "A reconciler for multiple XMLTV data sources.\n" if $opt->{desc};
270	printf "$progname is ready for operation.\n" if ($opt->{ready});
271
272	printf "No --output file specified.\n" if ($opt->{output_file} eq "");
273
274	if ($opt->{help} \|\| $opt->{output_file} eq "") {
275	print<<EOF
276
277	usage: $0 [options] {FILE(s)}
278
279	Supported options include:
280	--ready verify that '$progname' is ready for operation
281
282	--lang={lang} set language to {lang} (default: $opt->{lang})
283	--channels_file={file} use channels file to augment list of channels (default: don't)
284	--output={file} send final XMLTV output to {file} (default: $opt->{output_file})
285	--debug enable ALL debugging
286
287	--print_listing print out programme listing of chosen programs
288
289	--config-file={file} config file for default overrides (default: none)
290	--log={file} write (detailed) log file in {file} (default: $opt->{log_file})
291	--alt-title-file={file} write details of possible alternate titles into {file} (default: $opt->{alt_title_file})
292
293	--list_options list all possible options
294	--option {opt}={val} set option {opt} to value {val}
295	EOF
296	;
297	foreach my $key (sort keys %reclogic) {
298	if (($key =~ /^warn_on_/) \|\| ($key =~ /^debug_/)) {
299	my $thiskey = sprintf "%s=%d",$key,($reclogic{$key} ? 0 : 1);
300	printf " --option %-30s %sable %s (default: %s)\n", $thiskey, ($reclogic{$key} ? "dis" : "en"),
301	$key, ($reclogic{$key} ? "do" : "don't");
302	} else {
303	my $thiskey = $key."={val}";
304	printf " --option %-30s set %s to {val} (default: %s)\n",$thiskey,$key,$reclogic{$key};
305	}
306	}
307	}
308	printf "\n";
309	exit(0);
310	}
311
312	# go go go!
313	unless ($opt->{nolog}) {
314	&rotate_logfiles;
315	open(LOG_FILE,">$opt->{log_file}") \|\| die "can't open log file $opt->{log_file} for writing: $!\n";
316	}
317
318	&log(1,(sprintf "started: %s%s%soutput %s",
319	($opt->{channels_file} ? "channels in $opt->{channels_file}, " : ""),
320	($opt->{config_file} ? "config in $opt->{config_file}, " : ""),
321	($opt->{preftitle} ? "preferred titles from $opt->{preftitle}, " : ""),
322	($opt->{output_file})));
323	&log(1,"logging to $opt->{log_file}") unless $opt->{nolog};
324	&log(1,"alternate titles to $opt->{alt_title_file}") unless $opt->{nolog};
325
326	# convert from old Data::Dumper to newer Storable config file
327	if ((defined $opt->{old_config_file}) && (-r $opt->{old_config_file})) {
328	&read_config_file($opt->{old_config_file},0) if ($opt->{old_config_file});
329	&write_config_file;
330	unlink($opt->{old_config_file});
331	}
332
333	&read_storable_file($opt->{config_file}) if ($opt->{config_file});
334	&show_settings;
335
336	&fill_in_channels if ($opt->{channels_file});
337
338	foreach my $file (@ARGV) {
339	$datafile = $file;
340	&log(1,(sprintf "parsing: %s",($datafile eq "-" ? "(from-stdin, hit control-D to finiah)" : $datafile)));
341
342	eval { XMLTV::parsefiles_callback(\&encoding_cb, \&credits_cb, \&channel_cb, \&programme_cb, $datafile); };
343	}
344
345	&start_writer;
346	&write_channels;
347
348	my $grabber_order = "", my $grabber_num = 0;
349	foreach my $data (@{($in->{datafile_order})}) {
350	$grabber_order .= sprintf "%s(%d)%s",
351	($grabber_num > 0 ? ", " : ""), $grabber_num, $data;
352	$grabber_num++;
353	}
354	&log(1,"reconciling with the following data-source preference: $grabber_order");
355
356	&reconcile;
357
358	&write_programmes;
359	$w->end();
360
361	unless ($opt->{nolog}) {
362	# compress older logfile
363	compress_file($opt->{log_file}.".1");
364	compress_file($opt->{alt_title_file}.".1");
365	}
366
367	&write_config_file if ($opt->{config_file});
368	&print_stats;
369
370	unless ($opt->{nolog}) {
371	close(LOG_FILE);
372	&write_alt_title_log;
373	}
374
375	die "No output file: $opt->{output_file}"
376	if !(-w $opt->{output_file} && -s $opt->{output_file});
377
378	exit(0);
379
380	######################################################################################################
381	# read settings (used for old config file and shepherd .conf files)
382
383	sub read_config_file
384	{
385	my($file,$die_on_failure) = @_;
386	if (!(-r $file)) {
387	die "file $file could not be read. aborting.\n" if $die_on_failure;
388	return;
389	}
390	local (@ARGV, $/) = ($file);
391	no warnings 'all'; eval <>; die "$@" if $@;
392	}
393
394	######################################################################################################
395	# used for reconciler new style config file
396
397	sub read_storable_file
398	{
399	my($file,$die_on_failure) = @_;
400	if (!(-r $file)) {
401	die "file $file could not be read. aborting.\n" if $die_on_failure;
402	return;
403	}
404
405	my $store;
406	eval { $store = Storable::retrieve($file); };
407	if ($@) {
408	&log(1,"Error reading $file: $@");
409	}
410
411	$setting_override = $store->{settings_override};
412	$title_xlate_table = $store->{title_xlate_table};
413	$title_history = $store->{title_history};
414
415	if (defined $opt->{dump_config}) {
416	print Dumper($store);
417	exit(0);
418	}
419	}
420
421	######################################################################################################
422
423	sub write_config_file
424	{
425	# age out old titles (default is to keep for 30 days as per $reclogic{title_history})
426	for my $cache_key (keys %{$title_history}) {
427	my ($starttime, $duration, $channel, $grabber) = split(/,/,$cache_key);
428	if ($starttime < (time-(86400*$reclogic{title_history}))) {
429	delete $title_history->{$cache_key};
430	$stats{expired_old_titles}++;
431	}
432	}
433
434	my $store;
435	$store->{settings_override} = $setting_override;
436	$store->{title_xlate_table} = $title_xlate_table;
437	$store->{title_history} = $title_history;
438
439	eval { Storable::store($store, $opt->{config_file}); };
440	if ($@) {
441	&log(1, "WARNING: Unable to update configuration file: $@");
442	} else {
443	&log(1,(sprintf "updated configuration file %s.\n",$opt->{config_file}));
444	}
445	}
446
447	######################################################################################################
448	# debug is actually always enabled (with default settings).
449	# --debug will turn on all debugging!
450
451	sub show_settings
452	{
453	foreach my $key (sort keys %reclogic) {
454	$reclogic{$key} = $setting_override->{$key} if (defined $setting_override->{$key});
455	$reclogic{$key} = $cli_override{$key} if (defined $cli_override{$key});
456	}
457
458	my $enabled_warnings = "";
459	my $enabled_debug = "";
460
461	foreach my $key (sort keys %reclogic) {
462	if ($key !~ /^debug_/) {
463	if ($key =~ /^warn_on_/) {
464	$enabled_warnings .= sprintf "%s%s",
465	($enabled_warnings ne "" ? ", " : ""),$key if ($reclogic{$key});
466	} elsif ($key =~ /^debug_/) {
467	$reclogic{$key} = 1 if ($opt->{debug});
468	$enabled_debug .= sprintf "%s%s",
469	($enabled_debug ne "" ? ", " : ""),$key if ($reclogic{$key});
470	} else {
471	# only print out setting if it was overridden
472	&log(1,(sprintf "%s was set to non-default %s via config-file option",$key,$reclogic{$key}))
473	if (defined $setting_override->{$key});
474	&log(1,(sprintf "%s was set to non-default %s via command-line option",$key,$reclogic{$key}))
475	if (defined $cli_override{$key});
476	}
477	}
478	}
479
480	&log(1,"warnings printed for: $enabled_warnings") if ($enabled_warnings ne "");
481	&log(1,"debug messages printed for: $enabled_debug") if ($enabled_debug ne "");
482	}
483
484	######################################################################################################
485	# we use our own die() routing to circumvent die() within eval statements where we are
486	# calling the standard XMLTV::parsefiles.
487	# this prevents bad XML from causing the reconciler to completely fail.
488
489	# ugly hack. please don't try this at home kids!
490
491	sub my_die {
492	my ($arg,@rest) = @_;
493	my ($pack,$file,$line,$sub) = caller(0);
494
495	# check if we are in an eval()
496	if ($^S) {
497	printf " caught a die() within eval{} from file $file line $line\n";
498	} else {
499	if (!ref($arg)) {
500	CORE::die("DIE at line $line in file $file ERROR: $arg" . join("",@rest));
501	} else {
502	CORE::die($arg,@rest);
503	}
504	}
505	}
506
507	######################################################################################################
508
509	sub rotate_logfiles
510	{
511	# keep last 4 log files
512	foreach my $file ($opt->{log_file}, $opt->{alt_title_file}) {
513	my $num;
514	for ($num = 4; $num > 0; $num--) {
515	my $f1 = sprintf "%s.%d.gz",$file,$num;
516	my $f2 = sprintf "%s.%d.gz",$file,$num+1;
517	unlink($f2);
518	rename($f1,$f2);
519	}
520
521	my $f2 = sprintf "%s.1",$file;
522	rename($file,$f2);
523	}
524	}
525
526	######################################################################################################
527
528	sub compress_file
529	{
530	my $infile = shift;
531	my $outfile = sprintf "%s.gz",$infile;
532	my $gz;
533
534	if (!(open(INFILE,"<$infile"))) {
535	warn "could not open file $infile for reading: $!\n";
536	return;
537	}
538
539	if (!($gz = gzopen($outfile,"wb"))) {
540	warn "could not open file $outfile for writing: $!\n";
541	return;
542	}
543
544	while (<INFILE>) {
545	my $byteswritten = $gz->gzwrite($_);
546	if ($byteswritten == 0) {
547	warn "error writing to compressed file: error $gz->gzerror";
548	}
549	}
550	close(INFILE);
551	$gz->gzclose();
552	unlink($infile);
553	}
554
555	######################################################################################################
556	# if we are supplied a channels_file, then fill in channels we know about from that.
557	# this is useful because some grabbers (e.g. oztivo) don't supply a <channels></channels>
558	# section at the top of their xmltv - and if they happen to be the first grabber,
559	# this causes issues with programmes with no (known) channel
560
561	sub fill_in_channels
562	{
563	&read_config_file($opt->{channels_file},1);
564
565	foreach my $ch (sort keys %{$channels}) {
566	&fill_channel($ch, $channels->{$ch});
567	}
568	foreach my $ch (sort keys %{$opt_channels}) {
569	&fill_channel($ch, $opt_channels->{$ch});
570	}
571
572	}
573
574	######################################################################################################
575
576	sub fill_channel
577	{
578	my ($ch, $id) = @_;
579
580	$in->{channels}->{$id}->{lang}->{($opt->{lang})} = $ch;
581	$in->{channels}->{$id}->{pref_desc} = $ch;
582	$in->{total_progs}->{$id} = 0;
583	$in->{total_progs_in}->{$id} = 0;
584	$in->{total_progs_out}->{$id} = 0;
585	}
586
587	######################################################################################################
588
589	sub log
590	{
591	my ($log_level,$entry) = @_;
592	printf "%s [%d] %s\n",$progname, time,$entry if ($log_level);
593	#printf LOG_FILE "%s [%d] %s\n",$progname, time,$entry if (($log_level) && (!$opt->{nolog}));
594	printf LOG_FILE "%s [%d] %s\n",$progname, time,$entry unless ($opt->{nolog});
595	}
596
597	######################################################################################################
598
599	sub print_stats
600	{
601	printf "STATS: %s v%s completed in %d seconds",$progname, $version, (time - $script_start_time);
602	foreach my $key (sort keys %stats) {
603	printf ", %d %s", $stats{$key},$key;
604	}
605	printf ".\n";
606	}
607
608	######################################################################################################
609	# descend a structure and clean up various things, including stripping
610	# leading/trailing spaces in strings, translations of html stuff etc
611	# -- taken & modified from Michael 'Immir' Smith's excellent tv_grab_au
612
613	sub cleanup {
614	my $x = shift;
615	if (ref $x eq "REF") { cleanup($_) }
616	elsif (ref $x eq "HASH") { cleanup(\$_) for values %$x }
617	elsif (ref $x eq "ARRAY") { cleanup(\$_) for @$x }
618	elsif (defined $$x) {
619	$$x =~ s/&(#(\d+)\|(.*?));/ $2 ? chr($2) : $amp{$3}\|\|' ' /eg;
620	# $$x =~ s/[^\x20-\x7f]/ /g;
621	$$x =~ s/(^\s+\|\s+$)//g;
622	}
623	}
624
625	######################################################################################################
626
627	# strptime type date parsing - BUT - if no timezone is present, treat time as being in localtime
628	# rather than the various other perl implementation which treat it as being in UTC/GMT
629	sub parse_xmltv_date
630	{
631	my $datestring = shift;
632	my @t; # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
633	my $tz_offset = 0;
634
635	# work out GMT offset - we only do this once
636	if (!$gmt_offset) {
637	my $tzstring = strftime("%z", localtime(time));
638
639	$gmt_offset = (6060) int(substr($tzstring,1,2)); # hr
640	$gmt_offset += (60 * int(substr($tzstring,3,2))); # min
641	$gmt_offset *= -1 if (substr($tzstring,0,1) eq "-"); # +/-
642	}
643
644	if ($datestring =~ /^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})/) {
645	($t[5],$t[4],$t[3],$t[2],$t[1],$t[0]) = (int($1)-1900,int($2)-1,int($3),int($4),int($5),0);
646	($t[6],$t[7],$t[8]) = (-1,-1,-1);
647
648	# if input data has a timezone offset, then offset by that
649	if ($datestring =~ /\+(\d{2})(\d{2})/) {
650	$tz_offset = $gmt_offset - (($1(6060)) + ($2*60));
651	} elsif ($datestring =~ /\-(\d{2})(\d{2})/) {
652	$tz_offset = $gmt_offset + (($1(6060)) + ($2*60));
653	}
654
655	my $e = mktime(@t);
656	return ($e+$tz_offset) if ($e > 1);
657	}
658	return undef;
659	}
660
661	######################################################################################################
662
663	sub write_alt_title_log
664	{
665	if (!(open(ALT_TITLE_FILE,">$opt->{alt_title_file}"))) {
666	warn "can't open alt-title-file $opt->{alt_title_file} for writing: $!\n";
667	return;
668	}
669
670	printf ALT_TITLE_FILE "$progname $version\n";
671
672	printf ALT_TITLE_FILE "\n==========================================================================================================\n\n";
673	printf ALT_TITLE_FILE "(1) The following list shows title translations that were used:\n\n";
674
675	printf ALT_TITLE_FILE " Times Preferred Title (translated to) Translated from Times\n";
676	printf ALT_TITLE_FILE " ----- -------------------------------- ------------------------------ -----\n";
677	my $u = $in->{used_translations};
678	foreach my $xlate_to (sort { $u->{$b}->{num} <=> $u->{$a}->{num} } keys %{$u}) {
679	printf ALT_TITLE_FILE " %5d %-32s", $u->{$xlate_to}->{num},$xlate_to;
680
681	my $u2 = $u->{$xlate_to}->{from};
682	my $num = 0;
683	foreach my $xlate_from (sort { $u2->{$a} <=> $u2->{$b} } keys %{$u2}) {
684	printf ALT_TITLE_FILE "%s %-30s %5d\n",
685	($num > 0 ? " " : ""),
686	$xlate_from, $u2->{$xlate_from};
687	$num++;
688	}
689	}
690
691	printf ALT_TITLE_FILE "\n==========================================================================================================\n\n";
692	printf ALT_TITLE_FILE "(2) The following table lists ALL the translations we have stored:\n\n";
693	printf ALT_TITLE_FILE "+Preferred title (xlate to) xlate_ preferred title seen in source (times)\n";
694	printf ALT_TITLE_FILE "-Alternate title (xlate from) times alternate title seen in source (times)\n";
695	printf ALT_TITLE_FILE " ---------------------------------- ------- --------------------------------------------------------------\n";
696
697	foreach my $xlate_to (sort { $title_xlate_table->{$b}->{translated} <=> $title_xlate_table->{$a}->{translated} } keys %{$title_xlate_table}) {
698	printf ALT_TITLE_FILE "+%-34s %7d ",
699	substr("\"".$title_xlate_table->{$xlate_to}->{translation}."\"",0,34),
700	$title_xlate_table->{$xlate_to}->{translated};
701
702	foreach my $source (sort { $title_xlate_table->{$xlate_to}->{same}->{$b} <=> $title_xlate_table->{$xlate_to}->{same}->{$a} }
703	keys %{($title_xlate_table->{$xlate_to}->{same})}) {
704	printf ALT_TITLE_FILE " %s(%d)", $source, $title_xlate_table->{$xlate_to}->{same}->{$source};
705	}
706	printf ALT_TITLE_FILE "\n";
707
708	foreach my $xlate_from (sort keys %{($title_xlate_table->{$xlate_to}->{alternate})}) {
709	my $last_xlated = (time - $title_xlate_table->{$xlate_to}->{alternate}->{$xlate_from}->{last_seen_in_secondary});
710	my $last_xlated_desc;
711	if ($last_xlated < (246060)) {
712	$last_xlated_desc = sprintf "-%dhrs",int($last_xlated/(246060));
713	} elsif ($last_xlated < (72460*60)) {
714	$last_xlated_desc = sprintf "-%ddays",int($last_xlated/(246060));
715	} else {
716	$last_xlated_desc = sprintf "-%dwks",int($last_xlated/(72460*60));
717	}
718
719	printf ALT_TITLE_FILE "-%-34s %7s ",substr("\"".$xlate_from."\"",0,34),$last_xlated_desc;
720
721	foreach my $source (sort { $title_xlate_table->{$xlate_to}->{alternate}->{$xlate_from}->{secondary}->{$a} <=>
722	$title_xlate_table->{$xlate_to}->{alternate}->{$xlate_from}->{secondary}->{$b} }
723	keys %{($title_xlate_table->{$xlate_to}->{alternate}->{$xlate_from}->{secondary})}) {
724	printf ALT_TITLE_FILE " %s(%d)", $source, $title_xlate_table->{$xlate_to}->{alternate}->{$xlate_from}->{secondary}->{$source};
725	}
726	printf ALT_TITLE_FILE "\n";
727	}
728	printf ALT_TITLE_FILE "\n";
729	}
730
731	printf ALT_TITLE_FILE "\n==========================================================================================================\n\n";
732	printf ALT_TITLE_FILE "(3) The following list shows timeslots where NO titles matched.\n\n";
733	printf ALT_TITLE_FILE " i.e. if we had 3 grabbers providing data for this timeslot,\n";
734	printf ALT_TITLE_FILE " the reconciler saw 3 programmes that it considered to be\n";
735	printf ALT_TITLE_FILE " different. (if 2 were the same and one was different, it wouldn't\n";
736	printf ALT_TITLE_FILE " show up in this list.)\n\n";
737	printf ALT_TITLE_FILE " The intent of this list is to keep a log that we can (hopefully)\n";
738	printf ALT_TITLE_FILE " interpret to improve the canonicalizeTitles_match() logic.\n\n";
739	print ALT_TITLE_FILE $in->{alt_title_mismatches} if (defined $in->{alt_title_mismatches});
740
741	close(ALT_TITLE_FILE);
742	}
743
744	######################################################################################################
745	# The two supplied program titles match well enough that we should consider them to identify the same
746	# program. The approach we use is check that every word in the shorter title has a corresponding
747	# (nearly) identical word in the longer title. This handles grabbers that shorten program titles,
748	# such as from "House, MD" to "House." It als ignores word order altogether, since different
749	# grabbers often change word order around. Finally, we allow the shorter title to join together
750	# two adjacent words from the longer title.
751
752	sub canonicalizeTitles_match
753	{
754	my $word1 = canonicalizeTitle(shift);
755	my $word2 = canonicalizeTitle(shift);
756	my @longer;
757	my @shorter;
758
759	if (length($word1) > length($word2)) {
760	@longer = split(/\s+/, $word1);
761	@shorter = split(/\s+/, $word2);
762	} else {
763	@shorter = split(/\s+/, $word1);
764	@longer = split(/\s+/, $word2);
765	}
766
767	WORD: for my $word (@shorter) {
768	for(my $i=0; $i < @longer; ++$i) {
769	if (forgivingMatch($longer[$i], $word)) {
770	splice(@longer,$i,1);
771	next WORD;
772	} elsif ($i+1 < @longer &&
773	$word eq "$longer[$i]$longer[$i+1]") {
774	splice(@longer,$i,2);
775	next WORD;
776	}
777	}
778	return(0);
779	}
780
781	return(0) if (match_stoplist_override($word1, $word2));
782	return(1);
783	}
784
785	# lookup table of special case name matches
786	my %alternatives = ( one => "1",
787	two => "2",
788	to => "2",
789	too => "2",
790	three => "3",
791	four => "4",
792	for => "4",
793	five => "5",
794	six => "6",
795	seven => "7",
796	eight => "8",
797	nine => "9"
798	);
799
800	##############################################################################
801	# Are the two arguments "close enough" to being identical strings that they
802	# should be considered the same word? Differences we are willing to overlook
803	# include a single character transposition, insertion/deletion, or replacement
804	# in words of 3 or more characters. We also have a table of special cases that
805	# consider digits to be identical to their names, and also to common homonyms
806	# of their names (eg, "2" for "too").
807
808	sub forgivingMatch
809	{
810	my $word1 = shift;
811	my $word2 = shift;
812
813	# exact match
814	return 1 if $word1 eq $word2;
815	# they match according to our alternatives lookup table
816	return 1 if $alternatives{$word1} && $alternatives{$word1} eq $word2 \|\|
817	$alternatives{$word2} && $alternatives{$word2} eq $word1;
818	# irreconcilable differences
819	return 0 if abs(length($word1) - length($word2)) > 1 \|\|
820	length($word1) < 3;
821
822	my @list1 = split(//,$word1);
823	my @list2 = split(//,$word2);
824	my $i = 0;
825	my $j = 0;
826
827	# find first difference
828	while ($i < @list1 && $j < @list2 && $list1[$i] eq $list2[$j]) {
829	++$i; ++$j;
830	}
831	if ($i+1 < @list1 && $j+1 < @list2) {
832	# at least 2 chars to go in both words
833	if ($list1[$i+1] eq $list2[$j] && $list1[$i] eq $list2[$j+1]) {
834	# step over transposed characters
835	$i += 2;
836	$j += 2;
837	} elsif ($list1[$i+1] eq $list2[$j]) {
838	# step over extra character inserted into @list1
839	$i += 2;
840	++$j;
841	} elsif ($list1[$i] eq $list2[$j+1]) {
842	# steop over extra character inserted into @list2
843	++$i;
844	$j += 2;
845	} else {
846	# step over single character difference
847	++$i;
848	++$j;
849	}
850	# we forgave one difference; now do rest of strings match exactly?
851	while ($i < @list1 && $j < @list2 && $list1[$i] eq $list2[$j]) {
852	++$i; ++$j;
853	}
854	return($i == @list1 && $j == @list2);
855	} elsif ($i == @list1 \|\| $j == @list2) {
856	# only difference is one word has one extra letter, or last char
857	# of each word differ. That's still only one one-char difference
858	return(1);
859	}
860	}
861
862	##############################################################################
863	# Cleanup small ideosyncracies in a title that might make it harder to match.
864	# For now this just fixes up html entities and ampersands, normalizes whitepace,
865	# removes punctuation, and lowercases everything.
866
867	sub canonicalizeTitle
868	{
869	my $title=shift;
870	$title =~ s/^\s+//;
871	$title =~ s/\s+$//;
872	$title =~ s/&(#(\d+)\|(.*?));/ $2 ? chr($2) : $amp{$3}\|\|' ' /eg;
873	$title =~ s/ \& / and /g;
874	$title =~ s/[^ a-zA-Z0-9]//g;
875	$title =~ s/\s+/ /;
876	return(lc($title));
877	}
878
879	######################################################################################################
880	# used to override what would otherwise be canonical matches
881	# returns 1 if they should NOT match
882
883	sub match_stoplist_override
884	{
885	my ($word1, $word2) = @_;
886
887	# if the left-hand-side programme matches the right-hand-side, ensure the
888	# alternate programme ALSO matches the right-hand-side
889	my $canonical_stop_list_exceptions = {
890	'Law.*Order' => [ "Criminal", "SVU", "Special", "Trial","UK" ],
891	'BBC World News' => [ "America" ],
892	'(CSI\|Crime.Scene.Investigation).:' => [ ":.Crime", "NY", "N.Y", "New", "Miami" ],
893	'NCIS' => [ "Los Angeles" ],
894	'Doctor Who' => ["Confidential"],
895	'Stargate' => [ "Universe", "SG.*1", "Atlantis", "Infinity" ],
896	'Criminal Minds' => [ 'Suspect Behavior', 'Suspect Behaviour' ],
897	'Once Upon a Time' => [ 'in .*' ],
898	};
899
900	foreach my $stop1 (keys %$canonical_stop_list_exceptions) {
901	#printf "checking word1 ($word1) against stoplist stop1 ($stop1) ..\n";
902	if ($word1 =~ /^$stop1/i) {
903	#printf " word1 ($word1) contains stop1 ($stop1)\n";
904	foreach my $stop2 (@{($canonical_stop_list_exceptions->{$stop1})}) {
905	#printf " checking whether word1 ($word1) contains stop2 ($stop2)\n";
906	if ($word1 =~ /$stop2/i) {
907	#printf " word1 ($word1) contains stop2 ($stop2)\n";
908	if ($word2 !~ /$stop2/i) {
909	#printf " word2 ($word2) doesn't contain stop2 ($stop2). rejecting match!\n";
910	return 1;
911	}
912	}
913	#printf " checking whether word2 ($word2) contains stop2 ($stop2)\n";
914	if ($word2 =~ /$stop2/i) {
915	#printf " word2 ($word2) contains stop2 ($stop2)\n";
916	if ($word1 !~ /$stop2/i) {
917	#printf " word1 ($word1) doesn't contain stop2 ($stop2). rejecting match!\n";
918	return 1;
919	}
920	}
921	}
922	}
923	}
924
925	return 0;
926	}
927
928	######################################################################################################
929
930	sub encoding_cb( $ )
931	{
932	my $e = shift;
933	#printf "got encoding ".Dumper($e);
934	$in->{encoding} = $e if (!$in->{encoding});
935
936	&log($reclogic{warn_on_encoding_differences},
937	(sprintf"WARNING: encoding '%s' from %s different from %s",$e,$datafile,$in->{encoding}))
938	if ($in->{encoding} ne $e);
939	}
940
941	######################################################################################################
942
943	sub credits_cb( $ )
944	{
945	my $c = shift;
946	#printf "got credits ".Dumper($c);
947
948	my ($proggy, $version);
949
950	if ($c->{'generator-info-name'}) {
951	if ($c->{'generator-info-name'} =~ /\s?(\S+)\s[v]?([\d\.]+)/) {
952	($proggy, $version) = ($1,$2);
953	}
954	}
955
956	$proggy = $datafile if (!defined $proggy);
957	$version = "" if (!defined $version);
958
959	$in->{data}->{$proggy}->{file} = $datafile;
960	$in->{datafile}->{$datafile} = $proggy;
961	$in->{data}->{$proggy}->{version} = $version;
962
963	if (!defined $in->{num_datafiles}) {
964	$in->{num_datafiles} = 0;
965	$in->{sources} = "$proggy";
966	} else {
967	$in->{sources} .= ",$proggy";
968	}
969
970	$in->{data}->{titlepref} = $in->{num_datafiles}
971	if ((defined $opt->{preftitle}) && ($datafile eq $opt->{preftitle}));
972
973	$in->{datafile_order}->[($in->{num_datafiles})] = $proggy;
974	$in->{num_datafiles}++;
975	}
976
977	######################################################################################################
978
979	sub channel_cb( $ )
980	{
981	my $c = shift;
982	#printf "got channel ".Dumper($c);
983
984	my $chan = $c->{id};
985	my %chan_lang;
986
987	# only add this channel if $reclogic{always_add_new_channels} is set
988	if ((!defined $in->{channels}->{$chan}) && (!$reclogic{always_add_new_channels})) {
989	&log($reclogic{warn_on_unknown_channel},(sprintf "WARNING: channel '%s' from file \"%s\" not in channels.conf; ignored.", $chan, $datafile));
990	$stats{ignored_unknown_channel}++;
991	return;
992	}
993
994	if (defined $c->{'display-name'} && defined $c->{'display-name'}->[0]) {
995	foreach my $ch_block ($c->{'display-name'}->[0]) {
996	my ($desc,$lang) = ($ch_block->[0],$ch_block->[1]);
997	$lang = $opt->{lang} if (!defined $lang);
998	$desc = "unknown" if (!defined $desc);
999
1000	if (!defined $in->{channels}->{$chan}) {
1001	$in->{channels}->{$chan}->{lang}->{$lang} = $desc;
1002	$in->{total_progs}->{$chan} = 0;
1003	$in->{total_progs_in}->{$chan} = 0;
1004	$in->{total_progs_out}->{$chan} = 0;
1005	} else {
1006	$in->{channels}->{$chan}->{lang}->{$lang} = $desc
1007	if (!defined $in->{channels}->{$chan}->{lang}->{$lang});
1008	}
1009
1010	$in->{channels}->{$chan}->{pref_desc} = $desc
1011	if (!defined $in->{channels}->{$chan}->{pref_desc});
1012	}
1013	}
1014	}
1015
1016	######################################################################################################
1017
1018	sub programme_cb( $ )
1019	{
1020	my $prog=shift;
1021	# print "got programme from $datafile: ".Dumper($prog);
1022
1023	# make sure programme has a title
1024	if (!defined $prog->{title} \|\| !defined $prog->{title}->[0]) {
1025	&log($reclogic{warn_on_no_title},(sprintf "WARNING: programme with no title in %s; ignored.", $datafile));
1026	$stats{bad_programme_no_title}++;
1027	return;
1028	}
1029	my $prog_title = $prog->{title}->[0]->[0];
1030	my $prog_subtitle;
1031	$prog_subtitle = $prog->{'sub-title'}->[0]->[0] if (defined $prog->{'sub-title'} && $prog->{'sub-title'}->[0] && $prog->{'sub-title'}->[0]->[0]);
1032
1033	# make sure programme has a channel
1034	if (!defined $prog->{channel}) {
1035	&log($reclogic{warn_on_no_channel},(sprintf "WARNING: programme '%s' had no channel information; ignored.", $prog_title));
1036	$stats{bad_programme_no_channel}++;
1037	return;
1038	}
1039	my $prog_chan = $prog->{channel};
1040
1041	# make sure we know about this channel
1042	if (!defined $in->{channels}->{$prog_chan}) {
1043	&log($reclogic{warn_on_unknown_channel},(sprintf "WARNING: programme '%s' had unknown channel \"%s\"; ignored.", $prog_title, $prog_chan));
1044	$stats{bad_programme_unknown_channel}++;
1045	return;
1046	}
1047
1048	my $source = $in->{datafile}->{$datafile};
1049
1050	# work out epoch times
1051	my $t1 = &parse_xmltv_date($prog->{start});
1052	my $t2 = &parse_xmltv_date($prog->{stop});
1053
1054	if (!$t1 \|\| !$t2) {
1055	&log($reclogic{warn_on_invalid_time_in_prog},
1056	(sprintf "WARNING: programme '%s' on channel '%s' from %s had invalid start (%s) or stop (%s) time; ignored.",
1057	$prog_title, $prog_chan, $datafile, ($prog->{start} ? $prog->{start} : "undef"),
1058	($prog->{stop} ? $prog->{stop} : "undef")));
1059	$stats{bad_programme_invalid_times}++;
1060	return;
1061	}
1062
1063	&log($reclogic{debug_parse_time},
1064	(sprintf " prog \"%s\" on chan \"%s\" start %s end %s, duration %d, file %s",
1065	$prog_title, $prog_chan, (strftime "%a%e%b%H:%M", localtime($t1)),
1066	(strftime "%a%e%b%H%M", localtime($t2)), ($t2 - $t1), $source)) if ($t1 && $t2);
1067
1068	# skip if on a freetv channel and too long OR extra long provided title isn't 'close'
1069	if (((defined $channels->{$in->{channels}->{$prog_chan}->{pref_desc}} &&
1070	(($t2 - $t1) > $reclogic{max_programme_length})) \|\|
1071	(($t2 - $t1) > $reclogic{max_programme_length_opt_channels})) &&
1072	($prog_title !~ /\bclose\b/i)) {
1073	&log($reclogic{warn_on_invalid_time_in_prog},
1074	(sprintf "WARNING: programme '%s' on channel '%s' from %s had a programme duration (%d) that exceeded max_programme_length (%d): start '%s' stop '%s'; ignored.",
1075	$prog_title, $prog_chan, $datafile, ($t2-$t1), $reclogic{max_programme_length},
1076	($prog->{start} ? $prog->{start} : "undef"), ($prog->{stop} ? $prog->{stop} : "undef")));
1077	$stats{bad_programme_duration_too_long}++;
1078	return;
1079	}
1080
1081	# skip if 'To Be Advised' or 'TBA'
1082	if ($prog_title =~ /^to be advised$/i or $prog_title =~ /^tba$/i)
1083	{
1084	&log($reclogic{warn_on_tba_prog},
1085	(sprintf "WARNING: ignoring TBA programme '%s' on channel '%s' from %s: start '%s' stop '%s'; ignored.",
1086	$prog_title, $prog_chan, $datafile,
1087	($prog->{start} ? $prog->{start} : "undef"),
1088	($prog->{stop} ? $prog->{stop} : "undef")));
1089	return;
1090	}
1091
1092	$prog->{start_epoch} = $t1;
1093	$prog->{stop_epoch} = $t2;
1094	$prog->{grabber} = $source;
1095	$prog->{grabber_num} = ($in->{num_datafiles}-1);
1096	my $prog_key = sprintf "%d:%d",$t1,$t2;
1097
1098	# if its on a freetv channel without a subtitle and a possible series
1099	# (not a movie (less then or equal to 70 minutes)) and
1100	# there is a ": " in title, split title into "title: subtitle"
1101	# if each of title/subtitle will be at least $reclogic{min_title_for_colon_title_split} characters
1102	if (defined $channels->{$in->{channels}->{$prog_chan}->{pref_desc}} && !defined $prog_subtitle &&
1103	(($t2 - $t1) <= $reclogic{max_length_for_colon_title_split})) {
1104	my ($title1,$title2) = split(/: /,$prog_title,2);
1105
1106	if (($title1) && ($title2) &&
1107	(length($title1) >= $reclogic{min_title_for_colon_title_split}) &&
1108	(length($title2) >= $reclogic{min_title_for_colon_title_split})) {
1109	&log($reclogic{debug_subtitle_derived_from_title},
1110	(sprintf "split title \"%s\" into title \"%s\" subtitle \"%s\" since over min_title_for_colon_title_split (%d)",
1111	$prog_title, $title1, $title2, $reclogic{min_title_for_colon_title_split}));
1112	$stats{derived_subtitle_from_title}++;
1113
1114	$prog_title = $title1;
1115	$prog->{title}->[0]->[0] = $title1;
1116
1117	$prog_subtitle = $title2;
1118	$prog->{'sub-title'}->[0]->[0] = $title2;
1119	$prog->{'sub-title'}->[0]->[1] = $prog->{'title'}->[0]->[1];
1120	}
1121
1122	}
1123
1124	# check to see if this grabber has supplied a programme with this start/stop on this
1125	# channel already. if there is, whinge about it & drop the duplicate
1126	if (defined $in->{dupcheck}->{$source}->{$prog_chan}->{$prog_key}) {
1127	# record statistic but don't print error message if programme names actually match
1128	my $warn = (($reclogic{warn_on_overlapping_programmes_always}) \|\|
1129	(($reclogic{warn_on_overlapping_programmes_for_different_title}) &&
1130	($prog_title ne $in->{dupcheck}->{$source}->{$prog_chan}->{$prog_key})));
1131	&log($warn,(sprintf "WARNING: file contained more than one programme in same timeslot: channel '%s' start %s, stop %s, programs \"%s\" and \"%s\"; ignored.",
1132	$prog_chan,
1133	(strftime "%a%e%b%H:%M",localtime($t1)),
1134	(strftime "%a%e%b%H:%M",localtime($t2)),
1135	$prog_title,
1136	$in->{dupcheck}->{$source}->{$prog_chan}->{$prog_key}));
1137	$stats{bad_programme_duplicate_times}++;
1138	return;
1139	}
1140	$in->{dupcheck}->{$source}->{$prog_chan}->{$prog_key} = $prog_title;
1141
1142
1143	#
1144	# store each programme in a tree. the tree looks like:
1145	# $in->{tree}->{$chan}->{$progkey}->{progs}->[n]
1146	# $in->{tree}->{$chan}->{$progkey}->{numprogs}
1147	#
1148
1149	my $prognum = 0;
1150	$prognum = $in->{tree}->{$prog_chan}->{$prog_key}->{numprogs}
1151	if (defined $in->{tree}->{$prog_chan}->{$prog_key}->{numprogs});
1152	$in->{tree}->{$prog_chan}->{$prog_key}->{progs}->[$prognum] = $prog;
1153	$prognum++;
1154	$in->{tree}->{$prog_chan}->{$prog_key}->{numprogs} = $prognum;
1155
1156	$in->{total_progs}->{$prog_chan}++;
1157	$in->{total_progs_in}->{$prog_chan}++;
1158	}
1159
1160	######################################################################################################
1161	# open output file, write encoding + credits headings
1162
1163	sub start_writer
1164	{
1165	my %writer_args = ( encoding => $in->{encoding} );
1166	my $fh = new IO::File(">$opt->{output_file}") \|\| die "can't open $opt->{output_file}: $!";
1167	$writer_args{OUTPUT} = $fh;
1168	$w = new XMLTV::Writer(%writer_args);
1169	$w->start( { 'generator-info-name' => "$progname $version", 'source-info-name' => $in->{sources} } );
1170	}
1171
1172	######################################################################################################
1173	# write out our channels
1174
1175	sub write_channels
1176	{
1177	foreach my $chan_id (sort keys %{($in->{channels})}) {
1178	my $this_chan = $in->{channels}->{$chan_id};
1179
1180	my $lang_list, my $num_langs = 0;
1181	foreach my $lang (keys %{($this_chan->{lang})}) {
1182	$lang_list->[$num_langs]->[0] = $this_chan->{lang}->{$lang};
1183	$lang_list->[$num_langs]->[1] = $lang;
1184	$num_langs++;
1185	}
1186
1187	$w->write_channel( { 'id' => $chan_id, 'display-name' => $lang_list } );
1188	}
1189	}
1190
1191	######################################################################################################
1192	# write out our programmes
1193
1194	sub write_programmes
1195	{
1196	foreach my $chan_id (sort keys %{($in->{channels})}) {
1197	foreach my $prog_key (sort keys %{($out->{$chan_id})}) {
1198	my $prog = $out->{$chan_id}->{$prog_key};
1199	my $progname = sprintf "%s%s",
1200	$prog->{title}->[0]->[0],
1201	($prog->{subtitle} ? ": $prog->{subtitle}->[0]->[0]" : "");
1202
1203	printf "%-10s %s - %s: %-30s {src %s}\n",
1204	$in->{channels}->{$chan_id}->{pref_desc},
1205	(strftime "%a%e%b%H:%M", localtime($prog->{start_epoch})),
1206	(strftime "%a%e%b%H:%M", localtime($prog->{stop_epoch})),
1207	$progname,
1208	$prog->{datasources}
1209	if ($reclogic{debug_print_programme_list});
1210
1211	delete $prog->{start_epoch} if (defined $prog->{start_epoch});
1212	delete $prog->{stop_epoch} if (defined $prog->{stop_epoch});
1213	delete $prog->{datasources} if (defined $prog->{datasources});
1214
1215	&cleanup($prog);
1216	$w->write_programme($prog);
1217	}
1218	}
1219	}
1220
1221	######################################################################################################
1222	# all logic associated with choosing the preferred title of a programme
1223	# (uses past-seen choices to set preferences)
1224
1225	sub choose_title
1226	{
1227	my ($num_matching,$m) = @_;
1228	my @titles, my @titles_from;
1229	my $num_titles = 0;
1230	my $channel = $m->[0]->{channel};
1231	my $title_start = $m->[0]->{start_epoch};
1232	my $title_duration = $m->[0]->{stop_epoch} - $m->[0]->{start_epoch};
1233
1234	# 0. first gather title from "preferred grabber" if we have it for
1235	# this programme
1236	if (defined $in->{data}->{titlepref}) {
1237	for my $i (0..($num_matching-1)) {
1238	if (($m->[$i]->{grabber_num} == $in->{data}->{titlepref}) &&
1239	(defined $m->[$i]->{title})) {
1240	foreach my $found_t (@{($m->[$i]->{title})}) {
1241	my $t = $found_t->[0];
1242	my $l = $found_t->[1];
1243
1244	if ((!defined $l) \|\| (lc($l) eq lc($opt->{lang}))) {
1245	$titles[$num_titles] = $t;
1246	$titles_from[$num_titles] = $m->[$i]->{grabber};
1247	$num_titles++;
1248	}
1249	}
1250	}
1251	}
1252	}
1253
1254	# 1. gather a list of all titles we have for our preferred language
1255	# there are stored in the @titles array in "quality" order
1256	for my $i (0..($num_matching-1)) {
1257	if (defined $m->[$i]->{title}) {
1258	next if ((defined $in->{data}->{titlepref}) &&
1259	($m->[$i]->{grabber_num} == $in->{data}->{titlepref}));
1260
1261	foreach my $found_t (@{($m->[$i]->{title})}) {
1262	my $t = $found_t->[0];
1263	my $l = $found_t->[1];
1264
1265	if ((!defined $l) \|\| (lc($l) eq lc($opt->{lang}))) {
1266	$titles[$num_titles] = $t;
1267	$titles_from[$num_titles] = $m->[$i]->{grabber};
1268	$num_titles++;
1269	}
1270	}
1271	}
1272	}
1273
1274	# 2. no titles in our language? return with the first title we saw
1275	if ($num_titles == 0) {
1276	my $title = $m->[0]->{title}->[0]->[0];
1277	my $lang = $m->[0]->{title}->[0]->[1];
1278
1279	&log($reclogic{debug_choose_title},(sprintf
1280	"choose_title: no titles in lang %s found; using first title \"%s\" in lang %s",
1281	$opt->{lang}, $title, (defined $lang ? $lang : "(undef)")));
1282	return ($title, $lang);
1283	}
1284
1285	# if 70 minutes or longer and category sport return best title
1286	if ($title_duration >= $reclogic{title_xlate_skip_categories_min_programme_length}) {
1287	for my $i (0..($num_matching-1)) {
1288	if (defined $m->[$i]->{title} && defined $m->[$i]->{category}) {
1289	foreach my $found_c (@{($m->[$i]->{category})}) {
1290	my $c = $found_c->[0];
1291	next if ($c eq '');
1292
1293	foreach my $skip_c (@{$reclogic{title_xlate_skip_categories}}) {
1294	if (lc($c) eq lc($skip_c)) {
1295	&log($reclogic{debug_choose_title},(sprintf
1296	"choose_title: not using xlate table; using best title \"%s\" because category \"%s\" and length %d minutes", $titles[0], $skip_c, $title_duration/60));
1297	return ($titles[0], $opt->{lang});
1298	}
1299	}
1300	}
1301	}
1302	}
1303	}
1304
1305	# 3. do we already have any titles in our list here in our 'preferred title' list?
1306	my $found_index = -1;
1307	foreach my $i (0..$num_titles) {
1308	if (defined $title_xlate_table->{(lc($titles[$i]))}) {
1309	$found_index = $i;
1310	last;
1311	}
1312	}
1313
1314	# 4. found our preferred title. use that.
1315	if ($found_index != -1) {
1316	my $key = lc($titles[$found_index]);
1317	my $title = $title_xlate_table->{$key}->{translation};
1318
1319	&log($reclogic{debug_choose_title},(sprintf
1320	"choose_title: existing preferred title \"%s\" matched with title \"%s\" from grabber %s (index %d)",
1321	$title, $titles[$found_index], $titles_from[$found_index], $found_index));
1322
1323	# update stats on use
1324	$title_xlate_table->{$key}->{seen_in_primary}++;
1325	$title_xlate_table->{$key}->{last_seen_in_primary} = time;
1326
1327	# update 'seen' stats for alternatives
1328	foreach my $i (0..($num_titles-1)) {
1329	my $key2 = $titles[$i]; # don't actually store in lower-case..
1330	my $source = $titles_from[$i];
1331
1332	if (lc($key) eq lc($key2)) {
1333	# store where we have seen the same title
1334	$title_xlate_table->{$key}->{same}->{$source}++;
1335	} else {
1336	# store all alternatives for this title
1337	$title_xlate_table->{$key}->{alternate}->{$key2}->{secondary}->{$source}++;
1338	$title_xlate_table->{$key}->{alternate}->{$key2}->{last_seen_in_secondary} = time;
1339	}
1340	}
1341
1342	return ($title, $opt->{lang});
1343	}
1344
1345	# 5. didn't find this title in our preferred title list.
1346	# see if it is an alternate name
1347	foreach my $i (0..($num_titles-1)) {
1348	my $title = $titles[$i]; # don't actually convert to lowercase..
1349
1350	# FUTURE MAYBE: this is a linear search.
1351	# if it grows too much consider a schema change to make it better
1352
1353	foreach my $key (keys %{($title_xlate_table)}) {
1354	foreach my $key2 (keys %{($title_xlate_table->{$key}->{alternate})}) {
1355	if (lc($key2) eq lc($title)) {
1356	my $xlated_to = $title_xlate_table->{$key}->{translation};
1357	my $xlated_from = $titles[$i];
1358
1359	# check that its a real match
1360	if (match_stoplist_override($xlated_from, $xlated_to)) {
1361	&log($reclogic{debug_choose_title},
1362	"choose_title: match_stoplist_override: \"$xlated_from\" does not match \"$xlated_to\"");
1363	next;
1364	}
1365
1366	# matched alternate!
1367	$title_xlate_table->{$key}->{translated}++;
1368	$in->{used_translations}->{$xlated_to}->{num}++;
1369	$in->{used_translations}->{$xlated_to}->{from}->{$xlated_from}++;
1370
1371	&log($reclogic{debug_choose_title},(sprintf
1372	"choose_title: title \"%s\" (idx %d grabber %s) matched previously-seen alternate title for \"%s\"",
1373	$xlated_from, $i, $titles_from[$i], $xlated_to));
1374
1375	# update 'seen' stats for alternatives
1376	foreach my $j (0..($num_titles-1)) {
1377	my $key2a = $titles[$j]; # don't store in lowercase
1378	my $source = $titles_from[$j];
1379
1380	if ($key eq lc($key2a)) {
1381	# store where we have seen the same title
1382	$title_xlate_table->{$key}->{same}->{$source}++;
1383	} else {
1384	# store all alternatives for this title
1385	$title_xlate_table->{$key}->{alternate}->{$key2a}->{secondary}->{$source}++;
1386	$title_xlate_table->{$key}->{alternate}->{$key2a}->{last_seen_in_secondary} = time;
1387	}
1388	}
1389
1390	# return primary translation for this found alternative
1391	return ($xlated_to, $opt->{lang});
1392	}
1393	}
1394	}
1395	}
1396
1397	my $seen_in_primary = time;
1398
1399	# 6. look back through our history of programmes to see if we can fuzzy match
1400	# this title to a previously-seen title
1401	for my $title_cache_key (keys %{$title_history}) {
1402	my ($th_starttime, $th_duration, $th_channel, $th_grabber) = split(/,/,$title_cache_key);
1403
1404	# has to be on same channel
1405	next if ($channel ne $th_channel);
1406
1407	# has to be on the same day of the week
1408	next if ((int($th_starttime / 86400) % 7) != (int($title_start / 86400) % 7));
1409
1410	# duration has to be within 10% ($reclogic{title_history_duration_fuzzy_match_percent})
1411	next if ($title_duration > ($th_duration * (1 + ($reclogic{title_history_duration_fuzzy_match_percent} / 100))));
1412	next if ($title_duration < ($th_duration * (1 - ($reclogic{title_history_duration_fuzzy_match_percent} / 100))));
1413
1414	# start time has to be within 20 minutes ($reclogic{title_history_start_fuzzy_match_window})
1415	my $th_starttime_day = $th_starttime % (7*86400);
1416	my $title_start_day = $title_start % (7*86400);
1417	next if ($title_start_day > ($th_starttime_day + $reclogic{title_history_start_fuzzy_match_window}));
1418	next if ($title_start_day < ($th_starttime_day - $reclogic{title_history_start_fuzzy_match_window}));
1419
1420	# within window - check title
1421	foreach my $i (0..($num_titles-1)) {
1422	# grabber has to be different
1423	next if ($th_grabber eq $titles_from[$i]);
1424
1425	# check match
1426	my $match = canonicalizeTitles_match($title_history->{$title_cache_key},$titles[$i]);
1427	&log($reclogic{debug_choose_title},(sprintf "choose_title: title \"%s\" (from %s) %s title_history \"%s\" (from %s)",
1428	$titles[$i], $titles_from[$i], ($match == 1 ? "IS THE SAME AS" : "did not match"),
1429	$title_history->{$title_cache_key}, $th_grabber));
1430
1431	if ($match) {
1432	# match - add it to the front of our titles list!
1433	$num_titles++;
1434	unshift(@titles, $title_history->{$title_cache_key});
1435	unshift(@titles_from, $th_grabber);
1436	$seen_in_primary = $th_starttime;
1437	last;
1438	}
1439	}
1440	}
1441
1442	my $preferred_title = $titles[0];
1443
1444	# 7. don't create a preferred title for this unless we have met our threshold for title_xlate_table_min_alt_progs
1445	if (($num_titles-1) < $reclogic{title_xlate_table_min_alt_progs}) {
1446	&log($reclogic{debug_choose_title},(sprintf
1447	"choose_title: title \"%s\" not added as a preferred title due to title_xlate_table_min_alt_progs (%d)",
1448	$preferred_title, $reclogic{title_xlate_table_min_alt_progs}));
1449	return ($preferred_title, $opt->{lang});
1450	}
1451
1452	# 8. wasn't an alternate name
1453	# add it as a preferred name
1454
1455	my $key = lc($preferred_title);
1456	$title_xlate_table->{$key}->{seen_in_primary} = 1;
1457	$title_xlate_table->{$key}->{last_seen_in_primary} = $seen_in_primary;
1458	$title_xlate_table->{$key}->{translated} = 0;
1459	$title_xlate_table->{$key}->{translation} = $preferred_title;
1460	$title_xlate_table->{$key}->{same}->{$titles_from[0]} = 1;
1461
1462	foreach my $i (1..($num_titles-1)) {
1463	my $key2 = $titles[$i];
1464	my $source = $titles_from[$i];
1465
1466	if (lc($key2) eq $key) {
1467	$title_xlate_table->{$key}->{same}->{$source}++;
1468	} else {
1469	$title_xlate_table->{$key}->{alternate}->{$key2}->{secondary}->{$source} = 1;
1470	$title_xlate_table->{$key}->{alternate}->{$key2}->{last_seen_in_secondary} = time;
1471	}
1472	}
1473
1474	&log($reclogic{debug_choose_title},(sprintf
1475	"choose_title: added title \"%s\" as a preferred title (grabber %s)",
1476	$preferred_title, $titles_from[0]));
1477
1478	return ($preferred_title, $opt->{lang});
1479	}
1480
1481	######################################################################################################
1482	# insert a programme into our reconciled list
1483	# - if fed multiple programmes for the one slot, choose attributes from all of them
1484
1485	sub add_one_programme
1486	{
1487	my($chan_id,$title,$title_lang,$num_matching,$m) = @_;
1488	&log($reclogic{debug_add_logic},
1489	(sprintf "add_one_programme: adding programme %s-%s \"%s\" with data from %d programmes",
1490	(strftime "%a%e%b%H:%M",localtime(($m->[0]->{start_epoch}))),
1491	(strftime "%a%e%b%H:%M",localtime(($m->[0]->{stop_epoch}))),
1492	$title, $num_matching));
1493
1494	my $newprog;
1495	my $chan = $m->[0]->{channel};
1496	my $starttime = $m->[0]->{start_epoch};
1497	my $have_xlated_title = 0;
1498
1499	# always take start/stop/channel from first choice
1500
1501	if ($reclogic{always_rewrite_start_stop_without_timezone}) {
1502	$newprog->{start} = strftime "%Y%m%d%H%M00", localtime($m->[0]->{start_epoch});
1503	$newprog->{stop} = strftime "%Y%m%d%H%M00", localtime($m->[0]->{stop_epoch});
1504	} else {
1505	$newprog->{start} = $m->[0]->{start};
1506	$newprog->{stop} = $m->[0]->{stop};
1507	}
1508	$newprog->{start_epoch} = $m->[0]->{start_epoch};
1509	$newprog->{stop_epoch} = $m->[0]->{stop_epoch};
1510	$newprog->{channel} = $chan;
1511	$newprog->{title}->[0] = [ $title, $title_lang ];
1512
1513	# add this programme to our title_history
1514	my $title_history_key = sprintf "%d,%d,%s,%s",
1515	$newprog->{start_epoch},
1516	($newprog->{stop_epoch}-$newprog->{start_epoch}),
1517	$newprog->{channel}, $m->[0]->{grabber};
1518	$title_history->{$title_history_key} = $title;
1519
1520	# fill in programme fields and attributes
1521	$newprog->{datasources} = "";
1522	for my $i (0..($num_matching-1)) {
1523	$newprog->{datasources} .= sprintf "%s%d",($newprog->{datasources} ne "" ? "," : ""),$m->[$i]->{grabber_num};
1524
1525	# (1) merge in attributes which are simple scalars
1526	foreach my $field ('date', 'length') {
1527	if ((!defined $newprog->{$field}) &&
1528	(defined $m->[$i]->{$field}) &&
1529	($m->[$i]->{$field} ne "")) {
1530	$newprog->{$field} = $m->[$i]->{$field};
1531	&log($reclogic{debug_add_logic},
1532	(sprintf " - added field %s from #%d (%s) value %s",
1533	$field,$m->[$i]->{grabber_num},$m->[$i]->{grabber},$newprog->{$field}));
1534	}
1535	}
1536
1537	# (2) merge in attributes which are simple arrays
1538	foreach my $field ('url', 'star-rating', 'premiere', 'last-chance', 'language', 'orig-language') {
1539	if (defined $m->[$i]->{$field}) {
1540	my %existing_hash;
1541	my $num_existing = 0;
1542
1543	# pick up existing entries
1544	if (defined $newprog->{$field}) {
1545	my $existing_entries = $newprog->{$field};
1546	foreach my $entry (@$existing_entries) {
1547	$existing_hash{$entry} = 1;
1548	$num_existing++;
1549	}
1550	}
1551
1552	my $new_entries = $m->[$i]->{$field};
1553	foreach my $entry (@$new_entries) {
1554	if ((!defined $existing_hash{$entry}) && ($entry ne "")) {
1555	$existing_hash{$entry} = 1;
1556	$newprog->{$field}->[$num_existing] = $entry;
1557	$num_existing++;
1558
1559	&log($reclogic{debug_add_logic},
1560	(sprintf " - added field %s from #%d (%s) value %s",
1561	$field,$m->[$i]->{grabber_num},$m->[$i]->{grabber},$entry));
1562	}
1563	}
1564	}
1565	}
1566
1567	# (3) merge in attributes which are [val,lang] pairs, [val,val] or [val,val,val]
1568	# note: while 'title' is here, this is simply to pick up titles in any
1569	# additional languages; the primary (preferred) title has already been
1570	# set via the choose_title() routine
1571	foreach my $field ('title', 'sub-title', 'desc', 'category', 'country', 'episode-num', 'rating') {
1572	my $num_added = 0;
1573	my %lang_added;
1574
1575	# pick up existing entries already there
1576	if (defined $newprog->{$field}) {
1577	my $existing_entries = $newprog->{$field};
1578	foreach my $entry (@$existing_entries) {
1579	my $val = $entry->[0];
1580	my $lang = $entry->[1];
1581	$lang = "BLANK" if (!$lang);
1582	push(@{$lang_added{$lang}}, $val);
1583	$num_added++;
1584	}
1585	}
1586
1587	# augment them with any new data
1588	if (defined $m->[$i]->{$field}) {
1589	my $new_entries = $m->[$i]->{$field};
1590	foreach my $entry (@$new_entries) {
1591	my $val = $entry->[0];
1592	my $lang = $entry->[1];
1593
1594	if ($field eq "episode-num") {
1595	$lang = "onscreen" if (!$lang);
1596	} elsif ($field eq "rating") {
1597	$lang = "BLANK" if (!$lang);
1598	} else {
1599	$lang = $opt->{lang} if (!$lang);
1600	}
1601
1602	# special-case for some categories:
1603	# 'premiere' - don't pass it on but instead set premiere field.
1604	# 'en' - (as in language: en) - just strip
1605	# duplicate - just strip
1606	if ($field eq 'category') {
1607	if ($val eq "premiere") {
1608	$newprog->{premiere}->[0] = "premiere" if (!defined $newprog->{premiere});
1609	&log($reclogic{debug_add_logic}," - set 'premiere' because of category");
1610	next;
1611	} elsif ($val eq "en") {
1612	&log($reclogic{debug_add_logic}," - stripped 'en' category");
1613	next;
1614	} elsif (defined $lang_added{$lang} && grep($_ eq $val, @{$lang_added{$lang}})) {
1615	&log($reclogic{debug_add_logic}," - stripped duplicate category");
1616	next;
1617	}
1618	}
1619
1620	# special-case for country:
1621	# duplicate - just strip
1622	if ($field eq 'country') {
1623	if ((defined($lang_added{$lang}) && grep($_ eq $val, @{$lang_added{$lang}})) \|\|
1624	($lang eq $opt->{lang} && defined($lang_added{"BLANK"}) &&
1625	grep($_ eq $val, @{$lang_added{"BLANK"}}))) {
1626	&log($reclogic{debug_add_logic}," - stripped duplicate country");
1627	next;
1628	}
1629	}
1630
1631	if ((!defined $lang_added{$lang}) \|\| ($field eq 'category') \|\| ($field eq 'country')) {
1632	push(@{$lang_added{$lang}}, $val);
1633
1634	$newprog->{$field}->[$num_added]->[0] = $val;
1635
1636	&log($reclogic{debug_add_logic},
1637	(sprintf " - added field %s(%s) from #%d (%s) value %s",
1638	$field,($lang ne "BLANK" ? $lang : ""),$m->[$i]->{grabber_num},$m->[$i]->{grabber},$val));
1639
1640	if ($lang eq "BLANK") {
1641	$newprog->{$field}->[$num_added]->[1] = undef;
1642	} else {
1643	$newprog->{$field}->[$num_added]->[1] = $lang;
1644	}
1645
1646	if ($field eq "rating") {
1647	$newprog->{$field}->[$num_added]->[2] = $entry->[2];
1648	}
1649
1650	$num_added++;
1651	}
1652	}
1653	}
1654	}
1655
1656	# (4) merge in attributes which are {hash}->{hash}->[array]
1657	foreach my $field ('credits') {
1658	foreach my $field2 ('director','actor','writer','adapter','producer','presenter','commentator','guest') {
1659	my $num_added = 0;
1660	my %entries;
1661
1662	# pick up existing entries we already have
1663	if (defined $newprog->{$field}->{$field2}) {
1664	my $existing_entries = $newprog->{$field}->{$field2};
1665	foreach my $entry (@$existing_entries) {
1666	$entries{$entry} = 1;
1667	$num_added++;
1668	}
1669	}
1670
1671	# augment with new data
1672	if (defined $m->[$i]->{$field}->{$field2}) {
1673	my $new_entries = $m->[$i]->{$field}->{$field2};
1674	foreach my $entry (@$new_entries) {
1675	if (($entry ne "") && (!defined $entries{$entry})) {
1676	$newprog->{$field}->{$field2}->[$num_added] = $entry;
1677	$entries{$entry} = 1;
1678	$num_added++;
1679
1680	&log($reclogic{debug_add_logic},
1681	(sprintf " - added field %s/%s from #%d (%s) value %s",
1682	$field,$field2,$m->[$i]->{grabber_num},$m->[$i]->{grabber},$entry));
1683	}
1684	}
1685	}
1686	}
1687	}
1688
1689	# (5) merge in attributes which are by name with no values, or values we don't care to interpret
1690	foreach my $field ('new', 'subtitles', 'previously-shown') {
1691	if ((!defined $newprog->{$field}) && (defined $m->[$i]->{$field})) {
1692	$newprog->{$field} = $m->[$i]->{$field};
1693
1694	&log($reclogic{debug_add_logic},
1695	(sprintf " - added field %s from #%d (%s)",
1696	$field,$m->[$i]->{grabber_num},$m->[$i]->{grabber}));
1697	}
1698	}
1699
1700	# (6) merge in attributes which are {hash}->{hash}=val
1701	foreach my $field ('video', 'audio') {
1702	my %entries;
1703
1704	# pick up existing entries we already have
1705	if (defined $newprog->{$field}) {
1706	my $existing_entries = $newprog->{$field};
1707	foreach my $entry (keys %{$existing_entries}) {
1708	$entries{$entry} = $newprog->{$field}->{$entry};
1709	}
1710	}
1711
1712	# augment with new data
1713	if (defined $m->[$i]->{$field}) {
1714	my $new_entries = $m->[$i]->{$field};
1715	foreach my $entry (keys %{$new_entries}) {
1716	if (($entry ne "") && (!defined $entries{$entry})) {
1717	$newprog->{$field}->{$entry} = $m->[$i]->{$field}->{$entry};
1718	$entries{$entry} = $m->[$i]->{$field}->{$entry};
1719
1720	&log($reclogic{debug_add_logic},
1721	(sprintf " - added field %s from #%d (%s) value %s",
1722	$field,$m->[$i]->{grabber_num},$m->[$i]->{grabber},$entries{$entry}));
1723	}
1724	}
1725	}
1726	}
1727
1728	# ignored attributes:
1729	# icon
1730	}
1731
1732
1733	# (7) XMLTV supports multiple 'categories' but alas mythfilldatabase doesn't
1734	# really support that properly. Ensure that categories called
1735	# 'movie', 'series', 'sports' and 'tvshow' are not listed first
1736	if (defined $newprog->{category}) {
1737	my $num_categories = scalar @{$newprog->{category}};
1738	my $first_category = $newprog->{category}->[0]->[0];
1739	if (($num_categories > 1) &&
1740	(($first_category eq "movie") \|\| ($first_category eq "series") \|\|
1741	($first_category eq "sports") \|\| ($first_category eq "tvshow"))) {
1742	# see if we can switch two around...
1743	for (my $i=1; $i < $num_categories; $i++) {
1744	my $this_cat = $newprog->{category}->[$i]->[0];
1745	if (($this_cat ne "movie") && ($this_cat ne "series") &&
1746	($this_cat ne "sports") && ($this_cat ne "tvshow")) {
1747	$newprog->{category}->[$i]->[0] = $first_category;
1748	$newprog->{category}->[0]->[0] = $this_cat;
1749	&log($reclogic{debug_add_logic},
1750	(sprintf " - set primary category from '%s' to '%s'",
1751	$first_category, $this_cat));
1752	$i = $num_categories;
1753	}
1754	}
1755	}
1756	}
1757
1758
1759	if (defined $out->{$chan}->{$starttime}) {
1760	&log(1,(sprintf "ERROR: already have a programme on channel \"%s\" scheduled for %s! bug!",
1761	$chan, (strftime "%a %e %b %H:%M",localtime($starttime))));
1762	} else {
1763	$out->{$chan}->{$starttime} = $newprog;
1764	$in->{total_progs_out}->{($newprog->{channel})}++;
1765	}
1766	}
1767
1768	######################################################################################################
1769	# remove all programming data for this channel where programming is between start/stop times
1770
1771	sub delete_overlapping_programmes
1772	{
1773	my($chan_id,$del_start,$del_stop) = @_;
1774
1775	&log($reclogic{debug_delete_logic},
1776	(sprintf "delete_overlapping_programmes: called to delete within %s-%s on chan %s",
1777	(strftime "%a%e%b%H:%M", localtime($del_start)), (strftime "%a%e%b%H:%M", localtime($del_stop)),
1778	$in->{channels}->{$chan_id}->{pref_desc}));
1779
1780	# remove programming between $del_start and $del_stop
1781	foreach my $prog_key ( keys %{($in->{tree}->{$chan_id})} ) {
1782	for my $i (0..($in->{tree}->{$chan_id}->{$prog_key}->{numprogs}-1)) {
1783	my $delete_this = 0;
1784	my $prog_start = $in->{tree}->{$chan_id}->{$prog_key}->{progs}->[$i]->{start_epoch};
1785	my $prog_stop = $in->{tree}->{$chan_id}->{$prog_key}->{progs}->[$i]->{stop_epoch};
1786	my $prog_title = $in->{tree}->{$chan_id}->{$prog_key}->{progs}->[$i]->{title}->[0]->[0];
1787	my $prog_grabber = $in->{tree}->{$chan_id}->{$prog_key}->{progs}->[$i]->{grabber_num};
1788
1789	if (($prog_start >= $del_start) && ($prog_stop <= $del_stop)) {
1790	#
1791	# prog entirely within window - delete it
1792	#
1793
1794	$delete_this = 1;
1795	&log($reclogic{debug_delete_logic},
1796	(sprintf " - deleting \"%s\" (%s-%s, grabber %d) - within window",
1797	$prog_title, (strftime "%a%e%b%H:%M", localtime($prog_start)),
1798	(strftime "%a%e%b%H:%M", localtime($prog_stop)), $prog_grabber));
1799	} elsif (($prog_start < $del_start) && ($prog_stop > $del_stop)) {
1800	#
1801	# looks very bogus. starts before our delete window and ends after our delete window.
1802	# there is no "right" action here - try to apply some heuristics
1803	#
1804
1805	if ((($prog_start + $reclogic{delete_window_smaller_than_prog_window_threshold}) >= $del_start) &&
1806	(($prog_stop - $reclogic{delete_window_smaller_than_prog_window_threshold}) <= $del_stop)) {
1807	#
1808	# if programme is within -/+5 minutes (default) for both start/end of delete window
1809	# then delete it
1810	#
1811
1812	$delete_this = 1;
1813	&log($reclogic{debug_delete_logic},
1814	(sprintf " - deleting \"%s\" (%s-%s, grabber %d) - within window +/- delete_window_smaller_than_prog_window_threshold (%d)",
1815	$prog_title, (strftime "%a%e%b%H:%M", localtime($prog_start)),
1816	(strftime "%a%e%b%H:%M", localtime($prog_stop)), $prog_grabber,
1817	$reclogic{delete_window_smaller_than_prog_window_threshold}));
1818	$stats{prog_del_overwindow_close_enough}++;
1819	} else {
1820	#
1821	# rather than deleting it, try to cut back either the stop or bring forward the start
1822	#
1823
1824	my $before_del_start = $del_start - $prog_start;
1825	my $after_del_stop = $prog_stop - $del_stop;
1826
1827	if (($before_del_start <= $reclogic{min_prog_length_for_delete_cutoff}) &&
1828	($after_del_stop <= $reclogic{min_prog_length_for_delete_cutoff})) {
1829	#
1830	# programme would be too short if we did that. delete it
1831	#
1832	$delete_this = 1;
1833	&log($reclogic{debug_delete_logic},
1834	(sprintf " - deleting \"%s\" (%s-%s, grabber %d) - updating start/stop would result in under min_prog_length_for_delete_cutoff (%d)",
1835	$prog_title, (strftime "%a%e%b%H:%M", localtime($prog_start)),
1836	(strftime "%a%e%b%H:%M", localtime($prog_stop)), $prog_grabber,
1837	$reclogic{min_prog_length_for_delete_cutoff}));
1838	$stats{prog_del_overwindow_too_short}++;
1839	} else {
1840	if ($before_del_start > $after_del_stop) {
1841	#
1842	# cut off end
1843	#
1844	&log($reclogic{debug_delete_logic},
1845	(sprintf " - updating \"%s\" (%s-%s, grabber %d) - pulled back stop time because less time after cut window than before (%d before, %d after). prog now %s-%s",
1846	$prog_title, (strftime "%a%e%b%H:%M", localtime($prog_start)),
1847	(strftime "%a%e%b%H:%M", localtime($prog_stop)), $prog_grabber,
1848	$before_del_start, $after_del_stop,
1849	(strftime "%a%e%b%H:%M", localtime($prog_start)),
1850	(strftime "%a%e%b%H:%M", localtime($del_start))));
1851	$in->{tree}->{$chan_id}->{$prog_key}->{progs}->[$i]->{stop_epoch} = $del_start;
1852	$in->{tree}->{$chan_id}->{$prog_key}->{progs}->[$i]->{stop} = strftime "%Y%m%d%H%M",localtime($del_start);
1853	$stats{prog_del_overwindow_cut_end}++;
1854	} else {
1855	#
1856	# cut off beginning
1857	#
1858	&log($reclogic{debug_delete_logic},
1859	(sprintf " - updating \"%s\" (%s-%s, grabber %d) - pushed forward start time because less time before cut window than after (%d before, %d after). prog now %s-%s",
1860	$prog_title, (strftime "%a%e%b%H:%M", localtime($prog_start)),
1861	(strftime "%a%e%b%H:%M", localtime($prog_stop)), $prog_grabber,
1862	$before_del_start, $after_del_stop,
1863	(strftime "%a%e%b%H:%M", localtime($del_stop)),
1864	(strftime "%a%e%b%H:%M", localtime($prog_stop))));
1865	$in->{tree}->{$chan_id}->{$prog_key}->{progs}->[$i]->{start_epoch} = $del_stop;
1866	$in->{tree}->{$chan_id}->{$prog_key}->{progs}->[$i]->{start} = strftime "%Y%m%d%H%M",localtime($del_stop);
1867	$stats{prog_del_overwindow_culled_start}++;
1868	}
1869	}
1870	}
1871	} elsif (($prog_start < $del_stop) && ($prog_stop > $del_stop)) {
1872	#
1873	# programme starts within window but ends outside of it.
1874	#
1875	if (($del_stop - $prog_start) > $reclogic{max_prog_length_for_rejig}) {
1876	# would cut off too much programme - delete it
1877	$delete_this = 1;
1878	&log($reclogic{debug_delete_logic},
1879	(sprintf " - deleting \"%s\" (%s-%s, grabber %d) - updating start would lose more than max_prog_length_for_rejig (%d)",
1880	$prog_title, (strftime "%a%e%b%H:%M", localtime($prog_start)),
1881	(strftime "%a%e%b%H:%M", localtime($prog_stop)), $prog_grabber,
1882	$reclogic{max_prog_length_for_rejig}));
1883	$stats{prog_del_too_much_culled_from_start}++;
1884	} else {
1885	&log($reclogic{debug_delete_logic},
1886	(sprintf " - updating \"%s\" (%s-%s, grabber %d) - pushed forward start time because under max_prog_length_for_rejig (%d). prog now %s-%s",
1887	$prog_title, (strftime "%a%e%b%H:%M", localtime($prog_start)),
1888	(strftime "%a%e%b%H:%M", localtime($prog_stop)), $prog_grabber,
1889	$reclogic{max_prog_length_for_rejig},
1890	(strftime "%a%e%b%H:%M", localtime($del_stop)),
1891	(strftime "%a%e%b%H:%M", localtime($prog_stop))));
1892	$in->{tree}->{$chan_id}->{$prog_key}->{progs}->[$i]->{start_epoch} = $del_stop;
1893	$in->{tree}->{$chan_id}->{$prog_key}->{progs}->[$i]->{start} = strftime "%Y%m%d%H%M",localtime($del_stop);
1894	$stats{prog_del_start_cull_ok}++;
1895	}
1896	} elsif (($prog_start < $del_start) && ($prog_stop > $del_start)) {
1897	#
1898	# programme starts outside window but ends within it.
1899	#
1900	if (($prog_stop - $del_start) > $reclogic{max_prog_length_for_rejig}) {
1901	# would cut off too much programme - delete it
1902	$delete_this = 1;
1903	&log($reclogic{debug_delete_logic},
1904	(sprintf " - deleting \"%s\" (%s-%s, grabber %d) - updating stop would lose more than max_prog_length_for_rejig (%d)",
1905	$prog_title, (strftime "%a%e%b%H:%M", localtime($prog_start)),
1906	(strftime "%a%e%b%H:%M", localtime($prog_stop)), $prog_grabber,
1907	$reclogic{max_prog_length_for_rejig}));
1908	$stats{prog_del_too_much_cut_from_end}++;
1909	} else {
1910	&log($reclogic{debug_delete_logic},
1911	(sprintf " - updating \"%s\" (%s-%s, grabber %d) - pulled back stop time due to under max_prog_length_for_rejig (%d). prog now %s-%s",
1912	$prog_title, (strftime "%a%e%b%H:%M", localtime($prog_start)),
1913	(strftime "%a%e%b%H:%M", localtime($prog_stop)), $prog_grabber,
1914	$reclogic{max_prog_length_for_rejig},
1915	(strftime "%a%e%b%H:%M", localtime($prog_start)),
1916	(strftime "%a%e%b%H:%M", localtime($del_start))));
1917	$in->{tree}->{$chan_id}->{$prog_key}->{progs}->[$i]->{stop_epoch} = $del_start;
1918	$in->{tree}->{$chan_id}->{$prog_key}->{progs}->[$i]->{stop} = strftime "%Y%m%d%H%M",localtime($del_start);
1919	$stats{prog_del_end_cut_ok}++;
1920	}
1921	}
1922
1923	if ($delete_this) {
1924	delete $in->{tree}->{$chan_id}->{$prog_key}->{progs}->[$i];
1925	$in->{tree}->{$chan_id}->{$prog_key}->{numprogs}--;
1926	$in->{total_progs}->{$chan_id}--;
1927	$i--;
1928	}
1929	}
1930
1931	# if no progs left in group, delete entire group
1932	if ($in->{tree}->{$chan_id}->{$prog_key}->{numprogs} == 0) {
1933	# delete entire group
1934	delete $in->{tree}->{$chan_id}->{$prog_key};
1935	}
1936	}
1937	}
1938
1939	######################################################################################################
1940	# when given multiple programmes matching same timeslot, compare titles of them to see if
1941	# they are the same programme.
1942	# - if the same programme, insert them.
1943	# - if different programmes, select our preferred one to insert.
1944
1945	sub find_prog_to_add
1946	{
1947	my ($chan_id,$numprogs,$log_check_matching,$prog_list) = @_;
1948
1949	#
1950	# find out what titles match, store results
1951	#
1952
1953	&log($reclogic{debug_find_prog_to_add},
1954	(sprintf "find_prog_to_add: slot on channel %s has %d programmes to choose from.",
1955	$chan_id,$numprogs));
1956
1957	my @match_count;
1958	my $data_match;
1959	my $highest_num_matches_slot = 0;
1960
1961	for my $i (0..($numprogs-2)) {
1962	my $primary_title = $prog_list->[$i]{title}->[0]->[0];
1963	$match_count[$i] = 0;
1964
1965	for my $j ($i+1..($numprogs-1)) {
1966	# skip if we're comparing titles from the same grabber
1967	next if ($prog_list->[$i]->{grabber} eq $prog_list->[$j]->{grabber});
1968
1969	my $compare_title = $prog_list->[$j]->{title}->[0]->[0];
1970	if (canonicalizeTitles_match($primary_title, $compare_title)) {
1971	$data_match->[$i]->[$j] = 1;
1972	$data_match->[$j]->[$i] = 1;
1973	$match_count[$i]++;
1974	$match_count[$j]++;
1975	}
1976	}
1977
1978	$highest_num_matches_slot = $i if ($match_count[$i] > $match_count[$highest_num_matches_slot]);
1979	}
1980
1981	$match_count[0] = 0 if $numprogs < 2;
1982
1983	&log($reclogic{debug_find_prog_to_add},
1984	(sprintf "find_prog_to_add: grabber %d wins for this slot with %d matches.",
1985	$highest_num_matches_slot,$match_count[$highest_num_matches_slot]));
1986
1987	my $matching_progs, my $num_matching_progs = 1;
1988	if ($match_count[$highest_num_matches_slot] == 0) {
1989	my $prog = $prog_list->[0];
1990	if (($numprogs > 1) && ($log_check_matching)) {
1991	#
1992	# no data matched - log this for further inspection
1993	#
1994	my $alternate_titles = sprintf " channel %s %s - %s, (used grabber %d %s)\n",
1995	$in->{channels}->{$chan_id}->{pref_desc},
1996	(strftime "%a %e %b %H:%M",localtime(($prog->{start_epoch}))),
1997	(strftime "%a %e %b %H:%M",localtime(($prog->{stop_epoch}))),
1998	$prog->{grabber_num},$prog->{grabber};
1999
2000	for my $i (0..($numprogs-1)) {
2001	my $this_prog = $prog_list->[$i];
2002	$alternate_titles .= sprintf " #%d. \"%s\" {src %s}\n",
2003	$this_prog->{grabber_num}, $this_prog->{title}->[0]->[0], $this_prog->{grabber};
2004	}
2005
2006	&log($reclogic{debug_show_nonmatching_title_alternatives}, $alternate_titles);
2007
2008	$alternate_titles .= "\n";
2009	$in->{alt_title_mismatches} .= $alternate_titles;
2010	}
2011
2012	# add entry from our preferred grabber
2013	$matching_progs->[0] = $prog;
2014	} else {
2015	# add entry from our multiple grabbers
2016	$stats{rec_start_stop_title_match}++;
2017	$matching_progs->[0] = $prog_list->[$highest_num_matches_slot];
2018	my $primary_title = $matching_progs->[0]->{title}->[0]->[0];
2019	&log($reclogic{debug_find_prog_to_add},(sprintf "find_prog_to_add: \"%s\" selected data from grabber %d (%s)",
2020	$primary_title, $highest_num_matches_slot, $matching_progs->[0]->{grabber}));
2021	for my $i (0..($numprogs-1)) {
2022	if ($data_match->[$highest_num_matches_slot]->[$i]) {
2023	$matching_progs->[$num_matching_progs] = $prog_list->[$i];
2024	my $this_title = $matching_progs->[$num_matching_progs]->{title}->[0]->[0];
2025
2026	&log($reclogic{debug_find_prog_to_add},
2027	(sprintf "find_prog_to_add: - augmenting with data from \"%s\" grabber %d (%s)",
2028	$this_title, $i, $matching_progs->[$num_matching_progs]->{grabber}));
2029
2030	$num_matching_progs++;
2031	}
2032	}
2033	}
2034
2035	my ($title, $title_lang) = &choose_title($num_matching_progs,$matching_progs);
2036	&add_one_programme($chan_id,$title,$title_lang,$num_matching_progs,$matching_progs);
2037
2038	# remove all programming data for this channel which overlaps with this (inserted) programme
2039	&delete_overlapping_programmes($chan_id,$matching_progs->[0]->{start_epoch},$matching_progs->[0]->{stop_epoch});
2040	}
2041
2042	######################################################################################################
2043
2044	sub reconcile
2045	{
2046
2047	#
2048	# loop through channels
2049	# (chan_id)
2050	#
2051
2052	foreach my $chan_id (sort keys %{($in->{channels})}) {
2053	my $this_chan = $in->{channels}->{$chan_id};
2054
2055	#
2056	# (1) look for programmes within the same timeslot
2057	# if at least 2 grabbers say a programme starts/ends at the
2058	# same time & have a similar title, use that
2059	#
2060
2061	&log($reclogic{debug_reconcile},
2062	(sprintf "reconcile: channel '%s': pass 1: %d programmes remaining",
2063	$in->{channels}->{$chan_id}->{pref_desc}, $in->{total_progs}->{$chan_id}));
2064
2065	# 1a. gather up programming timeslots
2066	foreach my $prog_key (
2067	sort { $in->{tree}->{$chan_id}->{$a}->{numprogs} <=> $in->{tree}->{$chan_id}->{$b}->{numprogs} }
2068	keys %{($in->{tree}->{$chan_id})} ) {
2069	next if (!defined $in->{tree}->{$chan_id}->{$prog_key});
2070	my $num_progs_in_slot = $in->{tree}->{$chan_id}->{$prog_key}->{numprogs};
2071
2072	# 1b. at least 2 programs in the same timeslot - try to add it if titles match
2073	if ($num_progs_in_slot > 1) {
2074	my $this_prog_start = $in->{tree}->{$chan_id}->{$prog_key}->{progs}->[0]->{start_epoch};
2075	my $this_prog_stop = $in->{tree}->{$chan_id}->{$prog_key}->{progs}->[0]->{stop_epoch};
2076
2077	&log($reclogic{debug_reconcile_pass1},
2078	(sprintf "reconcile: %d programs between %s - %s",
2079	$num_progs_in_slot, (strftime "%a%e%b%H:%M",localtime($this_prog_start)),
2080	(strftime "%a%e%b%H:%M",localtime($this_prog_stop))));
2081
2082	$stats{rec_start_stop_match}++;
2083	&find_prog_to_add($chan_id,$num_progs_in_slot,1,$in->{tree}->{$chan_id}->{$prog_key}->{progs});
2084	}
2085	}
2086
2087	#
2088	# (2) look for programmes within similar (but not exact) timeslots
2089	# but with same name. use timeslot from the "higher preference"
2090	# grabber
2091	#
2092
2093	my $done = 0, my $preferred_grabber = 0;
2094	while (($in->{total_progs}->{$chan_id} > 0) && (!$done)) {
2095	&log($reclogic{debug_reconcile},
2096	(sprintf "reconcile: channel '%s': pass 2: %d programmes remaining, preferring grabber %d",
2097	$in->{channels}->{$chan_id}->{pref_desc}, $in->{total_progs}->{$chan_id}, $preferred_grabber));
2098
2099	# 2a. find first programme from preferred grabber
2100	my @prog_keys = sort { $in->{tree}->{$chan_id}->{$a} <=> $in->{tree}->{$chan_id}->{$b} } keys %{($in->{tree}->{$chan_id})};
2101	foreach my $prog_key (@prog_keys) {
2102	next if (!defined $in->{tree}->{$chan_id}->{$prog_key});
2103	next if ($in->{tree}->{$chan_id}->{$prog_key}->{numprogs} == 0);
2104	next if ($in->{tree}->{$chan_id}->{$prog_key}->{progs}->[0]->{grabber_num} != $preferred_grabber);
2105
2106	# got a programme from our preferred grabber
2107	my $found_prog = $in->{tree}->{$chan_id}->{$prog_key}->{progs}->[0];
2108	my $start_window = $found_prog->{start_epoch} - $reclogic{fuzzy_match_title_time_window};
2109	my $stop_window = $found_prog->{start_epoch} + $reclogic{fuzzy_match_title_time_window};
2110
2111	my $matched_progs;
2112	$matched_progs->[0] = $found_prog;
2113	my $num_matched_progs = 1;
2114
2115	&log($reclogic{debug_reconcile_pass2},
2116	(sprintf "reconcile: (%d to go) chose programme for %s-%s: \"%s\", looking for alternatives between %s-%s",
2117	$in->{total_progs}->{$chan_id},
2118	(strftime "%a%e%b%H:%M",localtime($found_prog->{start_epoch})),
2119	(strftime "%a%e%b%H:%M",localtime($found_prog->{stop_epoch})), $found_prog->{title}->[0]->[0],
2120	(strftime "%a%e%b%H:%M",localtime($start_window)),
2121	(strftime "%a%e%b%H:%M",localtime($stop_window))));
2122
2123	foreach my $prog_key2 ( sort { $in->{tree}->{$chan_id}->{$a} <=> $in->{tree}->{$chan_id}->{$b} } keys %{($in->{tree}->{$chan_id})} ) {
2124	next if ($in->{tree}->{$chan_id}->{$prog_key}->{progs}->[0]->{grabber_num} != $preferred_grabber);
2125	next if ($prog_key2 eq $prog_key);
2126
2127	my $numprogs = $in->{tree}->{$chan_id}->{$prog_key2}->{numprogs};
2128	for my $i (0..($numprogs-1)) {
2129	my $check_prog = $in->{tree}->{$chan_id}->{$prog_key2}->{progs}->[$i];
2130
2131	# match programmes which _start_ within the timewindow (but not necessarily end!)
2132	if (($check_prog->{start_epoch} >= $start_window) && ($check_prog->{start_epoch} < $stop_window)) {
2133	$matched_progs->[$num_matched_progs] = $check_prog;
2134	$num_matched_progs++;
2135
2136	&log($reclogic{debug_reconcile_pass2},
2137	(sprintf "reconcile: found alternative prog: %s-%s, \"%s\"",
2138	(strftime "%a%e%b%H:%M",localtime($check_prog->{start_epoch})),
2139	(strftime "%a%e%b%H:%M",localtime($check_prog->{stop_epoch})),
2140	$check_prog->{title}->[0]->[0]));
2141	}
2142	}
2143	}
2144
2145	&find_prog_to_add($chan_id,$num_matched_progs,0,$matched_progs);
2146	}
2147
2148	&log($reclogic{debug_reconcile},
2149	(sprintf "reconcile: still have %d programmes left, switching preferred grabbers",
2150	$in->{total_progs}->{$chan_id}))
2151	if ($in->{total_progs}->{$chan_id} > 0);
2152
2153	$preferred_grabber++;
2154	$done = 1 if ($preferred_grabber == $in->{num_datafiles});
2155	}
2156
2157	&log(1,(sprintf "reconciled \"%s\" (%s) %d input -> %d output programmes",
2158	$in->{channels}->{$chan_id}->{pref_desc}, $chan_id, $in->{total_progs_in}->{$chan_id}, $in->{total_progs_out}->{$chan_id}));
2159	}
2160	}

Note: See TracBrowser for help on using the browser.

Context Navigation

root/trunk/reconcilers/reconciler_mk2

Download in other formats: