blob: 6f70dcfd8a2ae34f9192b7575e44b2310909baab [file] [log] [blame]
#!/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";
}