1# -*- mode: perl; coding: utf-8 -*- ###########################################
2#
3# tv_grab_fi: source specific grabber code for http://www.telkku.com
4#
5###############################################################################
6#
7# Setup
8#
9# VERSION: $Id: telkku.pm,v 2.06 2016/08/20 16:55:13 stefanb2 Exp $
10#
11# INSERT FROM HERE ############################################################
12package fi::source::telkku;
13use strict;
14use warnings;
15use Date::Manip qw(UnixDate);
16use JSON qw();
17
18BEGIN {
19  our $ENABLED = 1;
20}
21
22# Import from internal modules
23fi::common->import();
24fi::programmeStartOnly->import();
25
26# Description
27sub description { 'telkku.com' }
28
29my %categories = (
30  SPORTS => "urheilu",
31  MOVIE  => "elokuvat",
32);
33
34# Fetch raw HTML and extract & parse JSON
35sub _getJSON($$$) {
36  my($date, $page, $keys) = @_;
37
38  # Fetch raw text
39  my $text = fetchRaw("http://www.telkku.com/tv-ohjelmat/$date/patch/koko-paiva");
40  if ($text) {
41    #
42    # All data is encoded in JSON in a script node
43    #
44    # <script>
45    #    window.__INITIAL_STATE__ = {...};
46    # </script>
47    #
48    my($match) = ($text =~ /window.__INITIAL_STATE__ = ({.+});/);
49
50    if ($match) {
51      my $decoded = JSON->new->decode($match);
52
53      if (ref($decoded) eq "HASH") {
54	my $data = $decoded;
55
56        #debug(5, JSON->new->pretty->encode($decoded));
57
58	# step through hashes using key sequence
59	foreach my $key (@{$keys}) {
60	  debug(5, "Looking for JSON key $key");
61	  return unless exists $data->{$key};
62	  $data = $data->{$key};
63	}
64	debug(5, "Found JSON data");
65
66	#debug(5, JSON->new->pretty->encode($data));
67	#debug(5, "KEYS: ", join(", ", sort keys %{$data}));
68	return($data);
69      }
70    }
71  }
72
73  return;
74}
75
76# Grab channel list
77sub channels {
78
79  # Fetch & extract JSON sub-part
80  my $data = _getJSON("tanaan", "peruskanavat",
81		      ["channelGroups",
82		       "channelGroupsArray"]);
83
84  #
85  # Channels data has the following structure
86  #
87  #  [
88  #    {
89  #      slug     => "peruskanavat",
90  #      channels => [
91  #                    {
92  #                      id   => "yle-tv1",
93  #                      name => "Yle TV1",
94  #                      ...
95  #                    },
96  #                    ...
97  #                  ],
98  #      ...
99  #    },
100  #    ...
101  #  ]
102  #
103  if (ref($data) eq "ARRAY") {
104    my %channels;
105    my %duplicates;
106
107    foreach my $item (@{$data}) {
108      if ((ref($item)             eq "HASH")  &&
109	  (exists $item->{slug})              &&
110	  (exists $item->{channels})          &&
111	  (ref($item->{channels}) eq "ARRAY")) {
112	my $group    = $item->{slug};
113	my $channels = $item->{channels};
114
115	if (defined($group) && length($group) &&
116	    (ref($channels) eq "ARRAY")) {
117	  debug(2, "Source telkku.com found group '$group' with " . scalar(@{$channels}) . " channels");
118
119	  foreach my $channel (@{$channels}) {
120	    if (ref($channel) eq "HASH") {
121	      my $id   = $channel->{id};
122	      my $name = $channel->{name};
123
124	      if (defined($id) && length($id)   &&
125		  (not exists $duplicates{$id}) &&
126		  length($name)) {
127		debug(3, "channel '$name' ($id)");
128		$channels{"${id}.${group}.telkku.com"} = "fi $name";
129
130		# Same ID can appear in multiple groups - avoid duplicates
131		$duplicates{$id}++;
132	      }
133	    }
134	  }
135	}
136      }
137    }
138
139    debug(2, "Source telkku.com parsed " . scalar(keys %channels) . " channels");
140    return(\%channels);
141  }
142
143  return;
144}
145
146# Grab one day
147sub grab {
148  my($self, $id, $yesterday, $today, $tomorrow, $offset) = @_;
149
150  # Get channel number from XMLTV id
151  return unless my($channel, $group) = ($id =~ /^([\w-]+)\.(\w+)\.telkku\.com$/);
152
153  # Fetch & extract JSON sub-part
154  my $data = _getJSON($today, $group,
155		      ["offeringByChannelGroup",
156		       $group,
157		       "offering",
158		       "publicationsByChannel"]);
159
160  #
161  # Programme data has the following structure
162  #
163  #  [
164  #    {
165  #      channel      => {
166  #                        id => "yle-tv1",
167  #                        ...
168  #                      },
169  #      publications => [
170  #                        {
171  #                           startTime     => "2016-08-18T06:25:00.000+03:00",
172  #                           endTime       => "2016-08-18T06:55:00.000+03:00",
173  #                           title         => "Helil kyläs",
174  #                           description   => "Osa 9/10. Asiaohjelma, mikä ...",
175  #                           programFormat => "MOVIE",
176  #                           ...
177  #                        },
178  #                        ...
179  #                      ]
180  #    },
181  #    ...
182  #  ]
183  #
184  if (ref($data) eq "ARRAY") {
185    my @objects;
186
187    foreach my $item (@{$data}) {
188      if ((ref($item)                 eq "HASH")  &&
189	  (ref($item->{channel})      eq "HASH")  &&
190	  (ref($item->{publications}) eq "ARRAY") &&
191	  ($item->{channel}->{id} eq $channel)) {
192
193	foreach my $programme (@{$item->{publications}}) {
194	   my($start, $end, $title, $desc) =
195	     @{$programme}{qw(startTime endTime title description)};
196
197	   #debug(5, JSON->new->pretty->encode($programme));
198
199	   if ($start && $end && $title && $desc) {
200             $start = UnixDate($start, "%s");
201	     $end   = UnixDate($end,   "%s");
202
203	     # NOTE: entries with same start and end time are invalid
204	     if ($start && $end && ($start != $end)) {
205	       my $category = $categories{$programme->{programFormat}};
206
207	       debug(3, "List entry $channel.$group ($start -> $end) $title");
208	       debug(4, $desc);
209	       debug(4, $category) if defined $category;
210
211	       # Create program object
212	       my $object = fi::programme->new($id, "fi", $title, $start, $end);
213	       $object->category($category);
214	       $object->description($desc);
215	       push(@objects, $object);
216	     }
217	   }
218	}
219      }
220    }
221
222    # Fix overlapping programmes
223    fi::programme->fixOverlaps(\@objects);
224
225    return(\@objects);
226  }
227
228  return;
229}
230
231# That's all folks
2321;
233