1# -*- mode: perl; coding: utf-8 -*- ###########################################
2#
3# tv_grab_fi: programme class
4#
5###############################################################################
6#
7# Setup
8#
9# VERSION: $Id: programme.pm,v 2.10 2016/08/20 16:55:13 stefanb2 Exp $
10#
11# INSERT FROM HERE ############################################################
12package fi::programme;
13use strict;
14use warnings;
15use Carp;
16use POSIX qw(strftime);
17
18# Import from internal modules
19fi::common->import();
20
21sub _trim {
22  return unless defined($_[0]);
23  $_[0] =~ s/^\s+//;
24  $_[0] =~ s/\s+$//;
25}
26
27# Constructor
28sub new {
29  my($class, $channel, $language, $title, $start, $stop) = @_;
30  _trim($title);
31  croak "${class}::new called without valid title or start"
32    unless defined($channel) && defined($title) && (length($title) > 0) &&
33           defined($start);
34
35  my $self = {
36	      channel  => $channel,
37	      language => $language,
38	      title    => $title,
39	      start    => $start,
40	      stop     => $stop,
41	     };
42
43  return(bless($self, $class));
44}
45
46# instance methods
47sub category {
48  my($self, $category) = @_;
49  _trim($category);
50  $self->{category} = $category
51    if defined($category) && length($category);
52}
53sub description {
54  my($self, $description) = @_;
55  _trim($description);
56  $self->{description} = $description
57    if defined($description) && length($description);
58}
59sub episode {
60  my($self, $episode, $language) = @_;
61  _trim($episode);
62  if (defined($episode) && length($episode)) {
63    $episode =~ s/\.$//;
64    push(@{ $self->{episode} }, [$episode, $language]);
65  }
66}
67sub season_episode {
68  my($self, $season, $episode) = @_;
69  # only accept a pair of valid, positive integers
70  if (defined($season) && defined($episode)) {
71    $season  = int($season);
72    $episode = int($episode);
73    if (($season  > 0) && ($episode > 0)) {
74      $self->{season}         = $season;
75      $self->{episode_number} = $episode;
76    }
77  }
78}
79sub start {
80  my($self, $start) = @_;
81  $self->{start} = $start
82    if defined($start) && length($start);
83  $start = $self->{start};
84  croak "${self}::start: object without valid start time"
85    unless defined($start);
86  return($start);
87}
88sub stop {
89  my($self, $stop) = @_;
90  $self->{stop} = $stop
91    if defined($stop) && length($stop);
92  $stop = $self->{stop};
93  croak "${self}::stop: object without valid stop time"
94    unless defined($stop);
95  return($stop);
96}
97
98# read-only
99sub language { $_[0]->{language} }
100sub title    { $_[0]->{title}    }
101
102# Convert seconds since Epoch to XMLTV time stamp
103#
104# NOTE: We have to generate the time stamp using local time plus time zone as
105#       some XMLTV users, e.g. mythtv in the default configuration, ignore the
106#       XMLTV time zone value.
107#
108sub _epoch_to_xmltv_time($) {
109  my($time) = @_;
110
111  # Unfortunately strftime()'s %z is not portable...
112  #
113  # return(strftime("%Y%m%d%H%M%S %z", localtime($time));
114  #
115  # ...so we have to roll our own:
116  #
117  my @time = localtime($time); #               is_dst
118  return(strftime("%Y%m%d%H%M%S +0", @time) . ($time[8] ? "3": "2") . "00");
119}
120
121# Configuration data
122my %series_description;
123my %series_title;
124my @title_map;
125my $title_strip_parental;
126
127# Common regular expressions
128# ($left, $special, $right) = ($description =~ $match_description)
129my $match_description = qr/^\s*([^.!?]+[.!?])([.!?]+\s+)?\s*(.*)/;
130
131sub dump {
132  my($self, $writer) = @_;
133  my $language    = $self->{language};
134  my $title       = $self->{title};
135  my $category    = $self->{category};
136  my $description = $self->{description};
137  my $episode     = $self->{episode_number};
138  my $season      = $self->{season};
139  my $subtitle    = $self->{episode};
140
141  #
142  # Programme post-processing
143  #
144  # Parental level removal (catch also the duplicates)
145  $title =~ s/(?:\s+\((?:S|T|7|9|12|16|18)\))+\s*$//
146      if $title_strip_parental;
147  #
148  # Title mapping
149  #
150  foreach my $map (@title_map) {
151    if ($map->($title)) {
152      debug(3, "XMLTV title '$self->{title}' mapped to '$title'");
153      last;
154    }
155  }
156
157  #
158  # Check 1: object already contains episode
159  #
160  my($left, $special, $right);
161  if (defined($subtitle)) {
162    # nothing to be done
163  }
164  #
165  # Check 2: title contains episode name
166  #
167  # If title contains a colon (:), check to see if the string on the left-hand
168  # side of the colon has been defined as a series in the configuration file.
169  # If it has, assume that the string on the left-hand side of the colon is
170  # the name of the series and the string on the right-hand side is the name
171  # of the episode.
172  #
173  # Example:
174  #
175  #   config: series title Prisma
176  #   title:  Prisma: Totuus tappajadinosauruksista
177  #
178  # This will generate a program with
179  #
180  #   title:     Prisma
181  #   sub-title: Totuus tappajadinosauruksista
182  #
183  elsif ((($left, $right) = ($title =~ /([^:]+):\s*(.*)/)) &&
184	 (exists $series_title{$left})) {
185    debug(3, "XMLTV series title '$left' episode '$right'");
186    ($title, $subtitle) = ($left, $right);
187  }
188  #
189  # Check 3: description contains episode name
190  #
191  # Check if the program has a description. If so, also check if the title
192  # of the program has been defined as a series in the configuration. If it
193  # has, assume that the first sentence (i.e. the text before the first
194  # period, question mark or exclamation mark) marks the name of the episode.
195  #
196  # Example:
197  #
198  #   config:      series description Batman
199  #   description: Pingviinin paluu. Amerikkalainen animaatiosarja....
200  #
201  # This will generate a program with
202  #
203  #   title:       Batman
204  #   sub-title:   Pingviinin paluu
205  #   description: Amerikkalainen animaatiosarja....
206  #
207  # Special cases
208  #
209  #   text:        Pingviinin paluu?. Amerikkalainen animaatiosarja....
210  #   sub-title:   Pingviinin paluu?
211  #   description: Amerikkalainen animaatiosarja....
212  #
213  #   text:        Pingviinin paluu... Amerikkalainen animaatiosarja....
214  #   sub-title:   Pingviinin paluu...
215  #   description: Amerikkalainen animaatiosarja....
216  #
217  #   text:        Pingviinin paluu?!? Amerikkalainen animaatiosarja....
218  #   sub-title:   Pingviinin paluu?!?
219  #   description: Amerikkalainen animaatiosarja....
220  #
221  elsif ((defined($description))              &&
222	 (exists $series_description{$title}) &&
223	 (($left, $special, $right) = ($description =~ $match_description))) {
224    my $desc_subtitle;
225
226    # Check for "Kausi <season>, osa <episode>. <maybe sub-title>...."
227    if (my($desc_season, $desc_episode, $remainder) =
228	($description =~ m/^Kausi\s+(\d+),\s+osa\s+(\d+)\.\s*(.*)$/)) {
229	$season  = $desc_season;
230	$episode = $desc_episode;
231
232	# Repeat the above match on remaining description
233	($left, $special, $right) = ($remainder =~ $match_description);
234
235	# Take a guess if we have a episode title in description or not
236	my $words;
237	$words++ while $left =~ /\S+/g;
238	if ($words > 5) {
239	    # More than 5 words probably means no episode title
240	    undef $left;
241	    undef $special;
242	    $right = $remainder;
243	}
244
245    # Check for "Kausi <season>. Jakso <episode>/<# of episodes>. <sub-title>...."
246    } elsif (($desc_season, $desc_episode, $remainder) =
247	($description =~ m,^Kausi\s+(\d+)\.\s+Jakso\s+(\d+)(?:/\d+)?\.\s*(.*)$,)) {
248	$season  = $desc_season;
249	$episode = $desc_episode;
250
251	# Repeat the above match on remaining description
252	($left, $special, $right) = ($remainder =~ $match_description);
253
254    # Check for "Kausi <season>, <episode>/<# of episodes>. <sub-title>...."
255    } elsif (($desc_season, $desc_episode, $remainder) =
256	($description =~ m!^Kausi\s+(\d+),\s+(\d+)(?:/\d+)?\.\s*(.*)$!)) {
257	$season  = $desc_season;
258	$episode = $desc_episode;
259
260	# Repeat the above match on remaining description
261	($left, $special, $right) = ($remainder =~ $match_description);
262
263    # Check for "<sub-title>. Kausi <season>, (jakso )?<episode>/<# of episodes>...."
264    } elsif (($desc_subtitle, $desc_season, $desc_episode, $remainder) =
265	     ($description =~ m!^(.+)\s+Kausi\s+(\d+),\s+(?:jakso\s+)?(\d+)(?:/\d+)?\.\s*(.*)$!)) {
266	$left    = $desc_subtitle;
267	$season  = $desc_season;
268	$episode = $desc_episode;
269
270	# Remainder is already the final episode description
271	$right = $remainder;
272	undef $special;
273    }
274    if (defined($left)) {
275	unless (defined($special)) {
276	    # We only remove period from episode title, preserve others
277	    $left =~ s/\.$//;
278	} elsif (($left    !~ /\.$/) &&
279		 ($special =~ /^\.\s/)) {
280	    # Ignore extraneous period after sentence
281	} else {
282	    # Preserve others, e.g. ellipsis
283	    $special =~ s/\s+$//;
284	    $left    .= $special;
285	}
286	debug(3, "XMLTV series title '$title' episode '$left'");
287    }
288    ($subtitle, $description) = ($left, $right);
289  }
290
291  # XMLTV programme desciptor (mandatory parts)
292  my %xmltv = (
293	       channel => $self->{channel},
294	       start   => _epoch_to_xmltv_time($self->{start}),
295	       stop    => _epoch_to_xmltv_time($self->{stop}),
296	       title   => [[$title, $language]],
297	      );
298  debug(3, "XMLTV programme '$xmltv{channel}' '$xmltv{start} -> $xmltv{stop}' '$title'");
299
300  # XMLTV programme descriptor (optional parts)
301  if (defined($subtitle)) {
302    $subtitle = [[$subtitle, $language]]
303      unless ref($subtitle);
304    $xmltv{'sub-title'} = $subtitle;
305    debug(3, "XMLTV programme episode ($_->[1]): $_->[0]")
306      foreach (@{ $xmltv{'sub-title'} });
307  }
308  if (defined($category) && length($category)) {
309    $xmltv{category} = [[$category, $language]];
310    debug(4, "XMLTV programme category: $category");
311  }
312  if (defined($description) && length($description)) {
313    $xmltv{desc} = [[$description, $language]];
314    debug(4, "XMLTV programme description: $description");
315  }
316  if (defined($season) && defined($episode)) {
317    $xmltv{'episode-num'} =  [[ ($season - 1) . '.' . ($episode - 1) . '.', 'xmltv_ns' ]];
318    debug(4, "XMLTV programme season/episode: $season/$episode");
319  }
320
321  $writer->write_programme(\%xmltv);
322}
323
324# class methods
325# Parse config line
326sub parseConfigLine {
327  my($class, $line) = @_;
328
329  # Extract words
330  my($command, $keyword, $param) = split(' ', $line, 3);
331
332  if ($command eq "series") {
333    if ($keyword eq "description") {
334      $series_description{$param}++;
335    } elsif ($keyword eq "title") {
336      $series_title{$param}++;
337    } else {
338      # Unknown series configuration
339      return;
340    }
341  } elsif ($command eq "title") {
342      if (($keyword eq "map") &&
343	  # Accept "title" and 'title' for each parameter
344	  (my(undef, $from, undef, $to) =
345	   ($param =~ /^([\'\"])([^\1]+)\1\s+([\'\"])([^\3]+)\3/))) {
346	  debug(3, "title mapping from '$from' to '$to'");
347	  $from = qr/^\Q$from\E/;
348	  push(@title_map, sub { $_[0] =~ s/$from/$to/ });
349      } elsif (($keyword eq "strip") &&
350	       ($param   =~ /parental\s+level/)) {
351	  debug(3, "stripping parental level from titles");
352	  $title_strip_parental++;
353      } else {
354	  # Unknown title configuration
355	  return;
356      }
357  } else {
358    # Unknown command
359    return;
360  }
361
362  return(1);
363}
364
365# Fix overlapping programmes
366sub fixOverlaps {
367  my($class, $list) = @_;
368
369  # No need to cleanup empty/one-entry lists
370  return unless defined($list) && (@{ $list } >= 2);
371
372  my $current = $list->[0];
373  foreach my $next (@{ $list }[1..$#{ $list }]) {
374
375    # Does next programme start before current one ends?
376    if ($current->{stop} > $next->{start}) {
377      debug(3, "Fixing overlapping programme '$current->{title}' $current->{stop} -> $next->{start}.");
378      $current->{stop} = $next->{start};
379    }
380
381    # Next programme
382    $current = $next;
383  }
384}
385
386# That's all folks
3871;
388