get-flash-videos 1.25.98-1 / usr / share / perl5 / FlashVideo / Site / Tv3.pm

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

use strict;
use FlashVideo::Utils;

our $VERSION = '0.04';
sub Version() { $VERSION; }

sub getSloc($) {
  return "tv3";
}

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

  my $content = $browser->content;

  #open(F, "> content.html");print F $content;close(F);

  if ($content !~ m/var\s+video\s*=\s*\"[\/\*]([^"]+)\"\s*;/s) {
    die "Unable to parse video path from web page";
  }
  my $replace = $1;
  $replace =~ s/\*/\//sg;

  if ($content !~ m/var\s+geo\s*=\s*\"([^"]+)\"\s*;/s) {
    die "Unable to determine geo mode";
  }
  my $geo = $1;

  debug "GEO mode: $geo";

  my $sloc = $self->getSloc();;

  # As per the JavaScript on the episode base page, for TV3's current
  # affairs programs the requested source location should be altered
  # to "3news" instead of "tv3".
  if ($content =~ m/var\s+pageloc\s*=\s*\'([^']+)\'\s*;/s) {
    my $pageloc = $1;
    debug "pageloc : $pageloc";

    if ($pageloc =~ m/^[^-]+-[^-]+-[^-]+-[^-]+-currentaffairs-/si) {
      # if sect4 == "currentaffairs" then sloc="3news"
      $sloc = "3news";
    }
  } else {
    debug "No pageloc parsed, optimistically continuing...";
  }

  if ($content !~ m/src=['"](\/[A-Za-z0-9\/]+\/player[-\d]+\.min\.js\?(?:|v=[0-9A-Za-z]*))['"](\>|\+ord)/s) {
    die "Unable to locate player module";
  }
  my $basePlayer = $1;
  my $withOrd = $2 =~ m/ord/s;

  my $ord = "";

  if ($withOrd) {
    # The player has, historically, always has a random component
    # appended to a fixed numeric prefix that will normally be 16
    # decimal digits long.
    for (my $c = 0; $c < 16; $c++) {
      $ord .= int(rand(10));
    }

    # Strip all leading zeros, but make sure there's at least one
    # (possibly zero) digit left.
    $ord =~ s/^0+(.)/$1/gs;
  }

  my $player = $basePlayer . $ord;

  # Default title is perfect.  We need to do this before we re-use the
  # browser to obtain other files.
  my $filename = title_to_filename(extract_title($browser));
  $filename ||= get_video_filename();

  debug "Trying to get player: $player";

  #
  # Getting the player.js isn't strictly necessary, but it allows us
  # to check assumptions, and not have to hard code the token - which
  # potentially might be changed from time to time.
  #

  my $smilPath = "/portals/0/video/smil1500-2.aspx";
  my $secureToken;
  {
    my $playerResponse = $browser->get($player);
    die "Failed to get player.js" if !$playerResponse->is_success();

    my $playerContent = $playerResponse->decoded_content();
    if ($playerContent !~ m/securetoken\s*:\s*\"([^\"]+)\"/s) {
      die "Unable to obtain securetoken";
    }
    $secureToken = $1;

    debug "Securetoken = $secureToken";

    my $smilPathRE = quotemeta($smilPath);
    if ($playerContent !~ m/$smilPathRE/s) {
      die "The expected SMIL path is not present";
    }
  }

  #
  # Default is "non-geo", and we've seen at least two values for the
  # "geo" variable, "non" and "non-geo".
  #
  my $serverVar = "rtmpe://vod-non-geo.mediaworks.co.nz/vod/_definst_";
  if ($geo eq "geo") {
    $serverVar = "rtmpe://vod-geo.mediaworks.co.nz/vod/_definst_";
  }

  my $locationVar = "mp4:" . $sloc . "/" . $replace;

  my $info = undef;
  {
    my $smil = $smilPath . "?serverVar=" . $serverVar .
      "&locationVar=" . $locationVar . "&typeVar=mp4";

    debug "Trying to get SMIL: $smil";

    my $smilResponse = $browser->get($smil);
    die "Failed to get SMIL" if !$smilResponse->is_success();
    my $smilContent = $smilResponse->decoded_content();

    #open(F, "> smil.xml");print F $smilContent;close(F);

    my $xml = $smilContent;
    my %rateMap = ();
    while ($xml =~ s/\<video src=\"([^\"]+)" system-bitrate=\"(\d+)\"//s) {
      my $url = $1;
      my $bps = $2;

      debug "Available rate of ${bps} from $url";

      $rateMap{$bps} = { rate => $bps, src => $url };
    }

    my $quality = $prefs->{quality};
    $quality = "default" if !defined($quality);

    $info = $rateMap{$quality};
    if (!defined($info)) {
      my @rates = map { $rateMap{$_} } sort { $a <=> $b } keys %rateMap;

      my $option = undef;
      foreach my $try ("high", "medium", "low") {
        $option = pop(@rates) if (scalar(@rates) > 0);

        if ($try eq $quality) {
          # Matched
          $info = $option;
          last;
        }

        if (!defined($info)) {
          # Default to highest quality if no match seen.
          $info = $option;
        }
      }
    }

    if (!defined($info)) {
      die "Couldn't match the requested quality";
    }

    debug "Matching \"$quality\" quality at " . $info->{rate} .
      "bps with source \"" . $info->{src} . "\"";
  }

  my $rtmp = $serverVar . "/" . $info->{src};

  # It seems to be necessary to use --live, otherwise the stream
  # periodically jumps backwards.
  return {
    rtmp => $rtmp,
    live => "",
    token => $secureToken,
    swfVfy => "http://wa2.static.mediaworks.co.nz/video/jw/6.60/jwplayer.flash.swf",
    flv => $filename
   };
}

sub can_handle {
  my($self, $browser, $url) = @_;

  my $slocRE = quotemeta($self->getSloc());

  return $url && URI->new($url)->host =~ m/(?:^|\.)$slocRE\.co\.nz$/;
}

1;