get_flash_videos

#!/usr/bin/env perl
#
# get_flash_videos -- download all the Flash videos off a web page
#
#   http://code.google.com/p/get-flash-videos/
#
# Copyright 2009, 2010 zakflash, MonsieurVideo and contributors.
#
# Licensed under the Apache License, Version 2.0 (the "License"); you may
# not use this file except in compliance with the License. You may obtain a
# copy of the License at
#   http://www.apache.org/licenses/LICENSE-2.0
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
# WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
# License for the specific language governing permissions and limitations
# under the License.
#
# Contributions are welcome and encouraged, but please take care to
# maintain the JustWorks(tm) nature of the program.

package App::get_flash_videos;
use strict;
use Encode ();
use File::Basename qw(basename);
use File::stat;
use Getopt::Long;
use Text::Wrap;

BEGIN {
  if(!$::SCRIPT_NAME) {
    # Are we running in development mode?
    require Cwd;
    require File::Spec;
    my($vol, $dir) = (File::Spec->splitpath(Cwd::realpath($0)))[0, 1];
    unshift @INC, File::Spec->catpath($vol, File::Spec->catdir($dir, "lib"));
  }
}

use FlashVideo::URLFinder;
use FlashVideo::Mechanize;
use FlashVideo::Downloader;
use FlashVideo::RTMPDownloader;
use FlashVideo::FFmpegDownloader;
use FlashVideo::Search;
use FlashVideo::Utils;
use FlashVideo::VideoPreferences;

unshift @INC, \&plugin_loader;

# single line for MakeMaker to get version
use constant CVERSION => "1.25"; our $VERSION = CVERSION;
 
our %opt;
BEGIN {
  my $player = "mplayer -really-quiet";
  # We have special handling for "VLC" on Windows
  $player = "VLC" if $^O =~ /MSWin/i;
  # On OSX we default to open, if mplayer isn't available
  $player = "open" if $^O =~ /darwin/ && !is_program_on_path("mplayer");

  if(is_program_on_path("xdg-open") && !is_program_on_path("mplayer")) {
    # If mplayer isn't available, but xdg-open is, use that.
    $player = "xdg-open";
  } elsif(is_program_on_path("gnome-open") && !is_program_on_path("mplayer")) {
    # Alternatively try gnome-open..
    $player = "gnome-open";
  } elsif(is_program_on_path("kde-open") && !is_program_on_path("mplayer")) {
    # Alternatively try kde-open..
    $player = "kde-open";
  }

  %opt = (
    yes => 0,
    filename => '',
    version => 0,
    update => 0,
    play => 0,
    player => $player,
    proxy => '',
    debug => 0,
    quiet => 0,
    quality => "high",
    subtitles => 0,
    info => 0
  );
}

# constant evaluated at compile time, can't use runtime variables.
use constant VER_INFO => 
    "get_flash_videos version " . CVERSION . " (http://code.google.com/p/get-flash-videos/)\n";

use constant USAGE => VER_INFO . <<EOF;

Usage: $0 [OPTION]... URL...
       $0 [OPTION]... search string

Downloads videos from the web pages given in URL or searches Google Video
Search for 'search string'. If the URL contains characters such as '&' you
will need to quote it.

