view release on metacpan or  search on metacpan

lib/FlashVideo/Site/Seesaw.pm  view on Meta::CPAN

# Part of get-flash-videos. See get_flash_videos for copyright.
package FlashVideo::Site::Seesaw;

use strict;
use FlashVideo::Utils;
use HTML::Entities qw(decode_entities);
use URI::Escape qw(uri_escape);

my @res = (
  { name => "lowResUrl",  resolution => [ 512, 288 ] },
  { name => "stdResUrl",  resolution => [ 672, 378 ] },
  { name => "highResUrl", resolution => [ 1024, 576 ] }
);

sub find_video {
  my ($self, $browser, $page_url, $prefs) = @_;

  # The videoplayerinfo info URL now appears as the Nth parameter to
  # player.init(), so just look for the videoplayerinfo directly, rather
  # than looking for player.init and the first parameter.
  my $player_info = ($browser->content =~ m{(/videoplayerinfo/\d+[^"]+)"})[0];

  # Remove escaped slashes
  (my $content = $browser->content) =~ s{\\/}{/}g;

  # Grab title and normalise
  my %seen; # avoid duplication in filenames
  
  # Annoyingly it's no longer easy to find out the series/season and
  # episode number.
  my %metadata = map { $_ => '' } qw(brandTitle seriesTitle programmeTitle);
 
  my ($series, $episode) = ($browser->content =~ /Series (\d+) - Ep(?:isode)?\.? (\d+)/);
  if ($series and $episode) {
    $metadata{series_and_episode} = sprintf "S%02dE%02d", $series, $episode;
  }

  # Need to make this Dublin Core / ISO 15836 compliant.
  foreach my $metadata_item (keys %metadata) {
    if (my $value = ($content =~ m{<$metadata_item>(.*?)</$metadata_item>}isg)[0]) {
      $value = decode_entities($value);

      # Handle various metadata items being identical.
      next if $seen{$value};

      $seen{$value}++;

      $metadata{$metadata_item} = $value;
    }
  }

  my $title = join "-", map { trim($_) }
                        grep length,
                        @metadata{qw(brandTitle series_and_episode seriesTitle programmeTitle)};

  # Grab player info
  $browser->get($player_info);

  debug "Got player info URL $player_info";

  if (!$browser->success) {
    die "Couldn't get player info: " . $browser->response->status_line;
  }

  my @urls;
  for my $res(@res) {
    if($browser->content =~ /$res->{name}":\["([^"]+)/) {
      push @urls, { %$res, url => $1 };
    }
  }

  die "No video URLs found" unless @urls;

  my $rtmp = $prefs->quality->choose(@urls);

  my($app, $playpath, $query) = $rtmp->{url} =~ m{^\w+://[^/]+/(\w+/\w+)(/[^?]+)(\?.*)};
  my $prefix = "mp4";
  $prefix = "flv" if $playpath =~ /\.flv$/;

  if ($prefs->subtitles) {
    if ($browser->content =~ m{"subtitleLocation":\["([^"]+)"\]}) {
      my $subtitles_url = $1;
      
      if ($subtitles_url =~ m{^/}) {
        $subtitles_url = "http://www.seesaw.com$subtitles_url";
      }

      debug "Got Seesaw subtitles URL: $subtitles_url";

      $browser->get($subtitles_url);

      if ($browser->success) {
        my $srt_filename = title_to_filename($title, "srt"); 

        convert_sami_subtitles_to_srt($browser->content, $srt_filename);

        info "Wrote subtitles to $srt_filename";
      }
      else {
        info "Couldn't download subtitles: " . $browser->response->status_line;
      }
    }
    else {
      debug "No Seesaw subtitles available (or couldn't extract URL)";
    }
  }

  return {
    flv      => title_to_filename($title, $prefix),
    rtmp     => $rtmp->{url},
    app      => $app,
    playpath => "$prefix:$playpath$query"
  }
}

sub search {
  my($self, $search, $type) = @_;

  my $series  = $search =~ s/(?:series |\bs)(\d+)//i ? int $1 : "";
  my $episode = $search =~ s/(?:episode |\be)(\d+)//i ? int $1 : "";

  my $browser = FlashVideo::Mechanize->new;

  _update_with_content($browser,
    "http://www.seesaw.com/start.layout.searchsuggest:inputtextevent?search="
    . uri_escape($search));

  # Find links to programmes
  my @urls = map  {
    chomp(my $name = $_->text);
    { name => $name, url => $_->url_abs->as_string }
  } $browser->find_all_links(text_regex => qr/.+/);

  # Only use result which matched every word.
  # (Seesaw's search is useless, so this seems to be the best we can do).
  my @words = split " ", $search;
  @urls = grep { my $a = $_; @words == grep { $a->{name} =~ /\Q$_\E/i } @words } @urls;

  if(@urls == 1) {
    $browser->get($urls[0]->{url});