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