Options:
     --add-plugin Add a plugin from a URL.
  -d --debug      Print extra debugging information.
  -f --filename   Filename to save the video as.
  -p --play       Start playing the video once enough has been downloaded.
     --player     Player to use for the video (default: $opt{player}).
     --proxy      Proxy to use, use host:port for SOCKS, or URL for HTTP.
     --subtitles  Download subtitles where available.
  -q --quiet      Be quiet (only print errors).
  -r --quality    Quality to download at (high|medium|low, or site specific).
  -u --update     Update to latest version.
  -v --version    Print version.
  -y --yes        Say yes to any questions (don't prompt for any information).
  -i --info       Print out info about video instead of downloading.

EOF

use constant REQ_INFO => <<EOF;

A required Perl module for downloading this video is not installed.
EOF

use constant FRIENDLY_FAILURE => <<EOF;

Couldn't extract Flash movie URL. This site may need specific support adding,
or fixing.

Please confirm the site is using Flash video and if you have Flash available
check that the URL really works(!).

Check for updates by running: $0 --update

If the latest version does not support this please open a bug
at http://code.google.com/p/get-flash-videos/ making sure you include
the output with --debug enabled. Alternatively, fix it yourself and send us
a pull request on Github: https://github.com/monsieurvideo/get-flash-videos
EOF

read_conf();

GetOptions(
  "yes|y"        => \$opt{yes},
  "filename|f=s" => \$opt{filename},
  "version|v"    => \$opt{version},
  "update|u"     => \$opt{update},
  "help|h"       => \$opt{help},
  "play|p"       => \$opt{play},
  "player=s"     => \$opt{player},
  "proxy=s"      => \$opt{proxy},
  "debug|d"      => \$opt{debug},
  "quiet|q"      => \$opt{quiet},
  "add-plugin=s" => \$opt{add_plugin},
  "quality|r=s"  => \$opt{quality},
  "subtitles"    => \$opt{subtitles},
  "info|i"       => \$opt{info},
) or die "Try $0 --help for more information.\n";

if($opt{version}) {
  die VER_INFO;
} elsif($opt{update}) {
  exit update();
} elsif($opt{help}) {
  die USAGE;
} elsif($opt{add_plugin}) {
  exit add_plugin($opt{add_plugin});
}

if ($opt{debug}) {
  if(my @plugins = get_installed_plugins()) {
    debug @plugins . " plugin" . (@plugins != 1 && "s") . " installed:";
    debug "- $_" for @plugins;
  } else {
    debug "No plugins installed";
  }
}

if($^O =~ /MSWin/i) {
  $opt{filename} = Encode::decode(get_win_codepage(), $opt{filename});
  binmode STDERR, ":encoding(" . get_win_codepage() . ")";
  binmode STDOUT, ":encoding(" . get_win_codepage() . ")";
} else {
  $opt{filename} = Encode::decode("utf-8", $opt{filename});
  binmode STDERR, '<:encoding(UTF-8)';
  binmode STDOUT, '<:encoding(UTF-8)';
}

my (@urls) = @ARGV;
@urls > 0 or die USAGE;

# Search string can either be quoted or unquoted (for ultimate laziness)
my $search;
if ( ((@urls == 1) and $urls[0] !~ m'\.') or
     ( (@urls > 1) and ! grep /^http:\/\/|^[\w\-]+\.[\w\-]+/, @urls)) {
  $search = join ' ', @urls;
}

my @download_urls;

if ($search) {
  if (my @results = FlashVideo::Search->search($search, 10, 20)) {
    if ($opt{yes} or @results == 1) {
      my $message = (@results == 1) ?
        "Downloading only match for '$search': '$results[0]->{name}'" :
        "Downloading first match for '$search': '$results[0]->{name}'" ;
      info $message;

      push @download_urls, $results[0]->{url};
    }
    else {
      print "Search for '$search' found these results:\n";

      # Need 5 chars for "[nn] ".
      my $columns = get_terminal_width() - 5;
      local $Text::Wrap::columns = $columns;

      my $count = 1;
      for my $result(@results) {
        printf "[%2d] %s\n", $count, $result->{name};

        if ($result->{description}) {
          # Show as much of the description as will fit on at least 2
          # lines in the current terminal width. (Not exact because
          # Text::Wrap wraps only after whole words.)
          print wrap("     ", "     ",
                     substr($result->{description}, 0, $columns * 2)), "\n";
        }

        $count++;
      }

      print "Enter the number(s) or range (e.g. 1-3) of the videos to download " .
            "(separate multiple with comma or space): ";
      chomp(my $choice = <STDIN>);
      $choice ||= 1;

      for(split /[ ,]+/, $choice) {
        if (/-/) {
          my ($lower, $upper) = split /-/, $choice;
          if ($upper > $lower and $upper > 0) {
            push @download_urls, map { $results[$_]->{url} } $lower - 1 .. $upper - 1;
            next;
          }
          else {
            print STDERR "Search range '$_' is invalid.\n";
            exit 1;
          }
        }

        $_--;

        if (!$results[$_]) {
          print STDERR "'$_' is an invalid choice.\n";
          exit 1;
        }

        push @download_urls, $results[$_]->{url};
      }
    }
  }
  else {
    print STDERR "No results found for '$search'.\n";
    exit 1;
  }
}
else {
  @download_urls = @urls;
}

my $download_count = 0;

# Construct a preferences object for these downloads, currently just based on
# the command line options.
my $prefs = FlashVideo::VideoPreferences->new(%opt);

foreach my $url (@download_urls) {
  if (download($url, $prefs, @download_urls - $download_count)) {
    $download_count++;
  }
}

if($download_count == 0) {
  info "Couldn't download any videos.";
  exit 1;
} elsif($download_count != @download_urls) {
  info "Problems downloading some videos.";
  exit 2;
}

exit 0;

sub download {
  my($url, $prefs, $remaining) = @_;

  $url = "http://$url" if $url !~ m!^\w+:!;

  # Might be downloading from a site that uses Brightcove or other similar
  # Flash RTMP streaming server. These are handled differently. Need to get
  # the page to determine this.
  my $browser = FlashVideo::Mechanize->new;

  # Figure out what package we need to use to get either the HTTP URL or
  # rtmpdump data for the video.
  my($package, $possible_url) = FlashVideo::URLFinder->find_package($url, $browser);

  # Before fetching the url, give the package a chance
  if($package->can("pre_find")) {
    $package->pre_find($browser);
  }

  info "Downloading $url";
  $browser->get($url);
  # Handle short url which redirect...
  if ($browser->response->is_redirect and ($url ne $possible_url)) {
    info "Downloading redirected $possible_url";
    $browser->get($possible_url);
  }

  # (Redirect check is for Youtube which sometimes redirects to login page
  # for "mature" videos.)
  if (!$browser->success and !$browser->response->is_redirect) {
    if ($opt{proxy}) {
      if ($browser->response->header('Client-Warning') eq 'Internal response') {
        info "Couldn't download $url - might not be able to contact " .
             "your proxy server ($opt{proxy})";
      }
    }

    error "Couldn't download '$url': " . $browser->response->status_line;
  }

  my($actual_url, @suggested_fnames) = eval {
    $package->find_video($browser, $possible_url, $prefs);
  };

  if(!$actual_url) {
    if($@ =~ /^Must have | requires /) {
      my $error = "$@";
      $error =~ s/at $0.*//;
      print STDERR "$error" . REQ_INFO;
      return 0;
    } else {
      print STDERR "Error: $@" . FRIENDLY_FAILURE;
      return 0;
    }
  }

  my $suggested_filename = $suggested_fnames[-1];
  if (ref($actual_url) eq 'HASH') {
      $suggested_filename ||= $actual_url->{flv};
  }

  if (!$opt{play}) {
    if (!$opt{yes} && !$opt{filename} && @suggested_fnames > 1) {
      print "There are different suggested filenames, please choose:\n";
      my $count;
      foreach my $filename (@suggested_fnames) {
        $count++;
        print "$count - $filename\n";
      }

      print "\nWhich filename would you like to use?: ";
      chomp(my $chosen_fname = <STDIN>);

      $suggested_filename = $suggested_fnames[$chosen_fname - 1] ||
        $suggested_fnames[-1];
    }
  }

  my $save_as = $opt{filename} || $suggested_filename;

  # Print info instead of downloading
  if($opt{info}) {
    if(ref($actual_url) eq 'ARRAY') {
      for my $data(@$actual_url) {
        print "Filename: " . $data->{flv} . "\n";
        $_ = $suggested_filename || $data->{flv};
        s/_/ /g;
        s/\.[^\.]*$//;
        print "Title: " . $_ . "\n";
        print "Content-Location: " . $data->{rtmp} . "\n";
        print "\n";
      }
    } else {
      print "Filename: " . ($save_as || $actual_url->{flv}) . "\n";
      $_ = $suggested_filename || $actual_url->{flv};
      s/_/ /g;
      s/\.[^\.]*$//;
      print "Title: " . $_ . "\n";
      print "Content-Location: ";
      if(ref($actual_url) eq 'HASH') {
        print $actual_url->{rtmp} . "\n";
      } else {
        print $actual_url . "\n";
        $browser->head($actual_url);
        if($browser->response->header('Content-Length')) {
          print "Content-Length: " . $browser->response->header('Content-Length') . "\n";
        }
      }
    }
    exit;
  }

  my $action = $opt{play} ? "play" : "download";

  for my $data((ref($actual_url) eq 'ARRAY' ? @$actual_url : $actual_url)) {
    my $downloader;
    my $file = $save_as;

    if(ref $data eq 'HASH') {
      if (defined($data->{downloader}) && $data->{downloader} eq "ffmpeg") {
        $downloader = FlashVideo::FFmpegDownloader->new;
        $file ||= $data->{flv};
      } else {
        # RTMP data
        $downloader = FlashVideo::RTMPDownloader->new;
        $file ||= $data->{flv};
      }
    } else {
      # HTTP
      $downloader = FlashVideo::Downloader->new;
    }

    # XXX: Needs some thought, but this hack works for Youku for now it seems.
    if (ref $data eq 'ARRAY') {
      my ($url, $part_number, $part_count, $part_size) = @$data;
      $data = $url;
      if (defined $part_number && defined $part_count) {
        my $part_suffix = sprintf('.part%02d_of_%02d', $part_number, $part_count);
        substr $file, rindex($file, '.'), 0, $part_suffix
          if $part_count > 1;
      }

      if (defined $part_size && -f $file && -s $file == $part_size) {
        info "Already downloaded $file ($part_size bytes)";
        next;
      }
    }

    my $size = $downloader->$action($data, $file, $browser) || return 0;

    info "\n" . ($remaining == 1 ? "Done. " : "")
      . "Saved $size bytes to $downloader->{printable_filename}";
  }

  return 1;
}

sub read_conf {
  for my $file("/etc/get_flash_videosrc", "$ENV{HOME}/.get_flash_videosrc") {
    open my $fh, "<", $file or next;

    while(<$fh>) {
      s/\r?\n//;
      next if /^\s*(#|$)/;

      my($n, $v) = split /\s*=\s*/;
      $v = 1 unless defined $v;
      $opt{$n} = $v;
    }
  }
}

sub add_plugin {
  my($plugin_url) = @_;

  my $uri = URI->new($plugin_url);

  unless(-d get_plugin_dir()) {
    require File::Path;
    File::Path::mkpath(get_plugin_dir())
      or die "Unable to create plugin dir: $!";
  }

  my $filename = get_plugin_dir() . "/" . basename($uri->path);

  if($filename !~ /\.pm$/) {
    die "Plugins must have a file extension of '.pm'\n";
  }

  if(!$uri->scheme) {
    # Local path given
    require File::Copy;
    File::Copy::copy($plugin_url => $filename)
      || die "Unable to copy plugin to '$filename': $!\n";

    info "Plugin installed.";
    return 0;
  } else {
    my $browser = FlashVideo::Mechanize->new;
    return !install_plugin($browser, $plugin_url, $filename);
  }
}

sub update {
  my %update_types = (
    'cpan-cpan' => [1, "cpan " . __PACKAGE__],
    'cpan-cpanp' => [1, "cpanp i " . __PACKAGE__],
    'cpan-cpanm' => [1, "cpanm " . __PACKAGE__],
    'cpan-manual' => [0, "Manual install"],
  );

  # SCRIPT_NAME is some magic set by combine-perl or via MakeMaker
  if($::SCRIPT_NAME) {
    my $browser = FlashVideo::Mechanize->new;

    $browser->get("http://get-flash-videos.googlecode.com/svn/wiki/Version.wiki");

    if(!$browser->response->is_success) {
      die "Unable to retrieve version data: " . $browser->response->status_line . "\n";
    }

    my $version = ($browser->content =~ /version: (\S+)/)[0];
    my $base = ($browser->content =~ /from: (\S+)/)[0];
    my $info = ($browser->content =~ /info: (\S+)/)[0];
    my $url = $base . $::SCRIPT_NAME . "-" . $version;

    die "Unable to parse version data" unless $version and $base;

    # Split version on . and compare... (can't yet use version, that is only
    # core since 5.10).
    my @v = split /\./, $version;
    my @V = split /\./, $VERSION;

    my $newer = 0;
    my $i = 0;
    for(@v) {
      $newer = 1 if !defined $V[$i] || $_ > $V[$i];
      last if $V[$i] > $v[$i];
      $i++;
    }

    if($newer) {
      info "Newer version ($version) available";
      debug "(Install type: $::INSTALL_TYPE)";

      if($::INSTALL_TYPE =~ /^cpan-/) {

        my $update_method = $update_types{$::INSTALL_TYPE};
        if($update_method->[0]) {
          info "This was installed via CPAN, you may upgrade by running:";
          info $update_method->[1];

          my $run_cpan = $opt{yes} || do {
            info "Shall I run that for you? (Y/n)";
            <STDIN> =~ /(?:^\s*$|y)/i;
          };

          if($run_cpan) {
            system $update_method->[1];
          }
        } else {
          info "Please visit http://code.google.com/p/get-flash-videos to upgrade";
        }
      } else {
        update_script($browser, $url, $info);
      }
    } else {
      print STDERR "You already have the latest version.\n";
    }
  } else {
    info "Development version, not updated";
  }

  update_plugins();

  return 0; # exit code
}

sub update_script {
  my($browser, $url, $info) = @_;

  info "Downloading new version...";
  die "Cannot update -- unable to write to $0\n" unless -w $0;

  my $new_file = $0 . ".new";
  $browser->mirror($url, $new_file);

  if($browser->response->is_success && -f $new_file) {
    rename $0, "$0.old" or die "Unable to rename $0 to $0.old: $!";
    rename $new_file, $0 or die "Unable to rename $new_file to $0: $!";
    chmod 0755, $0;

    info "New version installed as $0";
    info "(previous version backed up to $0.old).";
    info $info;
  } else {
    die "Download failed: " . $browser->response->status_line;
  }
}

sub update_plugins {
  my $browser = FlashVideo::Mechanize->new;

  foreach my $plugin(get_installed_plugins()) {
    debug "Seeing if there is an update for $plugin..";

    my $file = get_plugin_dir() . "/$plugin";
    require $file;

    my $package = "FlashVideo::Site::" . ($plugin =~ /(.*)\.pm$/)[0];

    if($package->can("update")) {
      # Allow plugin to override generic updater
      $package->update();
    } else {
      no strict 'refs';

      my $downloaded  = 0;
      my $newer_found = 0;

      foreach my $update_url (@{ "$package\::update_urls" }) {
        $browser->head($update_url);

        if (!$browser->response->is_success) {
          # This shouldn't be fatal
          debug "Couldn't retrieve $update_url for $plugin: " . $browser->response->status_line;
          next;
        }

        # Compare the last modified time of the plugin to the time of the file on disk
        my $file_mtime = stat($file)->mtime;

        my $remote_plugin_mtime = $browser->response->last_modified;

        if ($remote_plugin_mtime > $file_mtime) {
          info "Newer version of plugin $plugin found at $update_url, trying to download and install";
          $newer_found = 1;

          if ($downloaded = install_plugin($browser, $update_url, $file)) {
            last;
          }
        }
        else {
          debug "Plugin $plugin is already the lastest version.";
          debug "(Remote: " . $browser->response->header("Last-Modified")
            . "; Local: " . gmtime($file_mtime) . " GMT)";
        }
      }

      if ($newer_found and !$downloaded) {
        die "Couldn't install $plugin plugin";
      }
    }
  }
}

# Upgrade a plugin or install a new one.
sub install_plugin {
  my ($browser, $url, $file) = @_;

  # So we can track newly installed plugins as well as updated ones
  my $plugin_exists = -f $file;

  my $new_file = $plugin_exists ? "$file.new" : $file;

  $browser->mirror($url, $new_file);

  if ($browser->response->is_success && -f $new_file) {
    my $short_name = basename($file);

    if ($plugin_exists) {
      rename $file, "$file.old" or die "Unable to rename $file to $file.old: $!";
      rename $new_file, $file   or die "Unable to rename $new_file to $file: $!";

      info "New version of $short_name installed as $file";
      info "(previous version backed up to $file.old).";
    }
    else {
      info "New plugin $short_name installed as $file";
    }

    return 1;
  }
  else {
    warn "Download failed: " . $browser->response->status_line;
  }

  return 0;
}

# Coderef to this in @INC means Perl will call it for every module that it
# tries to load, including our internal FlashVideo::Site:: modules. Use
# this to load plugins off disk to support seperately distributed plugins.
sub plugin_loader {
  my (undef, $module) = @_;

  if ($module =~ m'^FlashVideo/Site/(.*)') {
    # Don't want to force people to have a FlashVideo/Site directory
    # structure in their plugins directory, as this makes it harder to
    # install plugins manually.
    my $plugin_name = $1;

    my $plugin_dir = get_plugin_dir();

    debug "Trying to open plugin $plugin_dir/$plugin_name";

    if (-s "$plugin_dir/$plugin_name") {
      if (open my $plugin_fh, '<', "$plugin_dir/$plugin_name") {
        return $plugin_fh; # Perl then reads the plugin from the FH
      }
      info "Failed to open plugin $plugin_dir/$plugin_name $!";
    }
  }

  return;
}

sub get_installed_plugins {
  my $plugin_dir = get_plugin_dir();

  my @plugins;
  if (opendir my $plugin_dir_dh, $plugin_dir) {
    @plugins = grep /\.pm$/i,
               readdir $plugin_dir_dh;
    closedir $plugin_dir_dh;
  }

  return @plugins;
}

# This is called in debug mode to get a list of installed plugins, so have
# it as a separate function.
sub get_plugin_dir {
  return get_user_config_dir() . "/plugins";
}