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