├── debian ├── compat ├── dirs ├── rules ├── copyright └── control ├── lib └── FlashVideo │ ├── Site │ ├── Cbs.pm │ ├── Msn.pm │ ├── Ringtv.pm │ ├── Vkontakte.pm │ ├── Xvideos.pm │ ├── Megaporn.pm │ ├── Stupidvideos.pm │ ├── Youtubenocookie.pm │ ├── Sockshare.pm │ ├── Four.pm │ ├── Oppetarkiv.pm │ ├── 5min.pm │ ├── Redtube.pm │ ├── Stagevu.pm │ ├── Liveleak.pm │ ├── Gosupark.pm │ ├── Myvideo.pm │ ├── Cbsnews.pm │ ├── Motherless.pm │ ├── Mitworld.pm │ ├── Mofosex.pm │ ├── Gawker.pm │ ├── Cultureunplugged.pm │ ├── Pennyarcade.pm │ ├── Sapo.pm │ ├── Mylifetime.pm │ ├── Gamespot.pm │ ├── Last.pm │ ├── Techcast.pm │ ├── Fora.pm │ ├── Videolectures.pm │ ├── Nhk.pm │ ├── Xhamster.pm │ ├── Xnxx.pm │ ├── Aniboom.pm │ ├── Video44.pm │ ├── Zshare.pm │ ├── Expertvillage.pm │ ├── Collegehumor.pm │ ├── Bing.pm │ ├── Ima.pm │ ├── About.pm │ ├── Filebox.pm │ ├── Videofun.pm │ ├── Theonion.pm │ ├── Todaysbigthing.pm │ ├── Vidzur.pm │ ├── Facebook.pm │ ├── Movieclips.pm │ ├── Spike.pm │ ├── Munkvideo.pm │ ├── Truveo.pm │ ├── Nicovideo.pm │ ├── Abclocal.pm │ ├── Ehow.pm │ ├── Gorillavid.pm │ ├── Grindtv.pm │ ├── Googlevideosearch.pm │ ├── Pinkbike.pm │ ├── Sevenload.pm │ ├── Videobb.pm │ ├── Vitheque.pm │ ├── Starwars.pm │ ├── Ardmediathek.pm │ ├── Scivee.pm │ ├── Tbs.pm │ ├── Zdf.pm │ ├── Metacafe.pm │ ├── Google.pm │ ├── Spiegel.pm │ ├── Presstv.pm │ ├── Daserste.pm │ ├── Vk.pm │ ├── Vimeo.pm │ ├── Cartoonnetwork.pm │ ├── Escapistmagazine.pm │ ├── Canoe.pm │ ├── Tva.pm │ ├── Freevideo.pm │ ├── Vrak.pm │ ├── Apple.pm │ ├── Yourupload.pm │ ├── Canalvie.pm │ ├── Blip.pm │ ├── Divxstage.pm │ ├── Redbull.pm │ ├── Traileraddict.pm │ ├── Flickr.pm │ ├── Nick.pm │ ├── Movshare.pm │ ├── Break.pm │ ├── Muzu.pm │ ├── Stickam.pm │ ├── Arte.pm │ ├── Kidswb.pm │ ├── Msnbc.pm │ ├── Megavideo.pm │ ├── Slashcontrol.pm │ ├── Cnet.pm │ ├── Ooyala.pm │ ├── Adultswim.pm │ ├── Tv4play.pm │ ├── 4od.pm │ ├── Thirteen.pm │ ├── Wat.pm │ ├── Ted.pm │ ├── Globaltv.pm │ ├── Dplay.pm │ ├── Nfb.pm │ ├── Ustream.pm │ ├── Nasa.pm │ ├── Sbs.pm │ ├── Fliqz.pm │ ├── Viafree.pm │ ├── Ctv.pm │ ├── Dailymotion.pm │ ├── Tv.pm │ ├── Nbc.pm │ ├── Svtplay.pm │ ├── Abc.pm │ ├── Cwtv.pm │ └── Amazon.pm │ ├── DASHDownloader.pm │ ├── Site.pm │ ├── VideoPreferences.pm │ ├── VideoPreferences │ ├── Account.pm │ └── Quality.pm │ ├── JSON.pm │ └── Search.pm ├── Makefile ├── MANIFEST.SKIP ├── .gitignore ├── utils ├── uncompress-flash.pl ├── autoplay.sh ├── combine-head ├── combine-tail └── combine-header ├── obsd_create.sh ├── t ├── rtmpdownloader.t ├── json.t ├── google_video_search.t ├── 00_load.t ├── utils.t ├── title_to_filename.t ├── url.t └── prefs.t ├── README.md ├── Makefile.bsd-wrapper ├── bin └── get_flash_videos.PL ├── mk ├── targets.mk └── release.mk └── Makefile.PL /debian/compat: -------------------------------------------------------------------------------- 1 | 7 2 | -------------------------------------------------------------------------------- /debian/dirs: -------------------------------------------------------------------------------- 1 | usr/bin 2 | -------------------------------------------------------------------------------- /debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | 3 | %: 4 | dh $@ 5 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Cbs.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Cbs; 3 | 4 | use base 'FlashVideo::Site::Tv'; 5 | 6 | 1; 7 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Msn.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Msn; 3 | 4 | use strict; 5 | use base 'FlashVideo::Site::Bing'; 6 | 7 | 1; 8 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Ringtv.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Ringtv; 3 | 4 | use strict; 5 | use base 'FlashVideo::Site::Grindtv'; 6 | 7 | 1; 8 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Vkontakte.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Vkontakte; 3 | 4 | use strict; 5 | use base 'FlashVideo::Site::Vk'; 6 | 7 | 1; 8 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Xvideos.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Xvideos; 3 | 4 | use strict; 5 | use base 'FlashVideo::Site::Xnxx'; 6 | 7 | 1; 8 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Megaporn.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Megaporn; 3 | 4 | use strict; 5 | use base 'FlashVideo::Site::Megavideo'; 6 | 7 | 1; 8 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Stupidvideos.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Stupidvideos; 3 | 4 | use strict; 5 | use base 'FlashVideo::Site::Grindtv'; 6 | 7 | 1; 8 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Youtubenocookie.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Youtubenocookie; 3 | 4 | use strict; 5 | use base 'FlashVideo::Site::Youtube'; 6 | 7 | 1; 8 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Sockshare.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Sockshare; 3 | 4 | # SockShare uses the same software as PutLocker 5 | use base 'FlashVideo::Site::Putlocker'; 6 | 7 | 1; 8 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all:: 2 | 3 | mk/makemaker-wrap.mk: Makefile.PL 4 | @if [ ! -f "mk/makemaker.mk" ]; then GFV_DEVEL_MODE=1 perl Makefile.PL; fi 5 | @echo "-include mk/makemaker.mk" > $@ 6 | 7 | -include mk/makemaker-wrap.mk 8 | include mk/targets.mk 9 | include mk/release.mk 10 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Four.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Four; 3 | 4 | use strict; 5 | 6 | use base qw(FlashVideo::Site::Tv3); 7 | 8 | our $VERSION = '0.01'; 9 | sub Version() { $VERSION; } 10 | 11 | sub getSloc($) { 12 | return "four"; 13 | } 14 | 15 | 1; 16 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | \.git/ 2 | App-get_flash_videos-.*/ 3 | blib/ 4 | debian/ 5 | mk/ 6 | wiki/ 7 | \.sitemodules 8 | Makefile$ 9 | pm_to_blib 10 | bin/get_flash_videos$ 11 | combined-get_flash_videos(|-\d.*)$ 12 | get_flash_videos-\d.*$ 13 | t/test-\d+/ 14 | .*\.(flv|mp\d|mpe?g|wmv|avi|mov) 15 | .*\.tar\.gz$ 16 | ..*sw[op]$ 17 | .*\.bak 18 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | App-get_flash_videos-* 2 | bin/get_flash_videos 3 | combined-get_flash_videos* 4 | get_flash_videos-* 5 | get_flash_videos.1 6 | .sitemodules 7 | .DS_Store 8 | wiki 9 | *.bak 10 | *.old 11 | *.mp4 12 | *.flv 13 | *.m3u8 14 | *.ogg 15 | *.ts 16 | *.tsx 17 | *.webm 18 | *.gz 19 | .*sw[op] 20 | blib 21 | pm_to_blib 22 | MANIFEST 23 | META.yml 24 | MYMETA.* 25 | mk/makemaker.mk 26 | mk/makemaker.mk.old 27 | mk/makemaker-wrap.mk 28 | # Emacs files 29 | # 30 | *~ 31 | .#* 32 | \#*\# 33 | \#* 34 | TAGS 35 | -------------------------------------------------------------------------------- /lib/FlashVideo/DASHDownloader.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::DASHDownloader; 3 | 4 | use strict; 5 | use warnings; 6 | use base 'FlashVideo::Downloader'; 7 | use FlashVideo::Utils; 8 | use FlashVideo::JSON; 9 | use Term::ProgressBar; 10 | 11 | my $bitrate_index = { 12 | high => 0, 13 | medium => 1, 14 | low => 2 15 | }; 16 | 17 | sub download { 18 | my ($self, $args, $file, $browser) = @_; 19 | 20 | info "Not implemented yet"; 21 | } 22 | 1; 23 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Oppetarkiv.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Oppetarkiv; 3 | 4 | use strict; 5 | use warnings; 6 | 7 | use FlashVideo::Utils; 8 | use FlashVideo::JSON; 9 | use HTML::Entities; 10 | use base 'FlashVideo::Site::Svtplay'; 11 | 12 | our $VERSION = '0.01'; 13 | sub Version() { $VERSION;} 14 | 15 | sub find_video { 16 | my ($self, $browser, $embed_url, $prefs) = @_; 17 | $self->find_video_svt($browser, $embed_url, $prefs, 1); 18 | } 19 | 20 | 1; 21 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/5min.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::5min; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser) = @_; 9 | 10 | my $filename = title_to_filename(extract_info($browser)->{meta_title}); 11 | 12 | # They now pass the URL as a param, so the generic code can extract it. 13 | my $url = (FlashVideo::Generic->find_video($browser, $browser->uri))[0]; 14 | 15 | return $url, $filename; 16 | } 17 | 18 | 1; 19 | -------------------------------------------------------------------------------- /utils/uncompress-flash.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # http://board.flashkit.com/board/archive/index.php/t-283660.html 3 | use strict; 4 | use Compress::Zlib; 5 | 6 | my $file = shift; 7 | -f $file or die "Usage: $0 file > output\n"; 8 | 9 | open my $fh, "<", $file or die $!; 10 | binmode $fh; 11 | my $body; 12 | read $fh, $body, -s $file; 13 | 14 | die "Doesn't look like compressed flash to me..\n" unless 'C' eq substr $body, 0, 1; 15 | substr($body, 0, 1) = "F"; 16 | 17 | print substr $body, 0, 8; 18 | print uncompress(substr $body, 8); 19 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Redtube.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Redtube; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | sub find_video { 9 | my($self, $browser, $embed_url) = @_; 10 | 11 | my($title) = extract_title($browser) =~ /(.*) \|/; 12 | 13 | my($url) = $browser->content =~ /mp4_url=([^&"]+)/; 14 | $url = uri_unescape($url); 15 | 16 | $browser->allow_redirects; 17 | return $url, title_to_filename($title, "mp4"); 18 | } 19 | 20 | 1; 21 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Stagevu.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Stagevu; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser) = @_; 9 | 10 | my($title) = $browser->content =~ /(.*?)<\/title>/; 11 | $title =~ s/\s*-\s*Stagevu.*?$//; 12 | 13 | # Generic can handle this so just pass it over to that 14 | my($url) = FlashVideo::Generic->find_video($browser); 15 | 16 | return $url, title_to_filename($title); 17 | } 18 | 19 | 1; 20 | -------------------------------------------------------------------------------- /obsd_create.sh: -------------------------------------------------------------------------------- 1 | #!/bin/ksh 2 | 3 | # 4 | #VER=1.24.`date +%Y%m%d` 5 | #GVER=1.24-git-`date +%Y%m%d` 6 | #ARCNAME=App-get_flash_videos-${VER} 7 | #git tag v${VER} 8 | #env GFV_DEVEL_MODE=1 perl Makefile.PL 9 | #echo "-include mk/makemaker.mk">mk/makemaker-wrap.mk 10 | #make -f Makefile.bsd-wrapper VERSION=${VER} mk/makemaker-wrap.mk 11 | #make -f Makefile.bsd-wrapper VERSION=${VER} release-test 12 | 13 | make -f Makefile.bsd-wrapper mk/makemaker-wrap.mk 14 | make -f Makefile.bsd-wrapper mk/makemaker.mk 15 | make -f Makefile.bsd-wrapper release-test 16 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Liveleak.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Liveleak; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url) = @_; 9 | 10 | my $url; 11 | if ($browser->content =~ /file: "((?!rtmp))([^"]+)"/) { 12 | $url = $2; 13 | } else { 14 | die "Unable to extract video url"; 15 | } 16 | 17 | (my $title = extract_title($browser)) =~ s/LiveLeak\.com - //; 18 | 19 | return $url, title_to_filename($title, "mp4"); 20 | } 21 | 22 | 1; 23 | -------------------------------------------------------------------------------- /utils/autoplay.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | last="" 3 | 4 | cd /tmp 5 | 6 | play() { 7 | get_flash_videos -y -p --player "mplayer -really-quiet %s 2>/dev/null; rm %s" "$1" 8 | } 9 | 10 | while sleep 1; do 11 | clip="$(xclip -o)" 12 | 13 | # If changed 14 | if [ "${clip}x" != "${last}x" ]; then 15 | # Must be a http URL 16 | if [ "${clip/http:}" != "${clip}" ]; then 17 | # Looks like it might be a video.. 18 | if [ "${clip/{watch,flv,show,video}}" != "${clip}" ]; then 19 | play "${clip}" 20 | fi 21 | fi 22 | last="${clip}" 23 | fi 24 | done 25 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Gosupark.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Gosupark; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | our $VERSION = '0.01'; 8 | sub Version() { $VERSION; } 9 | 10 | sub find_video { 11 | my ($self, $browser, $embed_url) = @_; 12 | my $url = ""; 13 | 14 | if ($browser->content =~ /.*\s*file: "(http:\/\/gosupark[^"]+).*",/) { 15 | $url = $1; 16 | } else { 17 | return; 18 | } 19 | debug ("URL: '" . $url . "'"); 20 | return $url, title_to_filename("", "mp4"); 21 | } 22 | 23 | 1; 24 | 25 | -------------------------------------------------------------------------------- /utils/combine-head: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # get_flash_videos -- download all the Flash videos off a web page 4 | # 5 | # http://code.google.com/p/get-flash-videos/ 6 | # 7 | # Copyright 2009, zakflash and MonsieurVideo 8 | # 9 | # This file includes various perl modules, see their original source for their 10 | # copyright and license terms. 11 | 12 | use HTTP::Cookies (); 13 | use HTTP::Config (); 14 | use HTTP::Request::Common (); 15 | use LWP::Protocol::http (); 16 | use LWP::Protocol::https (); 17 | use Encode::Locale (); 18 | use XML::Simple (); 19 | use WWW::Mechanize::Link (); 20 | 21 | 1; 22 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Myvideo.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Myvideo; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url) = @_; 9 | 10 | my $video_url; 11 | 12 | if ($browser->content =~ m{<link rel='image_src' href='(http://[^'"]+)'}) { 13 | $video_url = $1; 14 | } 15 | 16 | $video_url =~ s|thumbs/||; 17 | $video_url =~ s|_\d\.jpg$|.flv|; 18 | 19 | my $title = (split /\//, $browser->uri->as_string)[-1]; 20 | 21 | return $video_url, title_to_filename($title); 22 | } 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /t/rtmpdownloader.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use lib qw(..); 4 | use Test::More tests => 3; 5 | use Tie::IxHash; 6 | 7 | BEGIN { 8 | use_ok "FlashVideo::RTMPDownloader"; 9 | } 10 | 11 | my $r = FlashVideo::RTMPDownloader->new; 12 | 13 | # Ensure ordering is consistent. 14 | my %data; 15 | tie %data, "Tie::IxHash", 16 | verbose => undef, conn => [qw/O:1 NS:foo/], rtmp => "rtmp://blah"; 17 | 18 | is_deeply([$r->get_command(\%data)], 19 | [qw{--verbose --conn O:1 --conn NS:foo --rtmp rtmp://blah}]); 20 | 21 | is(join(" ", $r->get_command(\%data, 1)), 22 | "--verbose --conn 'O:1' --conn 'NS:foo' --rtmp 'rtmp://blah'"); 23 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Cbsnews.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Cbsnews; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use base 'FlashVideo::Site::Cnet'; 7 | 8 | sub find_video { 9 | my ($self, $browser, $embed_url) = @_; 10 | 11 | my $video_id; 12 | if($browser->content =~ /CBSVideo\.setVideoId\(["']([0-9]+)["']\)/) { 13 | $video_id = $1; 14 | } else { 15 | die "Could not find video id. If this is a valid CBS News video, please file a bug report at https://github.com/monsieurvideo/get-flash-videos/issues"; 16 | } 17 | return $self->get_video($browser, $video_id); 18 | } 19 | 20 | 1; 21 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site; 3 | 4 | use strict; 5 | 6 | # Various accessors to avoid plugins needing to know about the exact command 7 | # line options. This will improve at some point (i.e. more OO) 8 | 9 | sub debug { 10 | $App::get_flash_videos::opt{debug}; 11 | } 12 | 13 | sub action { 14 | $App::get_flash_videos::opt{play} ? "play" : "download"; 15 | } 16 | 17 | sub player { 18 | $App::get_flash_videos::opt{player}; 19 | } 20 | 21 | sub yes { 22 | $App::get_flash_videos::opt{yes}; 23 | } 24 | 25 | sub quiet { 26 | $App::get_flash_videos::opt{quiet}; 27 | } 28 | 29 | 1; 30 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Motherless.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Motherless; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | our $VERSION = '0.01'; 8 | sub Version() { $VERSION; } 9 | 10 | sub find_video { 11 | my ($self, $browser, $embed_url) = @_; 12 | 13 | my $url; 14 | print $embed_url; 15 | if ($browser->content =~ /"file'[[:blank:]]*: "([^"]+)",/) { 16 | $url = $1."?start=0"; 17 | } else { 18 | die "Unable to extract video url"; 19 | } 20 | 21 | (my $title) = extract_title($browser) =~ /:\s+(.*)/; 22 | 23 | return $url, title_to_filename($title, "flv"); 24 | } 25 | 26 | 1; 27 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Mitworld.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Mitworld; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser) = @_; 9 | 10 | my($title) = $browser->content =~ m{id="video-meta">\s*<h2>(.*?)</h2>}s; 11 | if(!$title) { 12 | $title = extract_title($browser); 13 | $title =~ s/\|.*//; 14 | } 15 | 16 | my($host) = $browser->content =~ m{host:\s*"(.*?)"}; 17 | my($flv) = $browser->content =~ m{flv:\s*"(.*?)"}; 18 | 19 | return { 20 | rtmp => "rtmp://$host/ondemand/ampsflash/$flv?_fcs_vhost=$host", 21 | flv => title_to_filename($title) 22 | }; 23 | } 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /t/json.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use lib qw(..); 4 | use Test::More tests => 9; 5 | 6 | BEGIN { 7 | use_ok "FlashVideo::JSON"; 8 | } 9 | 10 | is_deeply(from_json('{"foo": "bar"}'), { foo => "bar" }); 11 | is_deeply(from_json('{"foo": "bar", "baz": { "foo" : 2, "bar": 12 | [1,2, 13 | 3] } }'), 14 | { foo => "bar", baz => { foo => 2, bar => [1,2,3] } }); 15 | 16 | is_deeply(from_json('[1,2,3,4]'), [1,2,3,4]); 17 | 18 | is_deeply(from_json('"hello"'), ["hello"]); 19 | is_deeply(from_json('"\u3053\u3093\u306b\u3061\u308f"'), ["\x{3053}\x{3093}\x{306b}\x{3061}\x{308f}"]); 20 | is_deeply(from_json('false'), [0]); 21 | is_deeply(from_json('true'), [1]); 22 | is_deeply(from_json('null'), [undef]); 23 | 24 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Mofosex.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Mofosex; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url) = @_; 9 | 10 | my $filename = title_to_filename($browser->content =~ /<title>(.*?)<\//); 11 | 12 | # I want to follow redirects now. 13 | $browser->allow_redirects; 14 | 15 | # Get the playlist and match for the url of the actual file 16 | my $playlist = ($browser->content =~ /videoPath=(.+?)%26page/)[0]; 17 | $browser->get($playlist); 18 | 19 | my $url = ($browser->content =~ /<url>(.+?)<\/url>/)[0]; 20 | 21 | return $url, $filename; 22 | } 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Gawker.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Gawker; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser) = @_; 9 | 10 | my $title = extract_title($browser); 11 | $title =~ s/^\w+\s+-\s*//; 12 | $title =~ s/\s*-\s+\w+$//; 13 | my $filename = title_to_filename($title); 14 | 15 | my $url = "http://cache." . $browser->uri->host . "/assets/video/" . 16 | ($browser->content =~ /newVideoPlayer\("([^"]+)/)[0]; 17 | 18 | return $url, $filename; 19 | } 20 | 21 | sub can_handle { 22 | my($self, $browser, $url) = @_; 23 | 24 | return $browser->content =~ /newVideoPlayer/; 25 | } 26 | 27 | 1; 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | get-flash-videos 2 | ================ 3 | 4 | `get-flash-videos` is a command line program to download videos from popular video hosting sites. It is written in perl and supports many platforms including Linux, Windows and OS X. For a list of supported sites see [Working Sites](https://github.com/monsieurvideo/get-flash-videos/wiki/WorkingSites). 5 | 6 | Installation 7 | ------------ 8 | 9 | See the [Installation wiki](https://github.com/monsieurvideo/get-flash-videos/wiki/Installation). 10 | 11 | Development 12 | ----------- 13 | 14 | See the [Development wiki](https://github.com/monsieurvideo/get-flash-videos/wiki/Developing). 15 | 16 | License 17 | ------- 18 | [Apache License 2.0](http://www.apache.org/licenses/LICENSE-2.0) 19 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Cultureunplugged.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Cultureunplugged; 3 | 4 | use strict; 5 | use FlashVideo::JSON; 6 | use FlashVideo::Utils; 7 | use URI::Escape; 8 | 9 | our $VERSION = '0.01'; 10 | sub Version() { $VERSION; } 11 | 12 | sub find_video { 13 | my ($self, $browser, $embed_url) = @_; 14 | 15 | my ($id, $title) = $embed_url =~ m{/play/(\d+)/(.*?)}; 16 | 17 | die "No video ID found" unless $id; 18 | 19 | $browser->get("http://www.cultureunplugged.com/ajax/getMovieInfo.php?movieId=$id&type="); 20 | my ($json) = from_json($browser->content); 21 | return $json->{'url'}, title_to_filename($json->{'title'}, "mp4"); 22 | } 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Pennyarcade.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Pennyarcade; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url) = @_; 9 | 10 | my $id; 11 | my $title; 12 | if ($browser->content =~/<h2>(.*?)<\/h2>/) { 13 | $title = $1; 14 | $title =~ s/<[^>]*>//g; 15 | } 16 | if ($browser->content =~/http:\/\/blip.tv\/play\/(.*).html/) { 17 | $id = $1; 18 | } else { 19 | die "No ID found\n"; 20 | } 21 | 22 | # They actually check this... 23 | $browser->add_header("User-Agent" => "Android"); 24 | $browser->allow_redirects; 25 | return "http://blip.tv/play/$id.mp4", title_to_filename($title); 26 | } 27 | 28 | 1; 29 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Sapo.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Sapo; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser) = @_; 9 | 10 | my ($video_url, $type); 11 | 12 | if ($browser->content =~ m{flvplayer-sapo\.swf\?file=(http://[^&"]+)}) { 13 | $video_url = $1; 14 | 15 | if ($video_url =~ m{/mov}) { 16 | $type = "mp4"; 17 | } 18 | } 19 | else { 20 | die "Couldn't extract Sapo video URL"; 21 | } 22 | 23 | (my $title = extract_title($browser)) =~ s/ - SAPO V\x{ed}deos//; 24 | 25 | my $filename = title_to_filename($title, $type); 26 | 27 | $browser->allow_redirects(1); 28 | 29 | return $video_url, $filename; 30 | } 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Mylifetime.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Mylifetime; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use base 'FlashVideo::Site::Brightcove'; 7 | 8 | my $JS_RE = qr/displayFlash\(/; 9 | 10 | sub find_video { 11 | my($self, $browser, $embed_url) = @_; 12 | 13 | my($player_id, $video_id) = $browser->content =~ /$JS_RE\s*"(\d+)",\s*"(\d+)"/; 14 | die "Unable to extract video ids" unless $video_id; 15 | 16 | return $self->amfgateway($browser, $player_id, { videoId => $video_id }); 17 | } 18 | 19 | sub can_handle { 20 | my($self, $browser, $url) = @_; 21 | 22 | # can only handle videos embedded with this javascript code. 23 | return $browser->content =~ $JS_RE; 24 | } 25 | 26 | 1; 27 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Gamespot.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Gamespot; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url) = @_; 9 | 10 | my($params) = $browser->content =~ /xml.php\?(id=[0-9]+.*?)"/; 11 | ($params) = $embed_url =~ /xml.php%3F(id%3D[^"&]+)/ unless $params; 12 | die "No params found\n" unless $params; 13 | 14 | $browser->get("http://www.gamespot.com/pages/video_player/xml.php?" . $params); 15 | 16 | my $xml = from_xml($browser); 17 | 18 | my $title = $xml->{playList}->{clip}->{title}; 19 | my $url = $xml->{playList}->{clip}->{URI}; 20 | 21 | $browser->allow_redirects; 22 | return $url, title_to_filename($title); 23 | } 24 | 25 | 1; 26 | 27 | -------------------------------------------------------------------------------- /Makefile.bsd-wrapper: -------------------------------------------------------------------------------- 1 | # For OpenBSD wrapper to avoid using Gnu make. 2 | # Makefile is overloaded as 3 | # perl Makefile.PL overwrites. 4 | 5 | all:: 6 | 7 | mk/makemaker-wrap.mk: Makefile.PL 8 | @if [ ! -f "mk/makemaker.mk" ]; then GFV_DEVEL_MODE=1 perl Makefile.PL; fi 9 | @echo "-include mk/makemaker.mk" > $@ 10 | 11 | mk/makemaker.mk : Makefile.PL get_flash_videos 12 | GFV_DEVEL_MODE=1 perl Makefile.PL 13 | 14 | # Only used in testiing github creates archives for download. 15 | OBSDDISTNAME=${DISTVNAME:S/^App-//} 16 | distgit: 17 | git archive --format=tar.gz --prefix=${OBSDDISTNAME}/ \ 18 | -o ${OBSDDISTNAME}.tar.gz ${VERSION}^{tree} 19 | 20 | # No longer used. 21 | cleandistgit: clean 22 | rm ${OBSDDISTNAME}.tar.gz 23 | 24 | -include mk/makemaker-wrap.mk 25 | include mk/targets.mk 26 | include mk/release.mk 27 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Last.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Last; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | sub find_video { 9 | my ($self, $browser, $embed_url) = @_; 10 | 11 | my($artist, $id) = $embed_url =~ m{/([^/]+)/\+videos/(\d+)}; 12 | my($title) = $browser->content =~ /<h1>([^<]+)/; 13 | 14 | die "No video ID found" unless $id; 15 | 16 | $browser->get("http://ext.last.fm/1.0/video/getplaylist.php?&vid=$id&artist=$artist"); 17 | 18 | return $browser->content =~ /<location>([^<]+)/, title_to_filename($title); 19 | } 20 | 21 | sub can_handle { 22 | my($self, $browser, $url) = @_; 23 | 24 | # Don't trigger on YouTube IDs 25 | return $url =~ /last\.fm/ && $url =~ m{\+video/\d{2,}}; 26 | } 27 | 28 | 1; 29 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Techcast.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Techcast; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use HTML::Entities; 7 | 8 | sub find_video { 9 | my ($self, $browser, $embed_url) = @_; 10 | 11 | my($clip_url) = $browser->content =~ /clip:\s*{\s*url:\s*['"]([^"']+)/; 12 | die "Unable to extract clip URL" unless $clip_url; 13 | $clip_url = URI->new_abs($clip_url, $browser->uri); 14 | 15 | my($talk) = $browser->content =~ /class="lecture_archive"[^>]+>([^<]+)/i; 16 | $talk = decode_entities($talk); 17 | 18 | my($author) = $browser->content =~ /class="speaker_archive"[^>]+>([^<]+)/i; 19 | $author = decode_entities($author); 20 | 21 | return $clip_url, title_to_filename($talk ? "$author - $talk" : $clip_url); 22 | } 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Fora.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Fora; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url) = @_; 9 | 10 | my($clip_id) = $browser->content =~ /clipid=(\d+)/; 11 | die "Unable to extract clipid" unless $clip_id; 12 | 13 | $browser->get("http://fora.tv/fora/fora_player_full?cid=$clip_id&h=1&b=0"); 14 | 15 | my $xml = from_xml($browser); 16 | 17 | my $filename = title_to_filename($xml->{clipinfo}->{clip_title}); 18 | 19 | my $playpath = $xml->{encodeinfo}->{encode_url}; 20 | $playpath =~ s/\.flv$//; 21 | 22 | return { 23 | flv => $filename, 24 | app => "a953/o10", 25 | rtmp => "rtmp://foratv.fcod.llnwd.net", 26 | playpath => $playpath, 27 | }; 28 | } 29 | 30 | 1; 31 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Videolectures.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Videolectures; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser) = @_; 9 | 10 | my $author = ($browser->content =~ /author:\s*<\/span><a [^>]+>([^<]+)/s)[0]; 11 | my $title = ($browser->content =~ /<h2>([^<]+)/)[0]; 12 | 13 | my $streamer = ($browser->content =~ /clip\.netConnectionUrl\s*=\s*["']([^"']+)/)[0]; 14 | my $playpath = ($browser->content =~ /clip\.url\s*=\s*["']([^"']+)/)[0]; 15 | $playpath =~ s/\.flv$//; 16 | 17 | my $data = { 18 | app => (split m{/}, $streamer)[-1], 19 | rtmp => $streamer, 20 | playpath => $playpath, 21 | flv => title_to_filename("$author - $title") 22 | }; 23 | 24 | return $data; 25 | } 26 | 27 | 1; 28 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Nhk.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Nhk; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | our $VERSION = '0.01'; 9 | sub Version() {$VERSION;} 10 | 11 | sub find_video { 12 | my ($self, $browser, $embed_url) = @_; 13 | 14 | # Grab the file from the page.. 15 | my $url = ($browser->content =~ /<div id="news_video">(.+?)</)[0]; 16 | die "Unable to extract url" unless $url; 17 | 18 | # Extract filename from page and format 19 | 20 | # title_to_filename() can't extract extension from URLs like 21 | # foo.flv?stuff - should probably change, but for now don't bother 22 | # passing in the URL. (Will default to .flv) 23 | 24 | return { rtmp => "rtmp://flv.nhk.or.jp/ondemand/flv/news/".$url, 25 | flv => $url}; 26 | } 27 | 28 | 1; 29 | -------------------------------------------------------------------------------- /t/google_video_search.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | no warnings; 4 | use lib qw(..); 5 | use Test::More; 6 | use FlashVideo::Site::Googlevideosearch; 7 | 8 | { 9 | my $mech = FlashVideo::Mechanize->new; 10 | $mech->get("http://www.google.com"); 11 | plan skip_all => "We don't appear to have an internet connection" if $mech->response->is_error; 12 | } 13 | 14 | plan tests => 2; 15 | 16 | my @results = FlashVideo::Site::Googlevideosearch->search('Iron Man trailer'); 17 | 18 | ok(@results > 1, "Results returned"); 19 | 20 | # Check to see if the results look sane 21 | my $sane_result_count = 0; 22 | 23 | foreach my $result (@results) { 24 | if ((ref($result) eq 'HASH') and 25 | $result->{name} and 26 | $result->{url} =~ m'^https?://') { 27 | $sane_result_count++; 28 | } 29 | } 30 | 31 | ok($sane_result_count == @results, "Results look sane"); 32 | -------------------------------------------------------------------------------- /utils/combine-tail: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # get_flash_videos -- download all the Flash videos off a web page 4 | # 5 | # http://code.google.com/p/get-flash-videos/ 6 | # 7 | # Copyright 2009, zakflash and MonsieurVideo 8 | # 9 | 10 | # Fix up for modules only used once giving compile warnings 11 | # use a second time to stop typo warning.... 12 | 13 | use HTTP::Headers qw(referrer); 14 | use HTTP::Request qw(url); 15 | my $dummy = $IO::Uncompress::Bunzip2::Bunzip2Error; 16 | $dummy = $IO::Uncompress::Inflate::InflateError; 17 | $dummy = $IO::Compress::Bzip2::Bzip2Error; 18 | $dummy = $IO::Compress::Deflate::DeflateError; 19 | $dummy = $HTTP::Status::RC_MOVED_TEMPORARILY; 20 | $dummy = $HTTP::Status::RC_NO_CODE; 21 | $dummy = $XML::Simple::xml_out; 22 | $dummy = $XML::Simple::xml_in; 23 | $dummy = $XML::SAX::ParserPackage; 24 | $dummy = $Net::HTTPS::blocking; 25 | 26 | 1; 27 | -------------------------------------------------------------------------------- /lib/FlashVideo/VideoPreferences.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::VideoPreferences; 3 | 4 | use strict; 5 | use FlashVideo::VideoPreferences::Quality; 6 | use FlashVideo::VideoPreferences::Account; 7 | 8 | sub new { 9 | my($class, %opt) = @_; 10 | 11 | return bless { 12 | raw => $opt{raw} || 0, 13 | quality => $opt{quality} || "high", 14 | subtitles => $opt{subtitles} || 0, 15 | type => $opt{type} || "", 16 | }, $class; 17 | } 18 | 19 | sub quality { 20 | my($self) = @_; 21 | 22 | return FlashVideo::VideoPreferences::Quality->new($self->{quality}); 23 | } 24 | 25 | sub subtitles { 26 | my($self) = @_; 27 | 28 | return $self->{subtitles}; 29 | } 30 | 31 | sub account { 32 | my($self, $site, $prompt) = @_; 33 | 34 | return FlashVideo::VideoPreferences::Account->new($site, $prompt); 35 | } 36 | 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Xhamster.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Xhamster; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser) = @_; 9 | 10 | my $server; 11 | if ($browser->content =~ m{'srv': '(http://[^'"]+)'}) { 12 | $server = $1; 13 | } 14 | else { 15 | die "Couldn't determine xhamster server"; 16 | } 17 | 18 | my $video_file; 19 | if ($browser->content =~ m{'file': '([^'"]+\.flv)'}) { 20 | $video_file = $1; 21 | } 22 | else { 23 | die "Couldn't determine xhamster video filename"; 24 | } 25 | 26 | my $filename = title_to_filename(extract_title($browser)); 27 | 28 | my $url = sprintf "%s/flv2/%s", $server, $video_file; 29 | 30 | # I want to follow redirects now 31 | $browser->allow_redirects; 32 | 33 | return $url, $filename; 34 | } 35 | 36 | 1; 37 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Xnxx.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Xnxx; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | sub find_video { 9 | my ($self, $browser, $embed_url) = @_; 10 | 11 | # Grab the file from the page.. 12 | my $url = ($browser->content =~ /flv_url=(.+?)&/)[0]; 13 | $url = uri_unescape($url); 14 | die "Unable to extract url" unless $url; 15 | 16 | # Extract filename from page and format 17 | $browser->content =~ /(?:<span class="style5">|<td style="font-size: 20px;">\s*)<strong>([^<]+)/; 18 | 19 | # title_to_filename() can't extract extension from URLs like 20 | # foo.flv?stuff - should probably change, but for now don't bother 21 | # passing in the URL. (Will default to .flv) 22 | my $filename = title_to_filename($1); 23 | 24 | return $url, $filename; 25 | } 26 | 27 | 1; 28 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Aniboom.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Aniboom; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url) = @_; 9 | 10 | my ($id, $url, $title); 11 | 12 | if ($browser->uri->as_string =~ /\/animation-video\/(\d*)\/([^\/]*)/) { 13 | $id = $1; 14 | $title = $2; 15 | $title =~ s/-/ /g; 16 | } else { 17 | die "Could not detect video ID!"; 18 | } 19 | 20 | $browser->get("http://www.aniboom.com/animations/player/handlers/animationDetails.aspx?mode=&movieid=$id"); 21 | 22 | if ($browser->content =~ /(?:mp4|flv)=([^&]*)/) { 23 | $url = $1; 24 | $url =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; 25 | } else { 26 | die "Could not get flv/mp4 location!"; 27 | } 28 | 29 | return $url, title_to_filename($title); 30 | } 31 | 32 | 1; 33 | 34 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Video44.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Video44; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | our $VERSION = '0.01'; 9 | sub Version() { $VERSION; } 10 | 11 | sub find_video { 12 | my ($self, $browser, $embed_url) = @_; 13 | 14 | my $flashvars = ""; 15 | my $file = ""; 16 | my $url = ""; 17 | my $name = ""; 18 | 19 | debug ("Content: " . $browser->content); 20 | if ($browser->content =~ /file: "(http:[^"]*\.(flv|mp4))",/) { 21 | $file = $1; 22 | } else { 23 | debug("Can't find file"); 24 | return; 25 | } 26 | 27 | debug("File: " . $file); 28 | 29 | $url = uri_unescape($file); 30 | debug("URL: '" . $url . "'"); 31 | 32 | # URL ends with filename 33 | $name = $url; 34 | $name =~ s/.*\/([^\/]+)/$1/; 35 | return $url, title_to_filename($name); 36 | } 37 | 38 | 1; 39 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Zshare.pm: -------------------------------------------------------------------------------- 1 | # A get-flash-videos module for the zshare.net website 2 | # Copyright (C) 2011 Rudolf Olah <rolah@goaugust.com> 3 | # Licensed under the GNU GPL v3 or later 4 | 5 | # Created using the instructions from: http://code.google.com/p/get-flash-videos/wiki/AddingSite 6 | 7 | package FlashVideo::Site::Zshare; 8 | 9 | use strict; 10 | use FlashVideo::Utils; 11 | 12 | sub find_video { 13 | my ($self, $browser, $embed_url, $prefs) = @_; 14 | # $browser is a WWW::Mechanize object 15 | # $embed_url will normally be the same as the page, but in the case 16 | # of embedded content it may differ. 17 | $embed_url = ($browser->content =~ /iframe src="(.*videoplayer.*?)"/i)[0]; 18 | $browser->get($embed_url); 19 | my $url = ($browser->content =~ /file:.*"(.*?)"/i)[0]; 20 | my $filename = ($browser->content =~ /<title>.*?- (.*)<\/title>/i)[0]; 21 | return $url, $filename; 22 | } 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Expertvillage.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Expertvillage; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | sub find_video { 9 | my ($self, $browser) = @_; 10 | 11 | my($fn) = $browser->content =~ /SWFObject\(['"][^'"]+flv=([^'"]+)/; 12 | my $embedvars = uri_unescape($browser->content =~ /embedvars['"],\s*['"]([^'"]+)/); 13 | die "Unable to find video info" unless $fn and $embedvars; 14 | 15 | my($title) = $browser->content =~ m{<h1[^>]*>(.*)</h1>}s; 16 | my $filename = title_to_filename($title); 17 | 18 | $browser->get("$embedvars?fn=$fn"); 19 | die "Unable to get emebdding info" if $browser->response->is_error; 20 | 21 | my $url = uri_unescape($browser->content =~ /source=([^&]+)/); 22 | die "Unable to find video URL" unless $url; 23 | 24 | return $url, $filename; 25 | } 26 | 27 | 1; 28 | -------------------------------------------------------------------------------- /t/00_load.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use warnings; 4 | use strict; 5 | use Test::More tests => 20; 6 | 7 | BEGIN { 8 | chdir 't' if -d 't'; 9 | push @INC, '../lib'; 10 | 11 | my @classes = qw( 12 | Compress::Zlib 13 | FlashVideo::Downloader 14 | FlashVideo::Generic 15 | FlashVideo::Mechanize 16 | FlashVideo::RTMPDownloader 17 | FlashVideo::Search 18 | FlashVideo::Site 19 | FlashVideo::URLFinder 20 | FlashVideo::Utils 21 | FlashVideo::VideoPreferences 22 | HTML::Entities 23 | HTML::TokeParser 24 | HTTP::Config 25 | HTTP::Cookies 26 | HTTP::Request::Common 27 | LWP::Protocol::http 28 | Tie::IxHash 29 | URI 30 | WWW::Mechanize 31 | XML::Simple 32 | ); 33 | 34 | foreach my $class (@classes) { 35 | use_ok $class or BAIL_OUT("Could not load $class"); 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /utils/combine-header: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # get_flash_videos -- download all the Flash videos off a web page 4 | # 5 | # http://code.google.com/p/get-flash-videos/ 6 | # 7 | # Copyright 2009, zakflash and MonsieurVideo 8 | # 9 | # Licensed under the Apache License, Version 2.0 (the "License"); you may 10 | # not use this file except in compliance with the License. You may obtain a 11 | # copy of the License at 12 | # http://www.apache.org/licenses/LICENSE-2.0 13 | # Unless required by applicable law or agreed to in writing, software 14 | # distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 15 | # WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 16 | # License for the specific language governing permissions and limitations 17 | # under the License. 18 | # 19 | # Contributions are welcome and encouraged, but please take care to 20 | # maintain the JustWorks(tm) nature of the program. 21 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Collegehumor.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Collegehumor; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url) = @_; 9 | my $base = "http://www.collegehumor.com/moogaloop"; 10 | 11 | my $id; 12 | if($browser->content =~ /video:(\d+)/) { 13 | $id = $1; 14 | } elsif($embed_url =~ m![/:](\d+)!) { 15 | # XXX: This is broken still... 16 | # I don't know a good way to turn new IDs to old IDs, I may just load the page based on this id and then go back to the first case 17 | $id = $1; 18 | } 19 | die "No ID found\n" unless $id; 20 | 21 | $browser->get("$base/video:$id"); 22 | 23 | my $xml = from_xml($browser); 24 | 25 | my $title = $xml->{video}->{caption}; 26 | $title = extract_title($browser) if ref $title; 27 | 28 | return $xml->{video}->{file}, title_to_filename($title); 29 | } 30 | 31 | 1; 32 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Bing.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Bing; 3 | use strict; 4 | use FlashVideo::Utils; 5 | 6 | sub find_video { 7 | my ($self, $browser, $embed_url, $prefs) = @_; 8 | 9 | my $count = 0; 10 | while((my $location = $browser->response->header("Location")) && $count++ < 5) { 11 | $browser->get($location); 12 | } 13 | 14 | my $title; 15 | if ($browser->content =~ /sourceFriendly:\s*'([^']+)'[\s\S]+?\s*title:\s*'([^']+)'/) { 16 | $title = "$1 - $2"; 17 | } 18 | 19 | my $url; 20 | if ($browser->content =~ /formatCode:\s*1003,\s*url:\s*'([^']+)'/) { 21 | $url = $1; 22 | 23 | # Unencode the url 24 | $url =~ s/\\x([0-9a-f]{2})/chr hex $1/egi; 25 | } 26 | die "Unable to extract video url" unless $url; 27 | 28 | # MSNBC hosted videos use 302 redirects 29 | $browser->allow_redirects; 30 | 31 | return $url, title_to_filename($title); 32 | } 33 | 34 | 1; 35 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Ima.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Ima; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser) = @_; 9 | 10 | my($id) = $browser->uri =~ /id=(\d+)/; 11 | die "ID not found" unless $id; 12 | 13 | my $rpc = "http://www.ima.umn.edu/videos/video_rpc.php?id=$id"; 14 | $browser->get($rpc); 15 | 16 | my($title) = $browser->content =~ m{<video_title>(.*)</video_title>}; 17 | my($instance) = $browser->content =~ m{<video_instance>(.*)</video_instance>}; 18 | my($file) = $browser->content =~ m{<video_file>(.*)</video_file>}; 19 | 20 | return { 21 | rtmp => "rtmp://reel.ima.umn.edu/ima/$instance/$file", 22 | flv => title_to_filename($title) 23 | }; 24 | } 25 | 26 | sub can_handle { 27 | my($self, $browser, $url) = @_; 28 | 29 | my $host = URI->new($url)->host; 30 | return $host =~ /ima\.umn\.edu/i; 31 | } 32 | 33 | 1; 34 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/About.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::About; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use base 'FlashVideo::Site::Brightcove'; 7 | 8 | my $JS_RE = qr/vdo_None\.js/; 9 | 10 | sub find_video { 11 | my($self, $browser, $embed_url) = @_; 12 | 13 | my($video_ref) = $browser->content =~ /zIvdoId=["']([^"']+)/; 14 | die "Unable to extract video ref" unless $video_ref; 15 | 16 | my($js_src) = $browser->content =~ /["']([^"']+$JS_RE)/; 17 | $browser->get($js_src); 18 | my($player_id) = $browser->content =~ /playerId.*?(\d+)/; 19 | die "Unable to extract playerId" unless $player_id; 20 | 21 | return $self->amfgateway($browser, $player_id, { videoRefId => $video_ref }); 22 | } 23 | 24 | sub can_handle { 25 | my($self, $browser, $url) = @_; 26 | 27 | # can only handle videos embedded with this javascript code. 28 | return $browser->content =~ $JS_RE; 29 | } 30 | 31 | 1; 32 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Filebox.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | 3 | package FlashVideo::Site::Filebox; 4 | 5 | use strict; 6 | use FlashVideo::Utils; 7 | 8 | sub find_video { 9 | my ($self, $browser, $embed_url) = @_; 10 | 11 | my $pause = 5; #if we don't pause, we don't get the proper video page 12 | info 'Pausing for '.$pause.' seconds (or the server won\'t respond)...'; 13 | sleep($pause); 14 | 15 | my $btn_id = 'btn_download'; #the ID of the button to submit the form 16 | for my $form ($browser->forms) { 17 | if ($form->find_input('#'.$btn_id)){ 18 | info 'Submitting form to get real video page.'; 19 | $browser->request($form->click('#'.$btn_id)); #submit to get the real page 20 | } 21 | } 22 | 23 | my ($filename) = ($browser->content =~ /product_file_name=(.*?)[&'"]/); 24 | my ($url) = ($browser->content =~ /product_download_url=(.*?)[&'"]/); 25 | 26 | return $url, $filename; 27 | } 28 | 29 | 1; 30 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Videofun.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Videofun; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | our $VERSION = '0.01'; 9 | sub Version() { $VERSION; } 10 | 11 | sub find_video { 12 | my ($self, $browser, $embed_url) = @_; 13 | 14 | my $coded_url = ""; 15 | my $url = ""; 16 | my $name = ""; 17 | 18 | 19 | # read URL from the configuration passed to flash player 20 | if ($browser->content =~ /\s*{url: "(http[^"]+)".*autoBuffering.*/) { 21 | $coded_url = $1; 22 | } else { 23 | # if we can't get it, just leave as the video URL is there 24 | return; 25 | } 26 | 27 | debug ("Coded URL: " . $coded_url); 28 | 29 | 30 | $url = uri_unescape($coded_url); 31 | debug("URL: '" . $url . "'"); 32 | 33 | # URL ends with filename 34 | $name = $url; 35 | $name =~ s/.*\/([^\/]+)\?.*/$1/; 36 | return $url, title_to_filename($name); 37 | } 38 | 39 | 1; 40 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Theonion.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Theonion; # horrible casing :( 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser) = @_; 9 | 10 | if ($browser->response->is_redirect) { 11 | $browser->get( $browser->response->header('Location') ); 12 | 13 | if (!$browser->success) { 14 | die "Couldn't follow Onion redirect: " . 15 | $browser->response->status_line; 16 | } 17 | } 18 | 19 | my $title; 20 | if ($browser->content =~ /var video_title = "([^"]+)"/) { 21 | $title = $1; 22 | } 23 | else { 24 | $title = extract_info($browser)->{meta_title}; 25 | } 26 | 27 | my $filename = title_to_filename($title); 28 | 29 | # They now pass the URL as a param, so the generic code can extract it. 30 | my $url = (FlashVideo::Generic->find_video($browser, $browser->uri))[0]; 31 | 32 | return $url, $filename; 33 | } 34 | 35 | 1; 36 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Todaysbigthing.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Todaysbigthing; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | my $base = "http://www.todaysbigthing.com/betamax"; 8 | 9 | sub find_video { 10 | my ($self, $browser, $embed_url) = @_; 11 | 12 | my $id; 13 | if($browser->content =~ /item_id=(\d+)/) { 14 | $id = $1; 15 | } elsif($embed_url =~ m![/:](\d+)!) { 16 | $id = $1; 17 | } 18 | die "No ID found\n" unless $id; 19 | 20 | $browser->get("$base:$id"); 21 | 22 | my $xml = from_xml($browser); 23 | 24 | my $title = $xml->{title}; 25 | $title = extract_title($browser) if ref $title; 26 | my $filename = title_to_filename($title); 27 | 28 | my $url = $xml->{flv}; 29 | die "No FLV location" unless $url; 30 | 31 | return $url, $filename; 32 | } 33 | 34 | sub can_handle { 35 | my($self, $browser, $url) = @_; 36 | 37 | return $browser->content =~ $base; 38 | } 39 | 40 | 1; 41 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Vidzur.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Vidzur; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | our $VERSION = '0.01'; 9 | sub Version() { $VERSION; } 10 | 11 | sub find_video { 12 | my ($self, $browser, $embed_url) = @_; 13 | 14 | my $coded_url = ""; 15 | my $url = ""; 16 | my $name = ""; 17 | 18 | 19 | # read URL from the configuration passed to flash player 20 | if ($browser->content =~ /\s*url: '(http:\/\/[^']+vidzur.com%2Fvideos%2F[^']+)',.*/) { 21 | $coded_url = $1; 22 | } else { 23 | # if we can't get it, just leave as the video URL is there 24 | return; 25 | } 26 | 27 | debug ("Coded URL: " . $coded_url); 28 | 29 | 30 | $url = uri_unescape($coded_url); 31 | debug("URL: '" . $url . "'"); 32 | 33 | # URL ends with filename 34 | $name = $url; 35 | $name =~ s/.*\/([^\/]+)\?.*/$1/; 36 | return $url, title_to_filename($name); 37 | } 38 | 39 | 1; 40 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Facebook.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Facebook; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | use URI::Escape; 8 | 9 | our $VERSION = '0.01'; 10 | sub Version { $VERSION; } 11 | 12 | sub find_video { 13 | my ($self, $browser, $embed_url) = @_; 14 | 15 | # If we should process Facebook's Like button, leave 16 | return if ($embed_url =~ /http:\/\/www\.facebook\.com\/plugins\/like\.php/); 17 | 18 | # Grab the file from the page.. 19 | my $params = ($browser->content =~ /\["params","(.+?)"\]/)[0]; 20 | $params =~ s/\\u([[:xdigit:]]{1,4})/chr(eval("0x$1"))/egis; 21 | $params = uri_unescape($params); 22 | my $url = ($params =~ /"hd_src":"([^"]*)"/)[0]; 23 | if (!$url) { $url = ($params =~ /"sd_src":"([^"]*)"/)[0]; } 24 | $url =~ s/\\\//\//g; 25 | die "Unable to extract url" unless $url; 26 | 27 | my $filename = ($url =~ /([^\/]*)\?/)[0]; 28 | 29 | return $url, $filename; 30 | } 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Movieclips.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Movieclips; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url) = @_; 9 | 10 | my $video_id = ($browser->content =~ /<meta name="video_id" content="([^"]+)"/i)[0]; 11 | 12 | debug "video_id = " . $video_id; 13 | 14 | $browser->get("http://config.movieclips.com/player/config/embed/$video_id/?loc=US"); 15 | 16 | my $xml = from_xml($browser->content); 17 | 18 | my $playpath = $xml->{video}->{properties}->{file_path}; 19 | 20 | my $title = $xml->{video}->{properties}->{clip_title}; 21 | 22 | debug $playpath; 23 | debug title_to_filename($title); 24 | 25 | return { 26 | flv => title_to_filename($title, 'flv'), 27 | swfUrl => "http://static.movieclips.com/embedplayer.swf?shortid=$video_id", 28 | app => "ondemand", 29 | rtmp => "rtmp://media.movieclips.com", 30 | playpath => $playpath 31 | }; 32 | } 33 | 34 | 1; 35 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Spike.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Spike; 3 | 4 | use strict; 5 | use base 'FlashVideo::Site::Mtvnservices'; 6 | 7 | use FlashVideo::Utils; 8 | use URI::Escape; 9 | 10 | sub find_video { 11 | my ($self, $browser, $embed_url) = @_; 12 | 13 | my $page_url = $browser->uri->as_string; 14 | 15 | my $config_url; 16 | if($browser->content =~ /config_url\s*=\s*["']([^"']+)/) { 17 | $config_url = $1; 18 | } elsif($browser->content =~ /(?:ifilmId|flvbaseclip)=(\d+)/) { 19 | $config_url = "/ui/xml/mediaplayer/config.groovy?ifilmId=$1"; 20 | } 21 | die "No config_url/id found\n" unless $config_url; 22 | 23 | $browser->get(uri_unescape($config_url)); 24 | my $xml = from_xml($browser); 25 | 26 | my $feed = uri_unescape($xml->{player}->{feed}); 27 | die "Unable to find feed URL\n" unless $feed; 28 | 29 | $browser->get($feed); 30 | 31 | return $self->handle_feed($browser->content, $browser, $page_url); 32 | } 33 | 34 | 1; 35 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Munkvideo.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Munkvideo; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | our $VERSION = '0.01'; 9 | sub Version() { $VERSION; } 10 | 11 | sub find_video { 12 | my ($self, $browser, $embed_url) = @_; 13 | 14 | my $url = ""; 15 | 16 | 17 | # read URL from the configuration passed to flash player 18 | if ($embed_url =~ /(http:\/\/www.munkvideo.cz\/video\/[^?]+)?.*/) { 19 | $url = "$1?munkvideo=original"; 20 | } else { 21 | # if we can't get it, just leave as the video URL is there 22 | return; 23 | } 24 | 25 | # $browser->allow_redirects; 26 | # obtained URL will be redirected 27 | $browser->get($url); 28 | $url = $browser->response->header('Location'); 29 | if ($url =~ /http:\/\/www\.munkvideo\.cz\/error\.php?type=video_missing/) { 30 | return; 31 | } 32 | debug("URL: '" . $url . "'"); 33 | 34 | return $url, title_to_filename($url); 35 | } 36 | 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Truveo.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Truveo; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my($self, $browser, $embed_url, $prefs) = @_; 9 | 10 | my($videourl) = $browser->content =~ /var videourl = "(.*?)"/; 11 | 12 | # Maybe we were given a direct URL.. 13 | $videourl = $embed_url 14 | if !$videourl && $browser->uri->host eq 'xml.truveo.com'; 15 | 16 | die "videourl not found" unless $videourl; 17 | 18 | $browser->get($videourl); 19 | 20 | if($browser->content =~ /url=(http:.*?)["']/) { 21 | my $redirect = url_exists($browser, $1); 22 | 23 | $browser->get($redirect); 24 | 25 | my($package, $possible_url) = FlashVideo::URLFinder->find_package($redirect, $browser); 26 | 27 | die "Recursion detected" if $package eq __PACKAGE__; 28 | 29 | return $package->find_video($browser, $possible_url, $prefs); 30 | } else { 31 | die "Redirect URL not found"; 32 | } 33 | } 34 | 35 | 1; 36 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Nicovideo.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Nicovideo; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | sub find_video { 9 | my ($self, $browser, $embed_url) = @_; 10 | my $id = ($embed_url =~ /([ns]m\d+)/)[0]; 11 | die "No ID found\n" unless $id; 12 | 13 | my $base = "http://ext.nicovideo.jp/thumb_watch/$id"; 14 | 15 | if($embed_url !~ /ext\.nicovideo\.jp\/thumb_watch/) { 16 | $embed_url = "$base?w=472&h=374&n=1"; 17 | } 18 | 19 | $browser->get($embed_url); 20 | my $playkey = ($browser->content =~ /'thumbPlayKey': '([^']+)/)[0]; 21 | die "No playkey found\n" unless $playkey; 22 | 23 | my $title = ($browser->content =~ /title: '([^']+)'/)[0]; 24 | $title =~ s/\\u([a-f0-9]{1,5})/chr hex $1/eg; 25 | 26 | $browser->get($base . "/$playkey"); 27 | my $url = uri_unescape(($browser->content =~ /url=([^&]+)/)[0]); 28 | 29 | return $url, title_to_filename($title, $id =~ /^nm/ ? "swf" : "flv"); 30 | } 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Abclocal.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Abclocal; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use Data::Dumper; 7 | use File::Basename; 8 | 9 | sub find_video { 10 | my ($self, $browser, $embed_url, $prefs) = @_; 11 | 12 | my($station,$id) = $browser->content =~ m{http://cdn.abclocal.go.com/[^"']*station=([^&;"']+)[^"']*mediaId=([^&;"']+)}s; 13 | 14 | die "No media id and station found" unless $id; 15 | 16 | $browser->get("http://cdn.abclocal.go.com/$station/playlistSyndicated?id=$id"); 17 | 18 | my @tmp = $browser->content =~ m{<video *videopath="([^"]*)"[^>]*width="([^"]*)"[^>]*height="([^"]*)"[^>]*>}s ; 19 | my(@videos); 20 | for (my $i = 0; $i < @tmp; $i+=3) 21 | { 22 | push @videos, { "playpath" => $tmp[$i], "resolution" => [$tmp[$i+1], $tmp[$i+2]] }; 23 | } 24 | 25 | my $video = $prefs->quality->choose(@videos); 26 | 27 | my $url = $video->{"playpath"}; 28 | 29 | return $url, File::Basename::basename($url); 30 | } 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Ehow.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Ehow; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | sub find_video { 9 | my ($self, $browser) = @_; 10 | 11 | # Get the video ID 12 | my $uri; 13 | if ($browser->content =~ /source=(.*?)[ &]/) { 14 | $uri = $1; 15 | } 16 | else { 17 | die "Couldn't extract video location from page"; 18 | } 19 | 20 | my $title; 21 | if ($browser->content =~ /<h1[^>]* class="[^"]*articleTitle[^"]*"[^>]*>(.*?)<\/h1>/x) { 22 | $title = $1; 23 | } 24 | 25 | if($uri =~ /^http:/) { 26 | return $uri, title_to_filename($title); 27 | } 28 | elsif($uri =~ /http:%3A/) { 29 | # This is the embed, and it's the same but encoded. 30 | $uri = uri_unescape($1); 31 | # Title is also probably wrong 32 | if ($browser->content =~ /<a[^>]*>(.*?)<\/a>/) { 33 | $title = $1; 34 | } 35 | return $uri, title_to_filename($title); 36 | } 37 | else { 38 | die "Couldn't extract Flash video URL from embed page"; 39 | } 40 | } 41 | 42 | 43 | 1; 44 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Gorillavid.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | 3 | #This package handles sites such as GorillaVid.in, DaClips.in and 4 | # MovPod.in 5 | package FlashVideo::Site::Gorillavid; 6 | 7 | use strict; 8 | use FlashVideo::Utils; 9 | 10 | sub find_video { 11 | my ($self, $browser, $embed_url) = @_; 12 | my $filename; 13 | 14 | for my $form ($browser->forms) { 15 | if ($form->find_input('#btn_download')){ 16 | $filename = $form->value('fname'); #extract the filename from the form 17 | 18 | info 'Submitting form to get real video page.'; 19 | $browser->request($form->click()); #submit to get the real page 20 | } 21 | } 22 | 23 | my ($url) = ($browser->content =~ /file: *"(https?:\/\/.*?)"/); 24 | 25 | #derive extension from the filename, if there is one 26 | my ($ext) = ($url =~ /(\.[a-z0-9]{2,4})$/); 27 | 28 | return $url, $filename.$ext; 29 | } 30 | 31 | sub can_handle { 32 | my($self, $browser, $url) = @_; 33 | 34 | return 1 if $url && URI->new($url)->host =~ /(gorillavid|daclips|movpod)\.in$/; 35 | } 36 | 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Grindtv.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Grindtv; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | my %sites = ( 8 | Grindtv => "http://videos.grindtv.com/1/", 9 | Stupidvideos => "http://videos.stupidvideos.com/2/", 10 | Ringtv => "http://videos.ringtv.com/7/" 11 | ); 12 | 13 | sub find_video { 14 | my ($self, $browser, $embed_url) = @_; 15 | 16 | my $site = ($self =~ /::([^:]+)$/)[0]; 17 | my $base = $sites{$site}; 18 | 19 | my $id; 20 | if($browser->content =~ /(?:baseID|video(?:ID)?)\s*=\s*['"]?(\d+)/) { 21 | $id = $1; 22 | } 23 | die "No ID found\n" unless $id; 24 | 25 | my $title = ($browser->content =~ /name="title" content="([^"]+)/i)[0]; 26 | $title = extract_title($browser) unless $title; 27 | 28 | my $filename = title_to_filename($title); 29 | 30 | # I want to follow redirects now. 31 | $browser->allow_redirects; 32 | 33 | my $str = sprintf "%08d", $id; 34 | my $url = $base . join("/", map { substr $str, $_*2, 2 } 0 .. 3) . "/$id.flv"; 35 | 36 | return $url, $filename; 37 | } 38 | 39 | 1; 40 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Googlevideosearch.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Googlevideosearch; 3 | 4 | use strict; 5 | no warnings 'uninitialized'; 6 | use FlashVideo::Mechanize; 7 | use URI::Escape; 8 | 9 | our $VERSION = '0.01'; 10 | sub Version() { $VERSION}; 11 | 12 | sub search { 13 | my($self, $search, $type) = @_; 14 | 15 | my $browser = FlashVideo::Mechanize->new; 16 | 17 | $browser->allow_redirects; 18 | 19 | $browser->get('http://www.google.com/videohp'); 20 | 21 | $browser->submit_form( 22 | with_fields => { 23 | q => $search, 24 | } 25 | ); 26 | 27 | return unless $browser->success; 28 | 29 | my @links = map { 30 | chomp(my $name = $_->text); 31 | my $url = $_->url_abs->as_string; 32 | $url =~ /q=([^&]*)/; 33 | $url = uri_unescape($1); 34 | { name => $name, url => $url } 35 | } 36 | $browser->find_all_links(text_regex => qr/.+/, url_regex => qr/\/url/); 37 | 38 | return @links; 39 | } 40 | 41 | 1; 42 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Pinkbike.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Pinkbike; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url, $prefs) = @_; 9 | my ($url, $filename, $quality); 10 | 11 | # Extract filename from page title 12 | my $title = extract_title($browser); 13 | debug("Found title : " . $title); 14 | 15 | $quality = {high => '1080p', medium => '720p', low => '480p'}->{$prefs->{quality}}; 16 | 17 | if (my $video_id = ($embed_url =~ m/\/video\/(\d+)\/?$/)[0]) { 18 | $url = "http://lv1.pinkbike.org/vf/" . (int($video_id / 10000)) . "/pbvid-" . $video_id . ".flv"; 19 | $filename = title_to_filename($title); 20 | } elsif (my $source = ($browser->content =~ m/<source data-quality=\\"$quality\\" src=\\"(https?:\/\/.+?\.mp4)\\"/)) { 21 | $url = $1; 22 | $filename = title_to_filename($title, 'mp4'); 23 | } 24 | 25 | die "Unable to extract url" unless $url; 26 | debug("Video URL: " . $url); 27 | debug("Filename : " . $filename); 28 | 29 | return $url, $filename; 30 | } 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /debian/copyright: -------------------------------------------------------------------------------- 1 | This package was debianized by MonsieurVideo <monsieurvideo@gmail.com> on 2 | Sun, 26 Apr 2009 12:46:52 +0100. 3 | 4 | It was downloaded from <http://code.google.com/p/get-flash-videos/> 5 | 6 | Upstream Author(s): 7 | 8 | MonsieurVideo <monsieurvideo@gmail.com> 9 | zakflash 10 | 11 | Copyright: 12 | 13 | Copyright 2009 MonsieurVideo 14 | Copyright 2009 zakflash 15 | 16 | License: 17 | Licensed under the Apache License, Version 2.0 (the "License"); you may 18 | not use this file except in compliance with the License. You may obtain a 19 | copy of the License at 20 | http://www.apache.org/licenses/LICENSE-2.0 21 | Unless required by applicable law or agreed to in writing, software 22 | distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 23 | WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 24 | License for the specific language governing permissions and limitations 25 | under the License. 26 | 27 | The Debian packaging is copyright 2009, MonsieurVideo <monsieurvideo@gmail.com> and 28 | is licensed under the GPL, see `/usr/share/common-licenses/GPL'. 29 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Sevenload.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Sevenload; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use HTML::Entities; 7 | use URI::Escape; 8 | 9 | sub find_video { 10 | my ($self, $browser) = @_; 11 | 12 | die "Could not find configPath" unless $browser->content =~ /configPath=([^"']+)/; 13 | my $configpath = uri_unescape(decode_entities($1)); 14 | $browser->get($configpath); 15 | 16 | my $config = from_xml($browser); 17 | 18 | my($title, $location); 19 | 20 | eval { 21 | my $item = $config->{playlists}->{playlist}->{items}->{item}; 22 | $title = title_to_filename($item->{title}); 23 | 24 | my $streams = $item->{videos}->{video}->{streams}->{stream}; 25 | $streams = [ $streams ] unless ref $streams eq 'ARRAY'; 26 | 27 | # Attempt to get the highest definition content 28 | $location = (sort { $b->{width} <=> $a->{width} } @$streams)[0] 29 | ->{locations}->{location}->{content}; 30 | }; 31 | 32 | return $location, $title if $location; 33 | 34 | die "Unable to get stream location" . ($@ ? ": $@" : ""); 35 | } 36 | 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Videobb.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Videobb; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use FlashVideo::JSON; 7 | use MIME::Base64; 8 | 9 | sub find_video { 10 | my ($self, $browser) = @_; 11 | 12 | if($browser->status == 302) { 13 | # in case we get a redirect 14 | $browser->allow_redirects; 15 | $browser->get; 16 | } 17 | my $flash_settings_b64 = ($browser->content =~ /<param value="setting=([^"]+)" name="FlashVars">/s)[0]; 18 | my $flash_settings = decode_base64($flash_settings_b64); 19 | 20 | $browser->get($flash_settings); 21 | 22 | if (!$browser->success) { 23 | die "Couldn't download video settings: " . $browser->response->status_line; 24 | } 25 | 26 | my $settings_data = from_json($browser->content); 27 | 28 | # assuming that the last in the list is the highest res 29 | my $url = decode_base64($settings_data->{settings}{res}->[-1]->{u}); 30 | 31 | my $title = $settings_data->{settings}{video_details}{video}{title}; 32 | my $filename = title_to_filename($title); 33 | 34 | return $url, $filename; 35 | } 36 | 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Vitheque.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Vitheque; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url, $prefs) = @_; 9 | my ($filename, $playpath, $param, $rtmp); 10 | 11 | debug "Vitheque::find_video called, embed_url = \"$embed_url\"\n"; 12 | for my $param($browser->content =~ /(?si)<embed.*?flashvars=["']?([^"'>]+)/gi) { 13 | if($param =~ m{file=([^ &"']+)}) { 14 | debug "playpath: ($1)"; 15 | $playpath = $1; 16 | } 17 | if($param =~ m{(rtmp://[^ &"']+)}) { 18 | debug "rtmp: $1"; 19 | $rtmp = $1; 20 | } 21 | } 22 | if($browser->content =~ /<span id="dnn_ctr1641_ViewVIT_FicheTitre_ltlTitre">(.*?)<\/span>/gi) { 23 | $filename = title_to_filename($1); 24 | } else { 25 | $filename = title_to_filename(File::Basename::basename($playpath)); 26 | } 27 | return { 28 | rtmp => $rtmp, 29 | playpath => "mp4:$playpath", 30 | flv => $filename, 31 | swfVfy => "http://www.vitheque.com/DesktopModules/VIT_FicheTitre/longTail/player-licensed.swf" 32 | }; 33 | } 34 | 35 | 1; 36 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Starwars.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Starwars; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url) = @_; 9 | 10 | my $video_id; 11 | if ($browser->uri->as_string =~ /view\/([0-9]+)\.html$/) { 12 | $video_id = $1; 13 | } 14 | 15 | my $page_url = $browser->uri->as_string; 16 | 17 | $browser->get("http://starwars.com/webapps/video/item/$video_id"); 18 | my $xml = from_xml($browser); 19 | 20 | my $items = $xml->{channel}->{item}; 21 | my $item = ref $items eq 'ARRAY' ? 22 | (grep { $_->{link}->{content} eq "/video/view/" . $video_id . ".html" } @$items)[0] : 23 | $items; 24 | 25 | debug $item->{enclosure}->{url}; 26 | 27 | my $rtmpurl = $item->{enclosure}->{url}; 28 | $rtmpurl =~ s/^rtmp:/rtmpe:/; # for some reason it only works with rtmpe 29 | 30 | my $title = $item->{title}; # is there a way to unencrypt <CDATA> tags? or does the xml handler do this for us? 31 | 32 | return { 33 | flv => $title, 34 | rtmp => title_to_filename($rtmpurl), 35 | playpath => $item->{content}->{url} 36 | }; 37 | } 38 | 39 | 1; 40 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Ardmediathek.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Ardmediathek; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url, $prefs) = @_; 9 | my ($id, $filename, $videourl, $quality); 10 | 11 | $quality = {high => '2', low => '1'}->{$prefs->{quality}}; 12 | 13 | if($embed_url =~ /documentId=(\d+)/) { 14 | $id = $1; 15 | debug "Ardmediathek::find_video called, embed_url = \"$embed_url\"\n"; 16 | debug "documentId: $id\n"; 17 | debug "quality: $quality\n"; 18 | 19 | if($browser->content =~ /addMediaStream\(0, $quality, "(rtmp:\/\/.*?)", "(.*?)"/) { 20 | $videourl = "$1/$2"; 21 | debug "found videourl: $videourl\n"; 22 | if($2 =~ /clip=(.*?)&/) { 23 | $filename = "$1.flv"; 24 | } else { 25 | $filename = "$id.flv"; 26 | } 27 | $filename = title_to_filename($filename); 28 | 29 | $videourl = { 30 | rtmp => $videourl, 31 | swfVfy => "http://www.ardmediathek.de/ard/static/player/base/flash/PluginFlash.swf" 32 | }; 33 | } 34 | } 35 | return $videourl, $filename; 36 | } 37 | 38 | 1; 39 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Scivee.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Scivee; # horrible casing :( 3 | 4 | # for use with Scivee.tv 5 | # 6 | 7 | use strict; 8 | use FlashVideo::Utils; 9 | use HTML::Entities; 10 | sub find_video { 11 | 12 | # print title_to_filename(decode_entities("The+Algorithmic+Lens%3A+How+the+Computational+Perspective+is+Transforming+the+Sciences.mp3")); 13 | # also /asset/audio/$vid 14 | my ($self, $browser) = @_; 15 | 16 | my $title; 17 | if ($browser->content =~ /title\>([^\|]+)/) { 18 | $title = $1; 19 | } 20 | else { 21 | #$title = extract_info($browser)->{meta_title}; 22 | $title = extract_info($browser)->{title}; 23 | } 24 | my $filename = title_to_filename($title); 25 | # since I can't figure how to get the request url 26 | my $vid; 27 | if ($browser->content =~ /\/ratings\/(\d+)/) { 28 | $vid = $1; 29 | } 30 | elsif ($browser->content =~ /flashvars="id=(\d+)/) { 31 | $vid = $1; 32 | } 33 | else { 34 | # print $browser->content; 35 | die "Could not find video!"; 36 | } 37 | my $url = "http://www.scivee.tv/asset/video/$vid"; 38 | 39 | return $url, $filename; 40 | } 41 | 42 | 1; 43 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Tbs.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Tbs; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url) = @_; 9 | 10 | my $oid; 11 | # as in http://www.tbs.com/video/index.jsp?oid=187350 12 | if ($browser->uri->as_string =~ /oid=([0-9]*)/) { 13 | $oid = $1; 14 | } 15 | 16 | $browser->get("http://www.tbs.com/video/cvp/videoData.jsp?oid=$oid"); 17 | 18 | my $xml = from_xml($browser); 19 | 20 | my $headline = $xml->{headline}; 21 | 22 | my $akamai; 23 | if ($xml->{akamai}->{src} =~ /[^,]*,([^,]*)/){ 24 | $akamai = $1; 25 | } 26 | 27 | my $files = $xml->{files}->{file}; 28 | my $file = ref $files eq 'ARRAY' ? 29 | (grep { $_->{type} eq "standard" } @$files)[0] : 30 | $files; 31 | 32 | if($akamai) { 33 | my $rtmpurl = $akamai . $file->{content}; 34 | die "Unable to find RTMP URL\n" unless $rtmpurl; 35 | 36 | return { 37 | flv => title_to_filename($headline), 38 | rtmp => $rtmpurl 39 | }; 40 | } else { 41 | # HTTP download 42 | return $file->{content}, title_to_filename($headline); 43 | } 44 | } 45 | 46 | 1; 47 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Zdf.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Zdf; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url, $prefs) = @_; 9 | my ($id, $filename, $videourl, $quality); 10 | 11 | $quality = {high => 'veryhigh', low => 'low'}->{$prefs->{quality}}; 12 | 13 | debug "Zdf::find_video called, embed_url = \"$embed_url\"\n"; 14 | 15 | if($browser->content =~ /\/video\/(\d*)\/(.*)"/) { 16 | $id = $1; 17 | debug "found video $1 $2\n"; 18 | $filename = title_to_filename($2); 19 | 20 | $browser->get("http://www.zdf.de/ZDFmediathek/xmlservice/web/beitragsDetails?id=$id&ak=web"); 21 | 22 | if($browser->content =~ /(http:\/\/fstreaming\.zdf\.de\/zdf\/$quality\/.*\.meta)/) { 23 | $browser->get($1); 24 | if($browser->content =~ /(rtmp.*)</) { 25 | debug "found rtmp url\"$1\"\n"; 26 | $videourl = { 27 | rtmp => $1, 28 | flv => $filename, 29 | swfVfy => "http://www.zdf.de/ZDFmediatek/flash/player.swf" 30 | }; 31 | } 32 | } 33 | } 34 | return $videourl, $filename; 35 | } 36 | 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/FlashVideo/VideoPreferences/Account.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::VideoPreferences::Account; 3 | 4 | use strict; 5 | 6 | sub new { 7 | my($class, $site, $prompt) = @_; 8 | 9 | require Net::Netrc; # Core since 5.8 10 | 11 | my $record = Net::Netrc->lookup($site); 12 | my($user, $pass) = $record ? $record->lpa : (); 13 | 14 | # Allow only setting user in .netrc if wanted 15 | 16 | if(!$user) { 17 | print $prompt; 18 | 19 | print "Username: "; 20 | chomp($user = <STDIN>); 21 | } 22 | 23 | if(!$pass) { 24 | print "Ok, need your password"; 25 | if(eval { require Term::ReadKey }) { 26 | print ": "; 27 | Term::ReadKey::ReadMode(2); 28 | chomp($pass = <STDIN>); 29 | Term::ReadKey::ReadMode(0); 30 | print "\n"; 31 | } else { 32 | print " (will be displayed): "; 33 | chomp($pass = <STDIN>); 34 | } 35 | } 36 | 37 | return bless { 38 | username => $user, 39 | password => $pass, 40 | }, $class; 41 | } 42 | 43 | sub username { 44 | my($self) = @_; 45 | return $self->{username}; 46 | } 47 | 48 | sub password { 49 | my($self) = @_; 50 | return $self->{password}; 51 | } 52 | 53 | 1; 54 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Metacafe.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Metacafe; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | sub find_video { 9 | my ($self, $browser) = @_; 10 | 11 | if ($browser->response->header("Location") =~ /Openx/) { 12 | # Family filter, turn it off 13 | my $filter = "http://www.metacafe.com/f/index.php?inputType=filter&controllerGroup=user&filters=0&prevURL=" . $browser->uri->path; 14 | debug "Disabling family filter by getting $filter"; 15 | 16 | $browser->allow_redirects; 17 | $browser->get($filter); 18 | } 19 | 20 | my $url; 21 | if ($browser->content =~ m'mediaURL=(http.+?)&') { 22 | $url = uri_unescape($1); 23 | } else { 24 | die "Couldn't find mediaURL parameter."; 25 | } 26 | 27 | if ($browser->content =~ m'gdaKey=(.+?)&') { 28 | $url .= "?__gda__=" . uri_unescape($1); 29 | } else { 30 | # They're now using a session ID on the end of the URL like this: 31 | # ?aksessionid=1255084734240_230066 32 | # but it doesn't seem to actually be required. 33 | } 34 | 35 | my $filename = title_to_filename(extract_title($browser)); 36 | 37 | return ($url, $filename); 38 | } 39 | 40 | 1; 41 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Google.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Google; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | sub find_video { 9 | my ($self, $browser) = @_; 10 | 11 | if ($browser->content =~ /googleplayer\.swf\?doc[iI]d=([^&;'"]+)/) { 12 | $browser->get("http://video.google.com/videoplay?docid=$1"); 13 | } 14 | 15 | if (!$browser->success) { 16 | $browser->get($browser->response->header('Location')); 17 | die "Couldn't download URL: " . $browser->response->status_line 18 | unless $browser->success; 19 | } 20 | 21 | my $url; 22 | if ($browser->content =~ /googleplayer\.swf\?&?videoUrl(.+?)\\x26/) { 23 | $url = uri_unescape($1); 24 | 25 | # Contains JavaScript (presumably) escaping \xHEX, so unescape hackily 26 | $url =~ s/\\x([A-F0-9]{2})/chr(hex $1)/egi; 27 | $url =~ s/^=//; 28 | } 29 | 30 | my $filename = title_to_filename(extract_title($browser)); 31 | 32 | $browser->allow_redirects; 33 | 34 | return $url, $filename; 35 | } 36 | 37 | sub can_handle { 38 | my($self, $browser, $url) = @_; 39 | 40 | return $url =~ m,http://video\.google\.,i 41 | || ($browser->response && $browser->response->header('Location') =~ /google/i) 42 | || $browser->content =~ /googleplayer\.swf/; 43 | } 44 | 45 | 1; 46 | -------------------------------------------------------------------------------- /debian/control: -------------------------------------------------------------------------------- 1 | Source: libapp-get-flash-videos-perl 2 | Section: utils 3 | Priority: optional 4 | Build-Depends: debhelper (>= 7) 5 | Build-Depends-Indep: libmodule-find-perl, 6 | libtie-ixhash-perl, 7 | liburi-perl, 8 | libwww-mechanize-perl, 9 | libwww-perl, 10 | libxml-simple-perl, 11 | perl 12 | Maintainer: Monsieur Video <monsieurvideo@gmail.com> 13 | Standards-Version: 3.8.3 14 | Homepage: http://code.google.com/p/get-flash-videos/ 15 | 16 | Package: get-flash-videos 17 | Architecture: all 18 | Depends: libcrypt-blowfish-pp-perl, 19 | libdata-amf-perl, 20 | libencode-locale-perl, 21 | libhtml-parser-perl, 22 | libhtml-tree-perl, 23 | libmodule-find-perl, 24 | libtie-ixhash-perl, 25 | liburi-perl, 26 | libwww-mechanize-perl, 27 | libwww-perl, 28 | ${misc:Depends}, 29 | ${perl:Depends} 30 | Recommends: get-iplayer, 31 | ffmpeg | libav-tools, 32 | libcrypt-rijndael-perl, 33 | liblwp-protocol-socks-perl, 34 | libxml-simple-perl, 35 | rtmpdump|flvstreamer 36 | Suggests: mplayer 37 | Description: Video downloader for various Flash-based video hosting sites 38 | Download videos from various Flash-based video hosting sites, without having 39 | to use the Flash player. Handy for saving viqeos for watching offline, and 40 | means you don't have to keep upgrading Flash for sites that insist on a newer 41 | version of the player. 42 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Spiegel.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Spiegel; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url, $prefs) = @_; 9 | my ($video_id, $xmlurl, $filename, $videourl, $quality); 10 | 11 | debug "Spiegel::find_video called, embed_url = \"$embed_url\"\n"; 12 | 13 | $quality = { 14 | high => '.mp4', 15 | medium => 'VP6_928.flv', 16 | low => 'VP6_576.flv'}->{$prefs->{quality}}; 17 | 18 | if($embed_url =~ /.*?www.spiegel.de\/video\/video-(\d*).html/) { 19 | $video_id = $1; 20 | $xmlurl = "http://video.spiegel.de/flash/$video_id.xml"; 21 | } else { 22 | die "Only works for http://www.spiegel/de/video/video... urls\n"; 23 | } 24 | 25 | if($browser->content =~ /<title>(.*?) -Video/) { 26 | $filename = "Spiegel_$1_${video_id}_$quality"; 27 | $filename = title_to_filename($filename, $quality); 28 | $filename =~ s/__/_/g; 29 | } else { 30 | die "Unable to find <title> on page $embed_url\n"; 31 | } 32 | 33 | $browser->get($xmlurl); 34 | 35 | if($browser->content =~ /<filename>(.*?$quality)<\/filename>/) { 36 | $videourl = "http://video.spiegel.de/flash/$1"; 37 | } else { 38 | die "could not find video url\n"; 39 | } 40 | 41 | return $videourl, $filename; 42 | } 43 | 44 | 1; 45 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Presstv.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Presstv; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI; 7 | 8 | sub find_video { 9 | my ($self, $browser, $embed_url, $prefs) = @_; 10 | 11 | my $page_url = $browser->uri; 12 | my $swfVfy = ($browser->content =~ /SWFObject\('(http.[^']+)'/i)[0]; 13 | my $rtmp = ($browser->content =~ /'streamer',\s*'(rtmp:[^']+)'/i)[0]; 14 | my $file = ($browser->content =~ /'file',\s*'([^']+)'/i)[0]; 15 | my $app = ($rtmp =~ m%rtmp://[^/]+/(.*)$%)[0]; 16 | my $filename = ($file =~ m%/([^/]+)$%)[0]; 17 | $filename =~ s/:/_/g; 18 | 19 | my @rtmpdump_commands; 20 | 21 | my $args = { 22 | app => $app, 23 | pageUrl => $page_url, 24 | swfVfy => $swfVfy, 25 | rtmp => $rtmp, 26 | playpath => $file, 27 | flv => "$filename.flv", 28 | }; 29 | 30 | push @rtmpdump_commands, $args; 31 | 32 | if (@rtmpdump_commands > 1) { 33 | return \@rtmpdump_commands; 34 | } 35 | else { 36 | return $rtmpdump_commands[-1]; 37 | } 38 | } 39 | 40 | sub can_handle { 41 | my($self, $browser, $url) = @_; 42 | 43 | my $host = URI->new($url)->host; 44 | return 1 if $url && $host =~ /^presstv\.(com|ir)$/; 45 | return 1 if $url && $host =~ /\.presstv\.(com|ir)$/; 46 | debug "Presstv.pm no match found\n"; 47 | return 0; 48 | } 49 | 50 | 1; 51 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Daserste.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Daserste; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use Data::Dumper; 7 | 8 | 9 | sub find_video { 10 | my ($self, $browser, $embed_url, $prefs) = @_; 11 | my ($data_url, $xml, $filename, $videourl, $quality); 12 | 13 | $quality = { 14 | high => "1.69 Web L VOD adative streaming", 15 | medium => "1.63 Web M VOD adaptive streaming", 16 | low => "1.65 Web S VOD adaptive streaming" 17 | }->{$prefs->{quality}}; 18 | 19 | if ($browser->content =~ /dataURL:'(.+?)'/) { 20 | $data_url = "http://www.daserste.de$1"; 21 | debug "Daserste::find_video data_url = \"$data_url\"\n"; 22 | $xml = from_xml($browser->get($data_url)); 23 | debug "Daserste::find_video Title: ". $xml->{video}->{title}; 24 | debug "Daserste::find_video Quality: " . $quality; 25 | foreach my $asset (@{$xml->{video}->{assets}->{asset}}) { 26 | if ($asset->{type} == $quality) { 27 | $videourl = $asset->{fileName}; 28 | debug "Daserste::find_video Videourl: $videourl"; 29 | $filename = $xml->{video}->{title} . ".mp4"; 30 | $filename = title_to_filename($filename); 31 | debug "Daserste::find_video Filename: $filename"; 32 | } 33 | } 34 | } 35 | return $videourl, $filename; 36 | } 37 | 38 | 1; 39 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Vk.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Vk; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | our $VERSION = '0.01'; 8 | sub Version() { $VERSION; } 9 | 10 | sub find_video { 11 | my ($self, $browser, $embed_url) = @_; 12 | my $new_embed_url = ""; 13 | my $title = ""; 14 | my $host = ""; 15 | my $uid = ""; 16 | my $vtag = ""; 17 | my $url = ""; 18 | 19 | # vkontakte.ru is the same page as vk.com, but it redirects to login (?) 20 | if ($embed_url =~ /http:\/\/vkontakte.ru\//) { 21 | $embed_url =~ s/http:\/\/vkontakte.ru\//http:\/\/vk.com\//; 22 | $browser->get($embed_url); 23 | } 24 | 25 | debug ("URI: " . $embed_url); 26 | 27 | if ($browser->content =~ /\s*var video_title = '([^']+)';/) { 28 | $title = $1; 29 | debug ("Title: '" . $title . "'"); 30 | } 31 | 32 | return unless ($browser->content =~ /\s*var video_host = '([^']+)';/); 33 | $host = $1; 34 | debug ("Host: '" . $host . "'"); 35 | 36 | return unless ($browser->content =~ /\s*var video_uid = '([^']+)';/); 37 | $uid = $1; 38 | debug ("UID: '" . $uid . "'"); 39 | 40 | return unless ($browser->content =~ /\s*var video_vtag = '([^']+)';/); 41 | $vtag = $1; 42 | 43 | $url = $host . "u" . $uid . "/videos/" . $vtag . ".360.mp4"; 44 | debug ("URL: '" . $url . "'"); 45 | return $url, title_to_filename($title, "mp4"); 46 | } 47 | 48 | 1; 49 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Vimeo.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Vimeo; 3 | 4 | use strict; 5 | use warnings; 6 | use FlashVideo::Utils; 7 | use FlashVideo::JSON; 8 | 9 | our $VERSION = '0.06'; 10 | sub Version() { $VERSION; } 11 | 12 | sub find_video { 13 | my ($self, $browser, $embed_url, $prefs) = @_; 14 | 15 | my $id; 16 | 17 | if ($browser->response->is_redirect) { 18 | my $relurl = $browser->response->header('Location'); 19 | info "Relocated to $relurl"; 20 | $browser->get($relurl); 21 | } 22 | 23 | my $page_url = $browser->uri->as_string; 24 | 25 | if ($embed_url =~ /clip_id=(\d+)/) { 26 | $id = $1; 27 | } elsif ($embed_url =~ m!/(\d+)!) { 28 | $id = $1; 29 | } 30 | die "No ID found\n" unless $id; 31 | 32 | # this JSON response will contain title and video URLs 33 | my $info_url = "https://player.vimeo.com/video/$id/config"; 34 | $browser->get($info_url); 35 | my $video_data = from_json($browser->content); 36 | my $title = $video_data->{video}{title}; 37 | my $filename = title_to_filename($title, "mp4"); 38 | 39 | my @formats = map { 40 | { resolution => [$_->{width}, $_->{height}], url => $_->{url} } 41 | } values @{$video_data->{request}{files}{progressive}}; 42 | 43 | my $preferred_quality = $prefs->quality->choose(@formats); 44 | 45 | return $preferred_quality->{url}, $filename; 46 | } 47 | 48 | 1; 49 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Cartoonnetwork.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Cartoonnetwork; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use POSIX(); 7 | 8 | sub find_video { 9 | my ($self, $browser, $embed_url) = @_; 10 | 11 | my $video_id; 12 | if ($browser->uri->as_string =~ /episodeID=([a-z0-9]*)/) { 13 | $video_id = $1; 14 | } 15 | 16 | $browser->get("http://www.cartoonnetwork.com/cnvideosvc2/svc/episodeSearch/getEpisodesByIDs?ids=$video_id"); 17 | my $xml = from_xml($browser); 18 | my $episodes = $xml->{episode}; 19 | my $episode = ref $episodes eq 'ARRAY' ? 20 | (grep { $_->{id} eq $video_id } @$episodes)[0] : 21 | $episodes; 22 | 23 | my $title = $episode->{title}; 24 | 25 | # as seen in http://www.cartoonnetwork.com/video/tools/js/videoConfig_videoPage.js 26 | my @gmtime = gmtime; 27 | $gmtime[1] = 15 * int($gmtime[1] / 15); 28 | my $date = POSIX::strftime("%m%d%Y%H%M", @gmtime); 29 | 30 | my $url; 31 | foreach my $key (keys (%{$episode->{segments}->{segment}})){ 32 | my $content_id = $key; 33 | $browser->post("http://www.cartoonnetwork.com/cnvideosvc2/svc/episodeservices/getVideoPlaylist", 34 | Content => "id=$content_id&r=$date" 35 | ); 36 | 37 | if ($browser->content =~ /<ref href="([^"]*)" \/>/){ 38 | $url = $1; 39 | } 40 | } 41 | 42 | return $url, title_to_filename($title); 43 | } 44 | 45 | 1; 46 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Escapistmagazine.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Escapistmagazine; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use FlashVideo::JSON; 7 | 8 | sub find_video { 9 | my ($self, $browser, $embed_url) = @_; 10 | # Actual Escapist Part 11 | my $title; 12 | my $url; 13 | if ($browser->content =~ /<div[^>]*class=['"]name['"]>(.*?)<\/div>/) { 14 | $title = $1; 15 | $title =~ s/<[^>]*>//g; 16 | } else { 17 | $title = extract_title($browser); 18 | } 19 | 20 | my $config_url; 21 | # This may be too specific, and thus more fragile than I'd like 22 | # I didn't want to hit something unrelated, though 23 | if ($browser->content =~ /<param name=['"]flashvars['"] value=['"]config=([^'"]*)['"]/) { 24 | $config_url = $1; 25 | } else { 26 | die "No Video Info URL Found\n"; 27 | } 28 | 29 | # Without this header the server gives you a 500 response 30 | # It also then puts you on some sort of list that gives you that response 31 | # for even good requests hours if not days 32 | # This took a long time to figure out. 33 | $browser->add_header(Accept => '*/*'); 34 | $browser->get("$config_url"); 35 | my $replaced = $browser->content; 36 | $replaced =~ s/'/"/g; 37 | my $json = from_json($replaced); 38 | 39 | my $item; 40 | for $item (@{$json->{playlist}}) { 41 | if ($item->{eventCategory} eq "Video") { 42 | $url = $item->{url}; 43 | } 44 | } 45 | return $url, title_to_filename($title); 46 | } 47 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Canoe.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | =pod 3 | Uses TVA/Canoe-Specific way to get the brightcove metadata, 4 | then forwards to the brightcove module. 5 | 6 | TVA/Canoe live streaming 7 | expects URL of the form 8 | http://tva.canoe.ca/dws/?emission=xxxxxxx 9 | =cut 10 | package FlashVideo::Site::Canoe; 11 | 12 | use strict; 13 | use FlashVideo::Utils; 14 | use base 'FlashVideo::Site::Brightcove'; 15 | 16 | sub find_video { 17 | my ($self, $browser, $embed_url) = @_; 18 | 19 | # look inside script that generates CanoeVideoStandalone object 20 | my $video_id = ($browser->content =~ /player.SetVideo.(\d+)/i)[0]; 21 | my $player_id = ($browser->content =~ /player.SetPlayer.(\d+)/i)[0]; 22 | 23 | debug "Extracted playerId: $player_id, videoId: $video_id" 24 | if $player_id or $video_id; 25 | 26 | if(!$video_id) { 27 | # Some pages use more complex video[x][3] type code.. 28 | my $video_offset = ($browser->content =~ /player.SetVideo.\w+\[(\d+)/i)[0]; 29 | $video_id = ($browser->content =~ /videos\[$video_offset\].+'(\d+)'\s*\]/)[0]; 30 | } 31 | 32 | die "Unable to extract Brightcove IDs from page" 33 | unless $player_id and $video_id; 34 | 35 | return $self->amfgateway($browser, $player_id, { videoId => $video_id, } ); 36 | } 37 | 38 | sub can_handle { 39 | my($self, $browser, $url) = @_; 40 | 41 | return $browser->content =~ /player = CanoeVideoStandalone\.create\(\);/i; 42 | } 43 | 44 | 1; 45 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Tva.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | =for comment 3 | Uses TVA/Canoe-Specific way to get the brightcove metadata, 4 | then forwards to the brightcove module. 5 | 6 | TVA/Canoe live streaming 7 | expects URL of the form 8 | http://tva.canoe.ca/dws/?emission=xxxxxxx 9 | =cut 10 | package FlashVideo::Site::Tva; 11 | 12 | use strict; 13 | use FlashVideo::Utils; 14 | use base 'FlashVideo::Site::Brightcove'; 15 | 16 | sub find_video { 17 | my ($self, $browser, $embed_url) = @_; 18 | 19 | # look inside script that generates CanoeVideoStandalone object 20 | my $video_id = ($browser->content =~ /player.SetVideo.(\d+)/i)[0]; 21 | my $player_id = ($browser->content =~ /player.SetPlayer.(\d+)/i)[0]; 22 | 23 | debug "Extracted playerId: $player_id, videoId: $video_id" 24 | if $player_id or $video_id; 25 | 26 | if(!$video_id) { 27 | # Some pages use more complex video[x][3] type code.. 28 | my $video_offset = ($browser->content =~ /player.SetVideo.\w+\[(\d+)/i)[0]; 29 | $video_id = ($browser->content =~ /videos\[$video_offset\].+'(\d+)'\s*\]/)[0]; 30 | } 31 | 32 | die "Unable to extract Brightcove IDs from page" 33 | unless $player_id and $video_id; 34 | 35 | return $self->amfgateway($browser, $player_id, { videoId => $video_id, } ); 36 | } 37 | 38 | sub can_handle { 39 | my($self, $browser, $url) = @_; 40 | 41 | return $browser->content =~ /player = CanoeVideoStandalone\.create\(\);/i; 42 | } 43 | 44 | 1; 45 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Freevideo.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Freevideo; # .ru 3 | 4 | use strict; 5 | use Encode; 6 | use FlashVideo::Utils; 7 | use URI::Escape; 8 | 9 | sub find_video { 10 | my ($self, $browser) = @_; 11 | 12 | my $ticket; 13 | if ($browser->uri->as_string =~ /\?id=(.*?)$/) { 14 | $ticket = $1; 15 | } 16 | 17 | $browser->post( 18 | "http://freevideo.ru/video/view/url/-/" . int(rand 100_000), 19 | [ 20 | onLoad => '[type Function]', 21 | highquality => 0, 22 | getvideoinfo => 1, 23 | devid => 'LoadupFlashPlayer', 24 | after_adv => 0, 25 | before_adv => 1, 26 | frame_url => 1, 27 | 'ref' => $browser->uri->as_string, 28 | video_url => 1, 29 | ticket => $ticket, 30 | ] 31 | ); 32 | 33 | if (!$browser->success) { 34 | die "Posting to Freevideo failed: " . $browser->response->status_line(); 35 | } 36 | 37 | my $video_data = uri_unescape($browser->content); 38 | 39 | my $url; 40 | 41 | if ($video_data =~ m'vidURL=(http://.*?\.flv)') { 42 | $url = $1; 43 | } 44 | else { 45 | die "Couldn't find Freevideo URL"; 46 | } 47 | 48 | my $title; 49 | 50 | if ($video_data =~ /title=(.*?)&userNick/) { 51 | $title = $1; 52 | } 53 | 54 | # All your double encoding is belong to us! 55 | $title = decode('utf-8', $title); 56 | 57 | return $url, title_to_filename($title); 58 | } 59 | 60 | 1; 61 | -------------------------------------------------------------------------------- /bin/get_flash_videos.PL: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | # Generate the CPAN installed version of get_flash_videos, i.e. set 3 | # $SCRIPT_NAME. 4 | 5 | open my $out, ">", $ARGV[0] or die $!; 6 | 7 | my $install_type = exists $ENV{GFV_INSTALL_TYPE} ? $ENV{GFV_INSTALL_TYPE} : ""; 8 | 9 | # So, despite having 3 environment variables that seem to serve the purpose of 10 | # identifying which CPAN shell you're using various bugs seem to mean they 11 | # aren't set how you'd expect. 12 | 13 | # cpanplus: Look at the version environment variable only (all the other shells 14 | # set CPANPLUS_IS_RUNNING). 15 | $install_type ||= "cpan-cpanp" if $ENV{PERL5_CPANPLUS_IS_VERSION}; 16 | 17 | # cpanminus: Appears to be buggy, only PERL5_CPANPLUS_IS_RUNNING is set. (But 18 | # also handle the CPANM variable being set just in case someone fixes this 19 | # bug). 20 | $install_type ||= "cpan-cpanm" if( 21 | ($ENV{PERL5_CPANPLUS_IS_RUNNING} and !$ENV{PERL5_CPAN_IS_RUNNING}) 22 | || $ENV{PERL5_CPANM_IS_RUNNING}); 23 | 24 | # cpan: Just check the original environment variable, we've ruled out the other 25 | # shells now. 26 | $install_type ||= "cpan-cpan" if $ENV{PERL5_CPAN_IS_RUNNING}; 27 | 28 | # Not under a shell (probably). 29 | $install_type ||= "cpan-manual"; 30 | 31 | # ...phew 32 | 33 | # Add our header with the type... 34 | print $out <<EOF; 35 | #!$^X 36 | \$::SCRIPT_NAME = "get_flash_videos"; 37 | \$::INSTALL_TYPE = "$install_type"; 38 | EOF 39 | 40 | open my $in, "<", "get_flash_videos" or die $!; 41 | 42 | <$in>; # throw away first line (shebang) for tidyiness. 43 | print $out join "", <$in>; 44 | 45 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Vrak.pm: -------------------------------------------------------------------------------- 1 | package FlashVideo::Site::Vrak; 2 | 3 | use strict; 4 | use FlashVideo::Utils; 5 | no strict 'refs'; 6 | 7 | 8 | #sub xxcan_handle { 9 | # my($self, $browser, $url) = @_; 10 | # return $browser->content =~ /var\s+videoId\s*=\s*\d+\s*;/i; 11 | #} 12 | 13 | sub find_video { 14 | my($self, $browser, $embed_url, $prefs) = @_; 15 | 16 | my $check_response = sub { 17 | my ( $message ) = @_; 18 | return if $browser->success; 19 | die sprintf $message, $browser->response->code; 20 | }; 21 | 22 | 23 | my $videoID = 0; 24 | 25 | ( $videoID ) = ( $browser->content =~ /var\s+videoId\s*=\s*(\d+)\s*;/i ); 26 | debug "VIDEOID = " . $videoID; 27 | 28 | die "No Vrak Video ID found" unless $videoID; 29 | 30 | my $title; 31 | ( $title ) = ( $browser->content =~ /var\s+videoTitle\s*=\s*"([^"]+)/i ); 32 | 33 | debug "TITLE = " . $title . " " . title_to_filename($title, 'flv'); 34 | 35 | my $xmlurl = 'http://www.vrak.tv/webtele/_dyn/getVideoDataXml.jsp?videoId=' . $videoID; 36 | $browser->get($xmlurl); 37 | my $xml = from_xml($browser); 38 | 39 | my $url; 40 | if ( $prefs->{quality} == "high" ) { 41 | $url = $xml->{video}->{highFlvUrl}; 42 | } else { 43 | $url = $xml->{video}->{lowFlvUrl}; 44 | } 45 | debug "URL = " . $url; 46 | 47 | my $ext; 48 | ( $ext ) = ( $url =~ /\.(.+)$/i ); 49 | 50 | die "No (high|low)FlvUrl found in XML ". $xmlurl unless $url; 51 | 52 | return $url, title_to_filename($title); 53 | 54 | } 55 | 56 | 1; 57 | 58 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Apple.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Apple; 3 | use strict; 4 | use FlashVideo::Utils; 5 | 6 | sub find_video { 7 | my ($self, $browser, $embed_url, $prefs) = @_; 8 | 9 | if(!FlashVideo::Downloader->check_file($browser->content)) { 10 | # We weren't given a quicktime link, so find one.. 11 | my @urls = $browser->content =~ /['"]([^'"]+\.mov)(?:\?[^'"]+)?['"]/g; 12 | die "No .mov URLs found on page" unless @urls; 13 | debug "Found URLs: @urls"; 14 | 15 | my $redirect_url = $prefs->quality->choose(map { 16 | /(\d+p?)\.mov/ && { 17 | url => $_, 18 | resolution => $prefs->quality->format_to_resolution($1) 19 | } 20 | } @urls 21 | )->{url}; 22 | 23 | $browser->get($redirect_url); 24 | } 25 | 26 | my $url = $self->handle_mov($browser); 27 | my $filename = ($url->path =~ m{([^/]+)$})[0]; 28 | 29 | return $url, $filename; 30 | } 31 | 32 | # This could move into generic if we see other sites using quicktime links like 33 | # this.. 34 | sub handle_mov { 35 | my ($self, $browser) = @_; 36 | 37 | # I'm an iPhone (not a PC) 38 | $browser->agent("Apple iPhone OS v2.0.1 CoreMedia v1.0.0.5B108"); 39 | 40 | if($browser->content =~ /url\s*\0+[\1-,]*(.*?)\0/) { 41 | return URI->new_abs($1, $browser->uri) 42 | } else { 43 | die "Cannot find link in .mov"; 44 | } 45 | } 46 | 47 | sub can_handle { 48 | my($self, $browser, $url) = @_; 49 | 50 | return $url =~ m{apple\.com/trailers/} || $url =~ m{movies\.apple\.com}; 51 | } 52 | 53 | 1; 54 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Yourupload.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Yourupload; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | our $VERSION = '0.01'; 9 | sub Version() { $VERSION; } 10 | 11 | sub find_video { 12 | my ($self, $browser, $embed_url) = @_; 13 | 14 | my $flashvars = ""; 15 | my $file = ""; 16 | my $url = ""; 17 | my $name = ""; 18 | 19 | if ($embed_url !~ /http:\/\/yourupload.com\/embed\//) { 20 | if ($browser->content =~ /<iframe src="(http:\/\/yourupload.com\/embed\/[^"]+)" style/) { 21 | $embed_url = $1; 22 | $browser->get($embed_url); 23 | } else { 24 | # we can't find the frame with embed URL 25 | return; 26 | } 27 | } 28 | 29 | # get configuration passed to flash player 30 | if ($browser->content =~ /\s*flashvars="([^"]+)"/) { 31 | $flashvars = $1; 32 | } else { 33 | # if we can't get it, just leave as the video URL is there 34 | debug("Can't find flashvars"); 35 | return; 36 | } 37 | 38 | debug ("Flashvars: " . $flashvars); 39 | 40 | # in the configuration there is also URL we're looking for 41 | if ($flashvars =~ /&file=(http[^&]+)&/) { 42 | $file = $1; 43 | } else { 44 | debug("Can't find file"); 45 | return; 46 | } 47 | 48 | debug("File: " . $file); 49 | 50 | $url = uri_unescape($file); 51 | debug("URL: '" . $url . "'"); 52 | 53 | # URL ends with filename 54 | $name = $url; 55 | $name =~ s/.*\/([^\/]+\.(flv|mp4)).*/$1/; 56 | debug("Filename: " . $name); 57 | return $url, title_to_filename($name); 58 | } 59 | 60 | 1; 61 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Canalvie.pm: -------------------------------------------------------------------------------- 1 | ############################################################################# 2 | # Canalvie.pm 2010-11-25 3 | # 4 | # Reverse-engineered using URLSnooper v2.28.01 & WinPcap 4.1.2 5 | # 6 | # Stavr0 7 | # 8 | # 9 | { 10 | package FlashVideo::Site::Canalvie; 11 | 12 | use strict; 13 | use FlashVideo::Utils; 14 | 15 | sub find_video { 16 | my($self, $browser, $embed_url, $prefs) = @_; 17 | 18 | my $check_response = sub { 19 | my ( $message ) = @_; 20 | return if $browser->success; 21 | die sprintf $message, $browser->response->code; 22 | }; 23 | 24 | 25 | my $videoID = 0; 26 | 27 | ( $videoID ) = ( $browser->content =~ /var\s+videoId\s*=\s*(\d+)\s*;/ ); 28 | debug "VIDEOID = " . $videoID; 29 | 30 | die "No Canalvie Video ID found" unless $videoID; 31 | 32 | my $title; 33 | ( $title ) = ( $browser->content =~ /NOM EPISODE\+LIEN ici --><a [^>]+>([^<]+)/ ); 34 | debug "TITLE = " . $title . " " . title_to_filename($title, 'flv'); 35 | 36 | my $xmlurl = 'http://www.canalvie.com/webtele/_dyn/getVideoDataXml.jsp?videoId=' . $videoID; 37 | $browser->get($xmlurl); 38 | my $xml = from_xml($browser); 39 | 40 | my $url; 41 | if ( $prefs->{quality} == "high" ) { 42 | $url = $xml->{video}->{highFlvUrl}; 43 | } else { 44 | $url = $xml->{video}->{lowFlvUrl}; 45 | } 46 | debug "URL = " . $url; 47 | 48 | my $ext; 49 | ( $ext ) = ( $url =~ /\.(.+)$/ ); 50 | 51 | die "No (high|low)FlvUrl found in XML ". $xmlurl unless $url; 52 | 53 | return $url, title_to_filename($title, $ext); 54 | 55 | } 56 | 57 | 58 | 1; 59 | } -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Blip.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Blip; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url) = @_; 9 | my $base = "http://blip.tv"; 10 | 11 | my $id; 12 | if($embed_url =~ m{flash/(\d+)}) { 13 | $id = $1; 14 | } else { 15 | $browser->get($embed_url); 16 | 17 | if($browser->response->is_redirect 18 | && $browser->response->header("Location") =~ m!(?:/|%2f)(\d+)!i) { 19 | $id = $1; 20 | } else { 21 | $id = ($browser->content =~ m!/rss/flash/(\d+)!)[0]; 22 | } 23 | } 24 | 25 | # Sometimes the ID is supplied in an odd way. 26 | if (!$id) { 27 | # Video ID is somehow related to the ID of a comment posted on the 28 | # site, slightly odd. 29 | if ($browser->content =~ /post_masthed_(\d+)/) { 30 | $id = $1; 31 | } 32 | } 33 | 34 | if (!$id) { ($id) = ($browser->content =~ m/data-posts-id="(\d+)"/); } 35 | if (!$id) { ($id) = ($browser->content =~ m/data-disqus-id="(\d+)"/); } 36 | if (!$id) { ($id) = ($embed_url =~ m/.*?(\d+$)/); } 37 | 38 | die "No ID found\n" unless $id; 39 | 40 | $browser->get("$base/rss/flash/$id"); 41 | 42 | my $xml = from_xml($browser); 43 | 44 | my $content = $xml->{channel}->{item}->{"media:group"}->{"media:content"}; 45 | 46 | my $url = ref $content eq 'ARRAY' ? $content->[0]->{url} : $content->{url}; 47 | 48 | my $filename = title_to_filename($xml->{channel}->{item}->{title}, $url); 49 | 50 | # I want to follow redirects now. 51 | $browser->allow_redirects; 52 | 53 | return $url, $filename; 54 | } 55 | 56 | 1; 57 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Divxstage.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Divxstage; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI; 7 | 8 | sub find_video { 9 | my ($self, $browser, $embed_url) = @_; 10 | 11 | #Extract the file and filekey variables from the flash variable in the HTML 12 | my ($file) = ($browser->content =~ /flashvars.file\s*=\s*"([a-f0-9]+)"/); 13 | my ($filekey) = ($browser->content =~ /flashvars.filekey\s*=\s*"([.\-a-f0-9]+)"/); 14 | 15 | #cleanest title source is the page title 16 | my ($filename) = title_to_filename(extract_title($browser)); 17 | $filename =~ s/_-_DivxStage//i; 18 | 19 | #Construct a request to the player.api PHP interface, which returns the actual location of the file 20 | my %query_params = ( 21 | 'codes'=>'1', 22 | 'file'=>$file, 23 | 'key'=>$filekey, 24 | 'pass'=>'undefined', 25 | 'user'=>'undefined',); 26 | 27 | info "Sending query to DivxStage Player API."; 28 | 29 | my $uri = URI->new( "http://www.divxstage.eu/api/player.api.php" ); 30 | $uri->query_form(%query_params); 31 | 32 | #parse the url and title out of the response 33 | my $contents = $browser->get($uri)->content; 34 | my ($url) = ($contents =~ /url=(.*?)&/); 35 | 36 | die "Couldn't find video URL from the player API." unless $url; 37 | 38 | info "Got the real video URL: ".$url; 39 | # use the API-given title if we need 40 | $filename ||= ($contents =~ /title=(.*?)&/)[0]; #probably the most reliable source of title 41 | #fallback to a default name 42 | $filename ||= get_video_filename(); 43 | 44 | return $url, $filename; 45 | } 46 | 47 | 1; 48 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Redbull.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Redbull; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI; 7 | use HTML::Entities; 8 | 9 | sub find_video { 10 | my ($self, $browser, $page_url) = @_; 11 | 12 | my $video_info_url; 13 | my $host = $browser->uri->host; 14 | 15 | if ( ($browser->content =~ /data_url:\s+'([^']+)'/) or 16 | ($browser->content =~ m{displayVideoPlayer\('([^']+)'\)})) { 17 | $video_info_url = $1; 18 | 19 | $video_info_url = "http://$host$video_info_url"; 20 | } 21 | 22 | if (!$video_info_url) { 23 | die "Couldn't find video info URL"; 24 | } 25 | 26 | $browser->get($video_info_url); 27 | 28 | if ($browser->response->is_redirect) { 29 | $browser->get($browser->response->header('Location')); 30 | } 31 | 32 | if (!$browser->success) { 33 | die "Couldn't download Red Bull video info XML: " . 34 | $browser->response->status_line; 35 | } 36 | 37 | # Red Bull's XML is screwed up: 38 | # <?xml version=&"1.0&" 39 | # All your double encoded entities is belong to them. 40 | # If Red Bull want to thank us for pointing this out, please send a few cases 41 | # to Zak and Monsieur. 42 | my $xml = $browser->content; 43 | $xml =~ s/&//g; 44 | $xml = decode_entities($xml); 45 | 46 | my $video_info = from_xml($xml); 47 | 48 | my $file_type = "flv"; 49 | 50 | if ($video_info->{high_video_url} =~ /\.mp4$/) { 51 | $file_type = "mp4"; 52 | } 53 | 54 | return { 55 | flv => title_to_filename($video_info->{title}, $file_type), 56 | rtmp => $video_info->{high_video_url}, 57 | }; 58 | } 59 | 60 | 1; 61 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Traileraddict.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Traileraddict; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | sub find_video { 9 | my ($self, $browser) = @_; 10 | 11 | my $video_id; 12 | if ($browser->content =~ m'/em[db]/(\d+)') { 13 | $video_id = $1; 14 | } 15 | else { 16 | die "Unable to get Traileraddict video ID"; 17 | } 18 | 19 | my $video_info_url = "http://www.traileraddict.com/fvar.php?tid=$video_id"; 20 | 21 | $browser->get($video_info_url); 22 | 23 | if (!$browser->success) { 24 | die "Couldn't download Traileraddict video info URL: " . 25 | $browser->response->status_line; 26 | } 27 | 28 | # Get video information -- this helpfully includes metadata which could 29 | # be useful for gfv's upcoming metadata feature. 30 | my %info = parse_video_info($browser->content); 31 | 32 | die "Couldn't find Traileraddict video URL" unless $info{fileurl}; 33 | 34 | $browser->head($info{fileurl}); 35 | if ($browser->response->is_redirect()) { 36 | $info{fileurl} = $browser->response->header('Location'); 37 | } 38 | 39 | my $type = $info{fileurl} =~ /\.mp4/i ? 'mp4' : 'flv'; 40 | 41 | return $info{fileurl}, title_to_filename($info{title}, $type); 42 | } 43 | 44 | sub parse_video_info { 45 | my $raw_video_info = shift; 46 | 47 | my %info; 48 | 49 | # Raw video info are URL-encoded key=value pairs. 50 | foreach my $pair (split /&/, $raw_video_info) { 51 | $pair = uri_unescape($pair); 52 | 53 | my ($name, $value) = split /=/, $pair; 54 | 55 | $info{$name} = $value; 56 | } 57 | 58 | return %info; 59 | } 60 | 61 | 1; 62 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Flickr.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Flickr; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | my $get_mtl = "http://www.flickr.com/apps/video/video_mtl_xml.gne?v=x"; 9 | 10 | sub find_video { 11 | my ($self, $browser, $embed_url) = @_; 12 | 13 | my($id) = $browser->content =~ /photo_id=(\d+)/; 14 | my($secret) = $browser->content =~ /photo_secret=(\w+)/; 15 | 16 | die "No video ID found\n" unless $id; 17 | 18 | $browser->get($get_mtl . "&photo_id=$id&secret=$secret&olang=en-us&noBuffer=null&bitrate=700&target=_self"); 19 | 20 | my $xml = from_xml($browser); 21 | 22 | my $guid = $self->make_guid; 23 | my $video_id = $xml->{Data}->{Item}->{id}->{content}; 24 | my $playlist_url = $xml->{Playlist}->{TimelineTemplates}->{Timeline} 25 | ->{Metadata}->{Item}->{playlistUrl}->{content}; 26 | 27 | die "No video ID or playlist found" unless $video_id and $playlist_url; 28 | 29 | $browser->get($playlist_url 30 | . "?node_id=$video_id&secret=$secret&tech=flash&mode=playlist" 31 | . "&lq=$guid&bitrate=700&rd=video.yahoo.com&noad=1"); 32 | 33 | $xml = eval { XML::Simple::XMLin($browser->content) }; 34 | die "Failed parsing XML: $@" if $@; 35 | 36 | $xml = $xml->{"SEQUENCE-ITEM"}; 37 | die "XML not as expected" unless $xml; 38 | 39 | my $filename = title_to_filename($xml->{META}->{TITLE}); 40 | my $url = $xml->{STREAM}->{APP} . $xml->{STREAM}->{FULLPATH}; 41 | 42 | return $url, $filename; 43 | } 44 | 45 | sub make_guid { 46 | my($self) = @_; 47 | 48 | my @chars = ('A' .. 'Z', 'a' .. 'z', 0 .. 9, '.', '_'); 49 | return join "", map { $chars[rand @chars] } 1 .. 22; 50 | } 51 | 52 | 1; 53 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Nick.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Nick; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | sub find_video { 9 | my ($self, $browser, $embed_url) = @_; 10 | 11 | #/mgid:cms:video:spongebob.com:895944 12 | 13 | my $page_url = $browser->uri->as_string; 14 | 15 | my $title; 16 | if($browser->content =~ /<span content=["']([\w \.:]+)["'] property=["']media:title["']\/>/) { 17 | $title = $1; 18 | } else { 19 | $title = "nothing"; 20 | } 21 | 22 | my $cmsId; 23 | if($browser->content =~ /KIDS\.add\("cmsId", "(\d+)"\);/) { 24 | $cmsId = $1; 25 | } else { 26 | die "Couldn't get the cmsId."; 27 | } 28 | 29 | my $site; 30 | if($browser->content =~ /KIDS\.add\(["']site["'], ["']([\w\.]+)["']\);/) { 31 | $site = lc($1); 32 | } else { 33 | die "Couldn't get the site."; 34 | } 35 | 36 | my $type; 37 | if($browser->content =~ /KIDS\.add\(["']type["'], ["']([a-z]+)["']\);/) { 38 | $type = $1; 39 | } else { 40 | $type = "video"; 41 | } 42 | 43 | my $uri = "mgid:cms:$type:$site:$cmsId"; 44 | 45 | $browser->get("http://www.nick.com/dynamo/video/data/mediaGen.jhtml?mgid=$uri"); 46 | my $xml = from_xml($browser->content); 47 | my $rtmp_url = $xml->{video}->{item}[0]->{rendition}[0]->{src}; 48 | 49 | return { 50 | rtmp => $rtmp_url, 51 | flv => title_to_filename($title), 52 | pageUrl => $page_url, 53 | swfhash($browser, "http://media.nick.com/" . $uri) 54 | }; 55 | } 56 | 57 | sub can_handle { 58 | my($self, $browser) = @_; 59 | return $browser->content =~ /<script src=["']http:\/\/media.nick.com\/player\/scripts\/mtvn_player_control\.1\.0\.1\.js["']/; 60 | } 61 | 62 | 1; 63 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Movshare.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Movshare; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI; 7 | 8 | our $VERSION = '0.01'; 9 | sub Version() { 10 | $VERSION; 11 | } 12 | 13 | sub find_video { 14 | my ($self, $browser, $embed_url) = @_; 15 | 16 | #Extract the file and filekey variables from the flash variable in the HTML 17 | my $file = ($browser->content =~ /flashvars.file\s*=\s*"(.+?)"/)[0]; 18 | my $filekey = ($browser->content =~ /flashvars.filekey\s*=\s*"([.\-a-f0-9]+)"/)[0]; 19 | 20 | #Construct a request to the player.api PHP interface, which returns the actual location of the file 21 | my %query_params = ( 22 | 'file'=>$file, 23 | 'key'=>$filekey,); 24 | 25 | info "Sending query to API..."; 26 | 27 | my $uri = URI->new( "http://www.movshare.net/api/player.api.php" ); 28 | $uri->query_form(%query_params); 29 | 30 | # Appear to be a Real Web Browser. Necessary to convince Movshare to yield 31 | # real results. 32 | $browser->add_header("User-Agent" => "Mozilla/6.9"); 33 | 34 | #parse the url and title out of the response 35 | my $contents = $browser->get($uri)->decoded_content; 36 | debug "API reply: $contents"; 37 | my ($url) = ($contents =~ /url=(.*?)&/); 38 | 39 | die "Couldn't find video URL from the player API!" unless $url; 40 | 41 | debug "Got the real video URL: ".$url; 42 | # Use the title from the API; it's pretty reliable. 43 | my $filename = ($contents =~ /title=(.*?)&/)[0]; 44 | #fallback to a default name 45 | $filename ||= get_video_filename(); 46 | 47 | return $url, $filename; 48 | } 49 | 50 | sub can_handle { 51 | my ($self, $browser, $url) = @_; 52 | 53 | return $url =~ m{movshare\.net}; 54 | } 55 | 56 | 1; 57 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Break.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Break; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | sub find_video { 9 | my($self, $browser, $embed_url) = @_; 10 | 11 | # Need to get additional ID, otherwise video download returns 403 12 | my $video_id; 13 | 14 | if ($browser->content =~ /flashVars\.icon = ["'](\w+)["']/) { 15 | $video_id = $1; 16 | } 17 | else { 18 | die "Couldn't get Break video ID"; 19 | } 20 | 21 | if($browser->content =~ /<meta name=['"]embed_video_url['"] content=["']([^'"]*)["']/) { 22 | $browser->get($1); 23 | } 24 | 25 | if(URI->new($embed_url)->host eq "embed.break.com") { 26 | $browser->get($embed_url); 27 | } 28 | 29 | if($browser->uri->host eq "embed.break.com") { 30 | # Embedded video 31 | if(!$browser->success && $browser->response->header('Location') !~ /sVidLoc/) { 32 | $browser->get($browser->response->header('Location')); 33 | } 34 | 35 | if($browser->response->header("Location") =~ /sVidLoc=([^&]+)/) { 36 | my $url = uri_unescape($1).'?'.$video_id; 37 | my $filename = title_to_filename((split /\//, $url)[-1]); 38 | 39 | return $url, $filename; 40 | } 41 | } 42 | 43 | my $path = ($browser->content =~ /sGlobalContentFilePath='([^']+)'/)[0]; 44 | my $filename = ($browser->content =~ /sGlobalFileName='([^']+)'/)[0]; 45 | 46 | die "Unable to extract path and filename" unless $path and $filename; 47 | 48 | my $video_path = ($browser->content =~ /videoPath\s*(?:',|=)\s*['"]([^'"]+)/)[0]; 49 | 50 | # I want to follow redirects now. 51 | $browser->allow_redirects; 52 | 53 | return $video_path . $path . "/" . $filename . ".flv" . "?" . $video_id, 54 | title_to_filename($filename); 55 | } 56 | 57 | 1; 58 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Muzu.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Muzu; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use HTML::Entities; 7 | 8 | sub find_video { 9 | my ($self, $browser) = @_; 10 | 11 | # Sometimes redirects to country-specific sites, sigh... 12 | if ($browser->response->code == 302) { 13 | $browser->allow_redirects; 14 | $browser->get($browser->response->header('Location')) 15 | } 16 | 17 | $browser->content =~ /id="trackHeading">(.*?)</; 18 | my $title = $1; 19 | 20 | if (!$title) { 21 | $browser->content =~ /id="videosPageMainTitleH1">(.*?)</s; 22 | $title = $1; 23 | } 24 | 25 | my $filename = title_to_filename(decode_entities($title)); 26 | 27 | my $flashvars = ($browser->content =~ m'flashvars:(?:\s+getPlayerData\(\)\s+\+\s+)?"([^"]+)')[0]; 28 | die "Unable to extract flashvars" unless $flashvars; 29 | 30 | my %map = ( 31 | networkId => "id", 32 | assetId => "assetId", 33 | vidId => "assetId", 34 | startChannel => "playlistId", 35 | ); 36 | 37 | my $playAsset = "http://www.muzu.tv/player/playAsset/?"; 38 | for(split /&/, $flashvars) { 39 | my($n, $v) = split /=/; 40 | $playAsset .= "$map{$n}=$v&" if exists $map{$n}; 41 | } 42 | 43 | $browser->get($playAsset); 44 | die "Unable to get $playAsset" if $browser->response->is_error; 45 | 46 | my $url = ($browser->content =~ /src="([^"]+)/)[0]; 47 | $url = decode_entities($url); 48 | die "Unable to find video URL" unless $url; 49 | 50 | if($url =~ /^rtmp:/) { 51 | my($playpath) = $url =~ m{/([^/]+)$}; 52 | 53 | return { 54 | flv => $filename, 55 | rtmp => $url, 56 | playpath => $playpath, 57 | $url =~ /live/ ? (live => 1) : () 58 | }; 59 | 60 | } else { 61 | return $url, $filename; 62 | } 63 | } 64 | 65 | 1; 66 | -------------------------------------------------------------------------------- /t/utils.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use lib qw(..); 4 | use utf8; # Test results are in UTF-8. 5 | use Test::More; 6 | use FlashVideo::Utils; 7 | use Encode; 8 | 9 | my @tests = ( 10 | [ <<EOF, "text/html", "foo bar" 11 | <Title>foo 12 | bar 13 | EOF 14 | ], 15 | [ <caf\x{e9} 18 | EOF 19 | ], 20 | [ <\xD0\xEE\xF1\xF1\xE8\xE9\xF1\xEA\xE0\xFF\x20\xD4\xE5\xE4\xE5\xF0\xE0\xF6\xE8\xFF 22 | EOF 23 | ], 24 | [ < 26 | \xD0\xEE\xF1\xF1\xE8\xE9\xF1\xEA\xE0\xFF\x20\xD4\xE5\xE4\xE5\xF0\xE0\xF6\xE8\xFF 27 | EOF 28 | ], 29 | [ <\x4E\x54\x54\x83\x68\x83\x52\x83\x82\x82\xCC\x83\x49\x83\x74\x83\x42\x83\x56\x83\x83\x83\x8B\x83\x45\x83\x46\x83\x75\x83\x54\x83\x43\x83\x67\x82\xC5\x82\xB7\x81\x42 31 | 32 | EOF 33 | ] 34 | ); 35 | 36 | # These aren't actually in UTF-8, hence the evilness. 37 | Encode::_utf8_off($_->[0]) for @tests; 38 | 39 | { # Mock version of WWW::Mechanize 40 | package MockMech; 41 | use base "FlashVideo::Mechanize"; 42 | 43 | sub _make_request { 44 | my($self, $req) = @_; 45 | 46 | my $num = $req->uri->host; 47 | 48 | my $res = HTTP::Response->new(200, "OK", 49 | [ "Content-type" => $tests[$num]->[1] ], 50 | $tests[$num]->[0]); 51 | 52 | $res->request($req); 53 | 54 | return $res; 55 | } 56 | } 57 | 58 | # Start tests.. 59 | 60 | plan tests => scalar @tests; 61 | 62 | my $mech = MockMech->new; 63 | for my $i(0 .. $#tests) { 64 | $mech->get("http://$i"); 65 | is(extract_title($mech), $tests[$i]->[2]); 66 | } 67 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Stickam.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Stickam; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my($self, $browser, $embed_url, $prefs) = @_; 9 | 10 | my $perfomer_id; 11 | 12 | if ($browser->content =~ /profileUserId=(\d+)/) { 13 | $perfomer_id = $1; 14 | } 15 | else { 16 | die "Can't get performer ID"; 17 | } 18 | 19 | my $filename; 20 | if ($browser->content =~ /userName=([^&]+)/) { 21 | $filename = $1; 22 | } 23 | else { 24 | $filename = $perfomer_id; 25 | } 26 | 27 | my $stream_info_url = sprintf 28 | "http://player.stickam.com/servlet/flash/getChannel?" . 29 | "type=join&performerID=%d", $perfomer_id; 30 | 31 | $browser->get($stream_info_url); 32 | 33 | if (!$browser->success) { 34 | die "Couldn't get stream info: " . $browser->response->status_line; 35 | } 36 | 37 | my %stream_info; 38 | 39 | foreach my $pair (split /&/, $browser->content) { 40 | my ($name, $value) = split /=/, $pair; 41 | 42 | # Special handling for server IP, as multiple can be specified. 43 | if ($name eq 'freeServerIP') { 44 | $value = (split /,/, $value)[0]; 45 | } 46 | 47 | $stream_info{$name} = $value; 48 | } 49 | 50 | if ($stream_info{errorCode}) { 51 | die "Stickam returned error $stream_info{errorCode}: $stream_info{errorMessage}"; 52 | } 53 | 54 | my $rtmp_stream_url = sprintf 55 | "rtmp://%s/video_chat2_stickam_peep/%d/public/mainHostFeed", 56 | $stream_info{freeServerIP}, 57 | $stream_info{channelID}; 58 | 59 | return { 60 | rtmp => $rtmp_stream_url, 61 | flv => title_to_filename($filename), 62 | live => '', 63 | conn => [ 64 | 'O:1', 65 | "NS:channel:$perfomer_id", 66 | 'O:1', 67 | ], 68 | swfhash($browser, 69 | "http://player.stickam.com/flash/stickam/stickam_simple_video_player.swf") 70 | }; 71 | } 72 | 73 | 1; 74 | -------------------------------------------------------------------------------- /mk/targets.mk: -------------------------------------------------------------------------------- 1 | # removing these are not used. 2 | # t/url.t uses the SCRIPT env... 3 | # GNU make ..... 4 | #ifeq ($(findstring release,$(MAKECMDGOALS)),release) 5 | # export SCRIPT = $(BASEEXT)-$(VERSION) 6 | #else 7 | # export SCRIPT = $(INST_SCRIPT)/$(BASEEXT) 8 | #endif 9 | # OpenBSD make 10 | #.if ${.TARGETS:C/.*(release).*/\1/} == "release" 11 | # export SCRIPT=$(BASEEXT)-$(VERSION) 12 | #.else 13 | # export SCRIPT=$(INST_SCRIPT)/$(BASEEXT) 14 | #.endif 15 | 16 | # Extra targets 17 | COMBINE = $(PERL) -I$(INST_LIB) utils/combine-perl.pl 18 | 19 | EXTRATARGETS = combined-$(BASEEXT) combined-$(BASEEXT)-$(VERSION) $(BASEEXT)-$(VERSION) 20 | 21 | # Build the main get_flash_videos, by combining the modules and sites into one 22 | # file, for easier download and installation. 23 | 24 | $(BASEEXT)-$(VERSION): bin/$(BASEEXT) pm_to_blib .sitemodules \ 25 | utils/combine-header 26 | $(COMBINE) --name="$(BASEEXT)" --include="^FlashVideo::" \ 27 | utils/combine-header .sitemodules bin/$(BASEEXT) > $@ 28 | chmod a+x $@ 29 | 30 | # This makes sure to 'use' all the Site modules, so that the combiner can pick 31 | # them all up. 32 | .sitemodules: lib/FlashVideo/Site/*.pm 33 | ls lib/FlashVideo/Site/*.pm| sed -e 's!lib/!!' -e 's!/!::!g' -e 's/\.pm$$/ ();/' -e 's/^/use /' > $@ 34 | 35 | # Build a combined version which also includes our dependencies, this makes it 36 | # easier for people who cannot install Perl modules. (Note that it does still 37 | # need HTML::Parser, as this is XS, and optionally XML::Simple, but LWP and 38 | # Mechanize are included by this). 39 | 40 | COMBINED_SOURCES = utils/combine-head .sitemodules bin/$(BASEEXT) utils/combine-tail 41 | 42 | combined-$(BASEEXT)-$(VERSION): combined-get_flash_videos 43 | cp -p $? $@ 44 | 45 | combined-$(BASEEXT): $(COMBINED_SOURCES) 46 | $(COMBINE) --name="$@" $(COMBINED_SOURCES) > $@ 47 | chmod a+x $@ 48 | 49 | clean:: extraclean 50 | 51 | extraclean: 52 | rm -f $(EXTRATARGETS) .sitemodules mk/makemaker-wrap.mk MANIFEST MANIFEST.bak $(DISTVNAME).tar$(SUFFIX) 53 | 54 | 55 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Arte.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Arte; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use FlashVideo::JSON; 7 | 8 | our $VERSION = '0.02'; 9 | sub Version { $VERSION; } 10 | 11 | sub find_video { 12 | my ($self, $browser, $embed_url, $prefs) = @_; 13 | my ($jsonurl, $filename, $title, $videourl, $quality); 14 | 15 | debug "Arte::find_video called, embed_url = \"$embed_url\"\n"; 16 | 17 | if($browser->content =~ /arte_vp_url=['"](.*)['"]/) { 18 | $jsonurl = $1; 19 | debug "found arte_vp_url \"$jsonurl\"\n"; 20 | ($filename = $jsonurl) =~ s/-.*$//; 21 | $title = extract_title($browser); 22 | } else { 23 | die "Unable to find 'arte_vp_url' in page\n"; 24 | } 25 | 26 | $browser->get($jsonurl); 27 | 28 | $quality = {high => 'SQ', medium => 'MQ', low => 'LQ'}->{$prefs->{quality}}; 29 | 30 | my $result = from_json($browser->content()); 31 | my $protocol = ""; 32 | 33 | if (defined ($result->{videoJsonPlayer}->{VSR}->{'RTMP_'.$quality.'_1'})) { 34 | my $video_json = $result->{videoJsonPlayer}->{VSR}->{'RTMP_'.$quality.'_1'}; 35 | $filename = title_to_filename($title, 'flv'); 36 | 37 | $videourl = { 38 | rtmp => $video_json->{streamer}, 39 | playpath => 'mp4:'.$video_json->{url}, 40 | flv => $filename, 41 | }; 42 | 43 | return $videourl, $filename; 44 | } elsif (defined ($result->{videoJsonPlayer}->{VSR}->{'HTTP_MP4_'.$quality.'_1'})) { 45 | my $video_json = $result->{videoJsonPlayer}->{VSR}->{'HTTP_MP4_'.$quality.'_1'}; 46 | $filename = title_to_filename($title, 'mp4'); 47 | 48 | return $video_json->{url}, $filename; 49 | } elsif (defined ($result->{videoJsonPlayer}->{VSR}->{'HTTP_'.$quality.'_1'})) { 50 | my $video_json = $result->{videoJsonPlayer}->{VSR}->{'HTTP_'.$quality.'_1'}; 51 | $filename = title_to_filename($title, 'mp4'); 52 | 53 | return $video_json->{url}, $filename; 54 | } else { 55 | die "Unable to figure out transport protocol in page\n"; 56 | } 57 | 58 | } 59 | 60 | 1; 61 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Kidswb.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Kidswb; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use FlashVideo::JSON; 7 | 8 | sub find_video { 9 | my($self, $browser, $embed_url, $prefs) = @_; 10 | 11 | # I'm just going to provide the config it because I don't know of a good way to find it. 12 | my $config_url = "http://staticswf.kidswb.com/franchise/digitalsmiths/wbkidsvideoplayer.xml"; 13 | my $mediaKey; 14 | if ($browser->uri->as_string =~ /\/video#.*\/([^\/]*)$/) { 15 | $mediaKey = $1; 16 | } else { 17 | die "Couldn't find flashvars param in " . $browser->uri->as_string; 18 | } 19 | 20 | $browser->allow_redirects; 21 | $browser->get($config_url); 22 | if (!$browser->success) { 23 | die "Couldn't download config.xml $config_url: " . $browser->response->status_line; 24 | } 25 | 26 | my $xml = from_xml($browser); 27 | my $domain = $xml->{mfs}->{url}; 28 | # my $version = $xml->{mfs}->{mfsVersion}; 29 | my $version = "v2"; 30 | my $account = $xml->{mfs}->{account}; 31 | my $partner = $xml->{mfs}->{partnerid}; 32 | 33 | my $asset_url = "$domain/$version/$account/assets/$mediaKey/partner/$partner?format=json"; 34 | $browser->get($asset_url); 35 | if (!$browser->success) { 36 | die "Couldn't download asset file $asset_url: " . $browser->response->status_line; 37 | } 38 | 39 | my $asset_data = from_json($browser->content); 40 | my $videos = $asset_data->{videos}; 41 | 42 | my $title = title_to_filename($asset_data->{assetFields}->{seriesName} . " - " . $asset_data->{assetFields}->{title}); 43 | 44 | # my $video = (grep { $_->{scheme} eq "" } $videos)[0] 45 | my $video = $videos->{limelight700}; 46 | # my $max_bitrate = 0; 47 | # while (($key, $value) = each ($videos)) 48 | # if (int($value->{bitrate}) > $max_bitrate) { 49 | # $video = $value; 50 | # $max_bitrate = int($value->{bitrate}); 51 | # } 52 | # } 53 | 54 | my $rtmp = $video->{uri}; 55 | 56 | return { 57 | flv => $title, 58 | rtmp => $rtmp, 59 | }; 60 | } 61 | 62 | 1; 63 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use ExtUtils::MakeMaker; 4 | 5 | my %mm_vars = ( 6 | AUTHOR => 'Monsieur Video ', 7 | NAME => 'App::get_flash_videos', 8 | ABSTRACT => "Video downloader for various Flash-based video hosting sites", 9 | VERSION_FROM => "get_flash_videos", 10 | EXE_FILES => ["bin/get_flash_videos"], 11 | PL_FILES => { 12 | 'bin/get_flash_videos.PL' => 'bin/get_flash_videos' 13 | }, 14 | MAN1PODS => { 15 | 'doc/get_flash_videos.pod' => 'blib/man1/get_flash_videos.1', 16 | }, 17 | 18 | # Avoid man pages for modules for now. 19 | MAN3PODS => {}, 20 | 21 | PREREQ_PM => { 22 | URI => 0, 23 | 'LWP::UserAgent' => 0, 24 | 'WWW::Mechanize' => 0, 25 | 'IO::Socket::SSL' => 0, 26 | 'LWP::Protocol::https' => 0, 27 | 'LWP::Protocol::socks' => 0, 28 | 'Module::Find' => 0, 29 | 'Term::ProgressBar' => 0, 30 | 'Term::ReadKey' => 0, 31 | }, 32 | ); 33 | 34 | # Needed for reasonable UTF-8 support, also modules are used that are 35 | # core perl as reported by 'corelist' since 5.8. 36 | if($ExtUtils::MakeMaker::VERSION >= 6.48) { 37 | $mm_vars{MIN_PERL_VERSION} = 5.008; 38 | } 39 | 40 | if($ExtUtils::MakeMaker::VERSION >= 6.46) { 41 | $mm_vars{META_MERGE} = { 42 | resources => { 43 | license => 'http://www.apache.org/licenses/LICENSE-2.0.html', 44 | bugtracker => 'https://github.com/monsieurvideo/get-flash-videos/issues', 45 | repository => 'http://github.com/monsieurvideo/get-flash-videos', 46 | } 47 | }; 48 | } 49 | 50 | my $build_req; 51 | if($ExtUtils::MakeMaker::VERSION >= 6.55) { 52 | $build_req = $mm_vars{BUILD_REQUIRES} ||= {}; 53 | } else { 54 | $build_req = $mm_vars{PREREQ_PM}; 55 | } 56 | 57 | # Needed for consistent order in t/rtmpdownloader.t 58 | $build_req->{"Tie::IxHash"} = 0; 59 | 60 | if($ENV{GFV_DEVEL_MODE}) { 61 | $mm_vars{FIRST_MAKEFILE} = "mk/makemaker.mk"; 62 | } 63 | 64 | WriteMakefile(%mm_vars); 65 | -------------------------------------------------------------------------------- /lib/FlashVideo/JSON.pm: -------------------------------------------------------------------------------- 1 | package FlashVideo::JSON; 2 | # Very simple JSON parser, loosely based on 3 | # http://code.google.com/p/json-sans-eval 4 | # Public domain. 5 | 6 | use strict; 7 | use base 'Exporter'; 8 | our @EXPORT = qw(from_json); 9 | 10 | my $number = qr{(?:-?\b(?:0|[1-9][0-9]*)(?:\.[0-9]+)?(?:[eE][+-]?[0-9]+)?\b)}; 11 | my $oneChar = qr{(?:[^\0-\x08\x0a-\x1f\"\\]|\\(?:["/\\bfnrt]|u[0-9A-Fa-f]{4}))}; 12 | my $string = qr{(?:"$oneChar*")}; 13 | my $jsonToken = qr{(?:false|true|null|[\{\}\[\]]|$number|$string)}; 14 | my $escapeSequence = qr{\\(?:([^u])|u(.{4}))}; 15 | 16 | my %escapes = ( 17 | '\\' => '\\', 18 | '"' => '"', 19 | '/' => '/', 20 | 'b' => "\b", 21 | 'f' => "\f", 22 | 'n' => "\xA", 23 | 'r' => "\xD", 24 | 't' => "\t" 25 | ); 26 | 27 | sub from_json { 28 | my($in) = @_; 29 | 30 | my @tokens = $in =~ /$jsonToken/go; 31 | my $result = $tokens[0] eq '{' ? {} : []; 32 | # Handle something other than array/object at toplevel 33 | shift @tokens if $tokens[0] =~ /^[\[\{]/; 34 | 35 | my $key; # key to use for next value 36 | my @stack = $result; 37 | for my $t(@tokens) { 38 | my $ft = substr $t, 0, 1; 39 | my $cont = $stack[0]; 40 | 41 | if($ft eq '"') { 42 | my $s = substr $t, 1, length($t) - 2; 43 | $s =~ s/$escapeSequence/$1 ? $escapes{$1} : chr hex $2/geo; 44 | if(!defined $key) { 45 | if(ref $cont eq 'ARRAY') { 46 | $cont->[@$cont] = $s; 47 | } else { 48 | $key = $s; 49 | next; # need to save $key 50 | } 51 | } else { 52 | $cont->{$key} = $s; 53 | } 54 | } elsif($ft eq '[' || $ft eq '{') { 55 | unshift @stack, 56 | (ref $cont eq 'ARRAY' ? $cont->[@$cont] : $cont->{$key}) = $ft eq '[' ? [] : {}; 57 | } elsif($ft eq ']' || $ft eq '}') { 58 | shift @stack; 59 | } else { 60 | (ref $cont eq 'ARRAY' ? $cont->[@$cont] : $cont->{$key}) = 61 | $ft eq 'f' ? 0 # false 62 | : $ft eq 'n' ? undef # null 63 | : $ft eq 't' ? 1 # true 64 | : $t; # sign or digit 65 | } 66 | undef $key; 67 | } 68 | 69 | return $result; 70 | } 71 | 72 | 1; 73 | -------------------------------------------------------------------------------- /t/title_to_filename.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use lib qw(..); 5 | use Test::More; 6 | use FlashVideo::Utils; 7 | use URI; 8 | 9 | my @media_file_extensions = qw(flv mp4 mov wmv avi m4v); 10 | 11 | my @test_data = ( 12 | { 13 | title => 'Snakes on a plane', 14 | expected_filename => 'Snakes_on_a_plane.flv', 15 | test_name => 'Default .flv extension used.', 16 | }, 17 | { 18 | title => 'Consecutive spaces', 19 | expected_filename => 'Consecutive_spaces.flv', 20 | test_name => 'Consecutive spaces collapsed to single space.', 21 | }, 22 | 23 | # Extracting file type from URL 24 | (map { 25 | { 26 | title => 'Snakes on a plane', 27 | expected_filename => "Snakes_on_a_plane.$_", 28 | test_name => "File type ($_) detected from URL.", 29 | type => "http://example.com/snakes_on_a_plane.$_", 30 | }, 31 | } @media_file_extensions), 32 | 33 | # Extracting file type from title 34 | (map { 35 | { 36 | title => "Snakes on a plane.$_", 37 | expected_filename => "Snakes_on_a_plane.$_", 38 | test_name => "File type ($_) detected from title.", 39 | }, 40 | } @media_file_extensions), 41 | 42 | 43 | { 44 | title => ' Ugly ', 45 | expected_filename => 'Ugly.flv', 46 | test_name => 'Spaces at start and end of filename removed.', 47 | }, 48 | { 49 | title => 'Invalid /" chars', 50 | expected_filename => 'Invalid____chars.flv', 51 | test_name => 'Invalid chars removed.', 52 | }, 53 | { 54 | title => 'Test subtitles file', 55 | type => 'srt', 56 | expected_filename => 'Test_subtitles_file.srt', 57 | test_name => 'Manually-supplied type/extension works (subtitle support).', 58 | }, 59 | ); 60 | 61 | plan tests => scalar @test_data; 62 | 63 | foreach my $test (@test_data) { 64 | my $filename = title_to_filename( 65 | $test->{title}, 66 | $test->{type}, 67 | ); 68 | 69 | is($filename, $test->{expected_filename}, $test->{test_name}); 70 | } 71 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Msnbc.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Msnbc; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url) = @_; 9 | 10 | # allow 302 redirects 11 | $browser->allow_redirects; 12 | 13 | # http://today.msnbc.msn.com/id/$cat/vp/$playlist#$id 14 | # http://today.msnbc.msn.com/id/$cat/vp/#$id 15 | # http://nbcsports.msnbc.com/id/$cat/vp/$playlist#$id 16 | # http://nbcsports.msnbc.com/id/$cat/vp/#$id 17 | # http://www.msnbc.msn.com/id/$cat/$playlist#$id 18 | # http://www.msnbc.msn.com/id/$cat/#$id 19 | my $id; 20 | my $location; 21 | if ($embed_url =~ /(.+\/id\/)([0-9]+)\/vp\/.+#([0-9]+)/) { 22 | $location = $1; 23 | $id = $3; 24 | } elsif ($embed_url =~ /(.+\/id\/)([0-9]+)\/vp\/([0-9]+)/) { 25 | $location = $1; 26 | $id = $3; 27 | } elsif ($embed_url =~ /(.+\/id\/)([0-9]+)\/.+#([0-9]+)/) { 28 | $location = $1; 29 | $id = $3; 30 | } elsif ($embed_url =~ /(.+\/id\/)([0-9]+)\/#([0-9]+)/) { 31 | $location = $1; 32 | $id = $3; 33 | } 34 | die "Unable to find location and videoid" unless $location and $id; 35 | 36 | $browser->get($location . $id . '/displaymode/1219/'); # http://today.msnbc.msn.com/id/$id/displaymode/1219/ 37 | 38 | my $xml = from_xml($browser->content); 39 | 40 | my $title; 41 | my $url; 42 | if ($xml->{video}->{docid} eq $id) { 43 | $title = $xml->{video}->{title}; 44 | foreach my $media (@{$xml->{video}->{media}}) { 45 | if ($media->{type} =~ /flashVideo$/i) { 46 | $url = $media->{content}; 47 | last; #prefer http get over rtmp 48 | } elsif ($media->{type} =~ /flashVideoStream$/i) { 49 | $browser->get($media->{content}); 50 | if ($browser->content =~ /(.+)<\/FlashLink>/i) { 51 | $url = $1; #rtmp 52 | } 53 | } 54 | } 55 | } 56 | die "Unable to extract video url" unless $url; 57 | 58 | if ($url =~ /^rtmp/i) { 59 | return { 60 | rtmp => $url, 61 | flv => title_to_filename($title) 62 | }; 63 | } 64 | 65 | return $url, title_to_filename($title); 66 | } 67 | 68 | 1; 69 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Megavideo.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Megavideo; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use URI::Escape; 7 | 8 | my %sites = ( 9 | Megavideo => "megavideo.com", 10 | Megaporn => "megaporn.com/video", 11 | ); 12 | 13 | sub find_video { 14 | my ($self, $browser) = @_; 15 | 16 | my $site = $sites{($self =~ /::([^:]+)$/)[0]}; 17 | 18 | # Get the video ID 19 | my $v; 20 | if ($browser->content =~ /\.v\s*=\s*['"]([^"']+)/ 21 | || $browser->uri =~ /v=([^&]+)/ 22 | || $browser->response->header("Location") =~ /v=([^&]+)/) { 23 | $v = $1; 24 | } else { 25 | die "Couldn't extract video ID from page"; 26 | } 27 | 28 | my $xml = "http://www.$site/xml/videolink.php?v=$v"; 29 | $browser->get($xml); 30 | 31 | die "Unable to get video infomation" unless $browser->response->is_success; 32 | 33 | my $k1 = ($browser->content =~ /k1="(\d+)/)[0]; 34 | my $k2 = ($browser->content =~ /k2="(\d+)/)[0]; 35 | my $un = ($browser->content =~ /un="([^"]+)/)[0]; 36 | my $s = ($browser->content =~ /\ss="(\d+)/)[0]; 37 | 38 | my $title = uri_unescape(($browser->content =~ /title="([^"]+)/)[0]); 39 | my $filename = title_to_filename($title); 40 | 41 | my $url = "http://www$s.$site/files/" . _decrypt($un, $k1, $k2) . "/"; 42 | 43 | return $url, $filename; 44 | } 45 | 46 | sub _decrypt { 47 | my($un, $k1, $k2) = @_; 48 | 49 | my @c = split //, join "", 50 | map { substr unpack("B8", pack "h", $_), 4 } split //, $un; 51 | 52 | my @iv; 53 | my $i = 0; 54 | while($i < 384) { 55 | $k1 = ($k1 * 11 + 77213) % 81371; 56 | $k2 = ($k2 * 17 + 92717) % 192811; 57 | $iv[$i] = ($k1 + $k2) % 128; 58 | $i++; 59 | } 60 | 61 | $i = 256; 62 | while($i >= 0) { 63 | my $a = $iv[$i]; 64 | my $b = $i-- % 128; 65 | 66 | ($c[$a], $c[$b]) = ($c[$b], $c[$a]); 67 | } 68 | 69 | $i = 0; 70 | while($i < 128) { 71 | $c[$i] ^= $iv[$i + 256] & 1; 72 | $i++; 73 | } 74 | 75 | $i = 0; 76 | my $c = ""; 77 | while($i < @c) { 78 | $c .= unpack "h", pack "B8", "0000" . join "", @c[$i .. ($i + 4)]; 79 | $i += 4; 80 | } 81 | 82 | return $c; 83 | } 84 | 85 | 1; 86 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Slashcontrol.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Slashcontrol; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use FlashVideo::JSON; 7 | 8 | sub find_video { 9 | my($self, $browser, $embed_url, $prefs) = @_; 10 | 11 | my $config; 12 | my $mediaKey; 13 | if ($browser->content =~ //) { 14 | $config = $1; 15 | $mediaKey = $2; 16 | } else { 17 | die "Couldn't find flashvars param in " . $browser->uri->as_string; 18 | } 19 | my $root; 20 | if ($browser->content =~ /uri->as_string; 24 | } 25 | my $config_url; 26 | $config_url = $1 . "/" . $config; 27 | 28 | $browser->allow_redirects; 29 | $browser->get($config_url); 30 | if (!$browser->success) { 31 | die "Couldn't download config.xml $config_url: " . $browser->response->status_line; 32 | } 33 | 34 | my $xml = from_xml($browser); 35 | my $domain = $xml->{mfs}->{mfsUrl}; 36 | my $version = $xml->{mfs}->{mfsVersion}; 37 | my $account = $xml->{mfs}->{mfsAccount}; 38 | my $partner = $xml->{mfs}->{mfsPartnerId}; 39 | 40 | my $asset_url = "$domain/$version/$account/assets/$mediaKey/partner/$partner?format=json"; 41 | $browser->get($asset_url); 42 | if (!$browser->success) { 43 | die "Couldn't download asset file $asset_url: " . $browser->response->status_line; 44 | } 45 | 46 | my $asset_data = from_json($browser->content); 47 | my $videos = $asset_data->{videos}; 48 | 49 | my $title = title_to_filename($asset_data->{assetFields}->{seriesName} . " - " . $asset_data->{assetFields}->{title}); 50 | 51 | # my $video = (grep { $_->{scheme} eq "" } $videos)[0] 52 | my $video = $videos->{limelight700}; 53 | # my $max_bitrate = 0; 54 | # while (($key, $value) = each ($videos)) 55 | # if (int($value->{bitrate}) > $max_bitrate) { 56 | # $video = $value; 57 | # $max_bitrate = int($value->{bitrate}); 58 | # } 59 | # } 60 | 61 | my $rtmp = $video->{uri}; 62 | 63 | return { 64 | flv => $title, 65 | rtmp => $rtmp, 66 | }; 67 | } 68 | 69 | 1; 70 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Cnet.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Cnet; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | my $cnet_api_base = "http://api.cnet.com"; 8 | my $cnet_api_rest = $cnet_api_base . "/restApi/v1.0"; 9 | my $cnet_api_video_search = $cnet_api_rest . "/videoSearch"; 10 | 11 | # /restApi/v1.0/videoSearch?videoIds=50106980&showBroadcast=true&iod=images,videoMedia,relatedLink,breadcrumb,relatedAssets,broadcast%2Clowcache&videoMediaType=preferred&players=Download,RTMP 12 | 13 | sub find_video { 14 | my ($self, $browser, $embed_url) = @_; 15 | 16 | my $video_id; 17 | 18 | if($browser->content =~ //) { 19 | $video_id = $1; 20 | } elsif($browser->content =~ /assetId: '([0-9]+)',/) { 21 | $video_id = $1; 22 | } else { 23 | die "Could not find video ID; you may have to click the 'share' link on the flash player to get the permalink to the video."; 24 | } 25 | 26 | return $self->get_video($browser, $video_id); 27 | } 28 | 29 | sub get_video { 30 | my ($self, $browser, $video_id) = @_; 31 | 32 | $browser->get($cnet_api_video_search . "?videoIds=" . $video_id . "&iod=videoMedia&players=RTMP"); 33 | 34 | my $xml = from_xml($browser->content, NoAttr => 1); 35 | 36 | my $video = $xml->{"Videos"}->{"Video"}; 37 | 38 | my $medias = $video->{"VideoMedias"}->{"VideoMedia"}; 39 | # my $media = @$medias[0]; 40 | 41 | my $max = 0; 42 | # my $max = (grep { $max = (( (int($_->{Width}) * int($_->{Height})) gt $max) ? $_ : $max) } @$medias); 43 | foreach (@{$video->{VideoMedias}->{VideoMedia}}) { 44 | if(int($_->{Width}) * int($_->{Height}) > $max){ 45 | $max = int($_->{Width}) * int($_->{Height}); 46 | } 47 | } 48 | my $media = (grep { (int($_->{Width}) * int($_->{Height})) eq $max } @$medias)[0]; 49 | my $delivery_url = $media->{DeliveryUrl}; 50 | 51 | my $title = $video->{FranchiseName} . ' - ' . $video->{Title}; 52 | 53 | if($media->{Player} eq 'RTMP'){ 54 | return { 55 | rtmp => $delivery_url, 56 | flv => title_to_filename($title) 57 | }; 58 | } elsif($media->{Player} eq 'Download'){ 59 | return $delivery_url, title_to_filename($title) 60 | } 61 | } 62 | 63 | 1; 64 | 65 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Ooyala.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Ooyala; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | use FlashVideo::JSON; 7 | use File::Basename; 8 | use HTML::Entities; 9 | use URI::Escape; 10 | use Data::Dumper; 11 | 12 | our $VERSION = '0.01'; 13 | sub Version() { $VERSION; } 14 | 15 | sub find_video { 16 | my ($self, $browser, $embed_url, $prefs) = @_; 17 | 18 | debug $embed_url; 19 | 20 | my ($player_js) = uri_unescape( 21 | decode_entities( 22 | $browser->content =~ m{<(?:embed|script)[^>]+src=["'](http://player\.ooyala\.com/player\.(?:swf|js)[^'"]*)['"]} 23 | ) 24 | ); 25 | 26 | $player_js =~ s{player\.swf}{player.js}; 27 | 28 | if (!$player_js && $browser->content =~ m{ooyala_video_player_data}) { 29 | my ($embed_code) = $browser->content =~ m{embed: *["']([^'"]*)['"]}; 30 | if ($embed_code) { 31 | $player_js = "http://player.ooyala.com/player.js?embedCode=$embed_code"; 32 | } 33 | } 34 | 35 | die 'Could not find player.js URL' unless $player_js; 36 | 37 | $browser->get($player_js); 38 | 39 | my ($mobile_player_js) = 40 | $browser->content =~ m{mobile_player_url *= *['"]([^'"]*)["']}; 41 | $mobile_player_js .= 'unknown&domain=unknown'; 42 | 43 | die 'Could not find mobile_player.js URL' unless $mobile_player_js; 44 | 45 | $browser->get($mobile_player_js); 46 | 47 | my ($streams) = $browser->content =~ m{streams *= *[^;]*eval\("(.*?)"\);}; 48 | 49 | die 'Could not find streams in mobile_player.js' unless $streams; 50 | 51 | my $data = from_json(json_unescape($streams)); 52 | 53 | my $title = $data->[0]{title}; 54 | my $url; 55 | if ($prefs->{quality} =~ /high|ipad/) { 56 | $url = $data->[0]{ipad_url}; 57 | } else { 58 | $url =$data->[0]{url}; 59 | } 60 | 61 | # The streams being returned are redirects 62 | $browser->allow_redirects; 63 | 64 | return $url, title_to_filename($title, 'mp4'); 65 | } 66 | 67 | sub can_handle { 68 | my($self, $browser, $url) = @_; 69 | 70 | return 1 if $url && URI->new($url)->host =~ /\.ooyala\.com$/; 71 | 72 | return 1 if $browser->content =~ m{ooyala_video_player_data}; 73 | return $browser->content =~ m{<(?:embed|script)[^>]+src=["']http://player\.ooyala\.com/player\.(?:swf|js)[^'"]*['"]}; 74 | } 75 | 76 | 1; 77 | -------------------------------------------------------------------------------- /t/url.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use lib qw(..); 4 | use constant DEBUG => $ENV{DEBUG}; 5 | use IPC::Open3; 6 | use Test::More; 7 | use File::Path; 8 | use FlashVideo::Downloader; 9 | 10 | my $script = $ENV{SCRIPT} ? "$ENV{SCRIPT}" : "../../blib/script/get_flash_videos"; 11 | 12 | chdir "t"; 13 | 14 | if($ENV{AUTOMATED_TESTING} && $ENV{PERL5_CPAN_IS_RUNNING}) { 15 | $ENV{SITE} = "\\[cpan\\]"; # a subset of tests specially for CPAN testers 16 | } elsif(!$ENV{SITE}) { 17 | # We don't want to do this unless they really meant it, as it downloads a lot. 18 | plan skip_all => "Not going online, set SITE to run these tests"; 19 | exit; 20 | } 21 | 22 | require FlashVideo::Mechanize; 23 | my $mech = FlashVideo::Mechanize->new; 24 | $mech->get("http://www.google.com"); 25 | plan skip_all => "We don't appear to have an internet connection" 26 | if $mech->response->is_error; 27 | 28 | my @urls = assemble_urls(); 29 | plan tests => 5 * scalar @urls; 30 | 31 | my $i = 0; 32 | for my $url_info(@urls) { 33 | my($url, $note) = @$url_info; 34 | $note =~ s/\[.*?\]//g; # metadata (e.g. if cpan testers should run this?) 35 | 36 | my $dir = "test-" . ++$i; 37 | mkpath $dir; 38 | chdir $dir or next; 39 | 40 | diag "Testing $note"; 41 | 42 | # Allow backticks for URLs that change 43 | $url =~ s/\`(.*)\`/`$1`/e; 44 | 45 | my $pid = open3(my $in_fh, my $out_fh, 0, 46 | $^X, "$script", "--yes", '--filename', 'cpan_testing_video', $url); 47 | 48 | while(<$out_fh>) { 49 | DEBUG && diag $_; 50 | } 51 | 52 | waitpid $pid, 0; 53 | ok $? == 0, $note; 54 | 55 | #DEBUG && diag "Files in directory: ", <*>; 56 | 57 | #my @files = <*.{mp4,flv,mov}>; 58 | my $file = "cpan_testing_video"; 59 | #ok @files == 1, "One file downloaded"; 60 | 61 | #ok($files[0] !~ /^video\d{14}\./, "Has good filename"); 62 | 63 | ok(FlashVideo::Downloader->check_file($file), "File is a media file"); 64 | 65 | ok -s $file > (1024*200), "File looks big enough"; 66 | 67 | chdir ".."; 68 | rmtree $dir; 69 | } 70 | 71 | sub assemble_urls { 72 | my @urls; 73 | 74 | open my $url_fh, "<", "urls" or die $!; 75 | my $note; 76 | while(<$url_fh>) { 77 | chomp; 78 | 79 | if(/^#\s*(.*)/) { 80 | $note = $1; 81 | } elsif(/^\S/) { 82 | next if $ENV{SITE} && $note !~ /$ENV{SITE}/i; 83 | push @urls, [ $_, $note ]; 84 | } 85 | } 86 | 87 | return @urls; 88 | } 89 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Adultswim.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Adultswim; 3 | 4 | use strict; 5 | use FlashVideo::Utils; 6 | 7 | our $VERSION = '0.02'; 8 | sub Version() { $VERSION; } 9 | 10 | sub find_video { 11 | my($self, $browser, $embed_url) = @_; 12 | 13 | my $xml; 14 | my $id; 15 | 16 | my $segIds; 17 | if($browser->{content} =~ m/(]* ?name=["']segIds["'] ?[^>]*>)/){ 18 | my $text = $1; 19 | if($text =~ m/content=["']([^"']+)["']/){ 20 | $segIds = $1; 21 | } 22 | } 23 | 24 | ($segIds)=$browser->{content} =~ m/]* ?data-segment-ids=["'](.+?)["'] ?[^>]*>/ if(!$segIds); 25 | my ($id1) = $segIds =~ m/^([0-9a-f]+)/; 26 | 27 | my $title; 28 | if($browser->{content} =~ m//){ 29 | $title = $1; 30 | } 31 | 32 | my $configURL = "/tools/swf/player_configs/watch_player.xml"; 33 | 34 | # foreach($xml->{head}->{script}){ 35 | if($browser->content =~ /pageObj\.configURL = ["']([^"']+)["'];/) { 36 | $configURL = $1; 37 | } 38 | # } 39 | 40 | $browser->get($configURL); 41 | 42 | my $serviceConfigURL; 43 | 44 | if($browser->response->code =~ /^30\d$/){ 45 | 46 | $xml = from_xml($browser); 47 | 48 | if($xml->{serviceConfigURL} ne ""){ 49 | $serviceConfigURL = $1; 50 | } 51 | } else { 52 | $serviceConfigURL = "http://asfix.adultswim.com/staged/AS.configuration.xml"; 53 | } 54 | 55 | $browser->get($serviceConfigURL); 56 | 57 | $xml = from_xml($browser); 58 | 59 | my $getVideoPlayerURL; 60 | if($xml->{config}->{services}->{getVideoPlaylist}->{url} ne ""){ 61 | $getVideoPlayerURL = $1; 62 | } else { 63 | $getVideoPlayerURL = "http://asfix.adultswim.com/asfix-svc/episodeservices/getVideoPlaylist?networkName=AS"; 64 | } 65 | 66 | my $videoURL = "$getVideoPlayerURL&id=$id1"; 67 | $browser->get($videoURL); 68 | 69 | $xml = from_xml($browser); 70 | my $bitrate=-1; 71 | my $file_url; 72 | foreach(@{$xml->{entry}}){ 73 | next if(ref($_) ne 'HASH'); 74 | next if ($_->{ref}->{href} =~ m,\.akamaihd\.net\/,); 75 | next if ($_->{param}->{bitrate} < $bitrate && $_->{ref}->{href} =~ m/iPhone/); 76 | $file_url=$_->{ref}->{href}; 77 | $bitrate=$_->{param}->{bitrate}; 78 | #print STDERR $_->{param}->{bitrate}."\t".$_->{ref}->{href}."\n"; 79 | } 80 | 81 | return $file_url, title_to_filename($title); 82 | } 83 | 84 | 1; 85 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Tv4play.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Tv4play; 3 | use strict; 4 | use warnings; 5 | use FlashVideo::Utils; 6 | use List::Util qw(reduce); 7 | 8 | our $VERSION = '0.03'; 9 | sub Version() { $VERSION;} 10 | 11 | my $bitrate_index = { 12 | high => 0, 13 | medium => 1, 14 | low => 2 15 | }; 16 | 17 | sub find_video { 18 | my ($self, $browser, $embed_url, $prefs) = @_; 19 | my $video_id = ($embed_url =~ /video_id=([0-9]*)/)[0]; 20 | my $smi_url = "http://prima.tv4play.se/api/web/asset/$video_id/play?protocol=hls"; 21 | my $title = extract_title($browser); 22 | $browser->get($smi_url); 23 | my $content = from_xml($browser); 24 | my $subtitle_url; 25 | my $hls_m3u = ""; 26 | my $hls_base; 27 | 28 | my @items; 29 | if (ref $content->{items}->{item} eq 'HASH') { 30 | push(@items, $content->{items}->{item}); 31 | } else { 32 | @items = @{$content->{items}->{item}}; 33 | } 34 | 35 | foreach my $item (@items) { 36 | 37 | # Find playlist item 38 | if ($item->{base} =~ m/.*\.m3u8/) { 39 | $hls_m3u = $item->{url}; 40 | $hls_base = $item->{url}; 41 | # Strip to base 42 | $hls_base =~ s/master\.m3u8//; 43 | } 44 | 45 | # Set subtitles 46 | if ($item->{mediaFormat} eq 'smi') { 47 | $subtitle_url = $item->{url}; 48 | } 49 | } 50 | 51 | if ($hls_m3u eq "") {die "No HLS stream found!"}; 52 | 53 | # Download subtitles 54 | if ($prefs->{subtitles} == 1) { 55 | if (not $subtitle_url eq '') { 56 | $browser->get("$subtitle_url"); 57 | if (!$browser->success) { 58 | info "Couldn't download subtitles: " . $browser->status_line; 59 | } else { 60 | my $srt_filename = title_to_filename($title, "srt"); 61 | info "Saving subtitles as " . $srt_filename; 62 | open my $srt_fh, '>', $srt_filename 63 | or die "Can't open subtitles file $srt_filename: $!"; 64 | binmode $srt_fh, ':utf8'; 65 | print $srt_fh $browser->content; 66 | close $srt_fh; 67 | } 68 | } else { 69 | info "No subtitles found"; 70 | } 71 | } 72 | 73 | my $filename = title_to_filename($title, "mp4"); 74 | 75 | return { 76 | downloader => "hls", 77 | flv => $filename, 78 | args => { hls_url => $hls_m3u, prefs => $prefs } 79 | }; 80 | } 81 | 82 | 1; 83 | -------------------------------------------------------------------------------- /mk/release.mk: -------------------------------------------------------------------------------- 1 | # For project people to easily make releases. 2 | 3 | # Put this in ~/bin: 4 | # http://code.google.com/p/support/source/browse/trunk/scripts/googlecode_upload.py 5 | 6 | release: release-test release-tag release-cpan release-upload deb 7 | svn commit -m "Version $(VERSION)" wiki/Installation.wiki wiki/Version.wiki 8 | 9 | release-test: $(BASEEXT)-$(VERSION) release-combined test 10 | @git status --porcelain | if grep -q . ; then \ 11 | echo "Tree dirty, won't release."; \ 12 | exit 1; \ 13 | else \ 14 | exit 0; \ 15 | fi 16 | 17 | release-cpan: manifest metafile dist 18 | 19 | release-tag: release-test changelog-update wiki-update 20 | git commit -m "Version $(VERSION)" debian/changelog 21 | git tag -a -m "Version $(VERSION)" v$(VERSION) 22 | git push origin v$(VERSION) 23 | 24 | release-upload: release-tag release-cpan deb 25 | googlecode_upload.py -l "Featured,OpSys-All" -s "Version $(VERSION)" -p get-flash-videos $(BASEEXT)-$(VERSION) 26 | googlecode_upload.py -l "OpSys-All" -s "Version $(VERSION) - CPAN dist" -p get-flash-videos $(DISTVNAME).tar.gz 27 | googlecode_upload.py -l "OpSys-All" -s "Version $(VERSION) -- combined version including some required modules." -p get-flash-videos combined-$(BASEEXT)-$(VERSION) 28 | googlecode_upload.py -l "Type-Package,OpSys-Linux" -s "Version $(VERSION) -- Debian package, for Debian and Ubuntu" -p get-flash-videos get-flash-videos_$(VERSION)-1_all.deb 29 | 30 | release-combined: combined-$(BASEEXT)-$(VERSION) 31 | 32 | wiki: 33 | svn checkout https://get-flash-videos.googlecode.com/svn/wiki/ $@ 34 | 35 | changelog-update: 36 | @fgrep -q '$(BASEEXT) ($(VERSION)-1)' debian/changelog || dch -v $(VERSION)-1 37 | 38 | wiki-update: wiki 39 | @cd wiki && svn up 40 | @perl -pi -e's/(get[-_]flash[-_]videos[-_])\d+\.\d+/$${1}$(VERSION)/g' wiki/Installation.wiki 41 | @perl -pi -e's/\d+\.\d+/$(VERSION)/g' wiki/Version.wiki 42 | @svn diff wiki/Installation.wiki wiki/Version.wiki | grep -q . || (echo "Version already released" && exit 1) 43 | @svn diff wiki/Installation.wiki wiki/Version.wiki && echo "OK? (ctrl-c to abort)" && read F 44 | 45 | deb: release-tag 46 | mkdir -p /tmp/deb 47 | git archive --prefix=v$(VERSION)/ v$(VERSION) | tar -xvf - -C /tmp/deb 48 | cd /tmp/deb/v$(VERSION) && (dpkg-buildpackage || echo "Ignoring return value..") 49 | cp /tmp/deb/get-flash-videos_$(VERSION)-1_all.deb . 50 | rm -rf /tmp/deb/v$(VERSION) 51 | 52 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/4od.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::4od; 3 | 4 | # Search support for 4oD (Channel 4 On Demand) on YouTube. 5 | # Downloading is handled by FlashVideo::Site::Youtube. 6 | 7 | use strict; 8 | use FlashVideo::Utils; 9 | use URI::Escape; 10 | 11 | sub search { 12 | my ($self, $search, $type) = @_; 13 | 14 | unless(eval { from_xml("") }) { 15 | if($type eq 'site') { 16 | die $@; 17 | } else { 18 | debug $@; 19 | return; 20 | } 21 | } 22 | 23 | # Use GData API to search 24 | # Note that 50 is the maximum value for max-results. 25 | my $gdata_template_url = 26 | "http://gdata.youtube.com/feeds/api/videos?q=%s&orderby=published&start-index=1&max-results=50&v=2"; 27 | my $search_url = sprintf $gdata_template_url, uri_escape($search); 28 | 29 | my $browser = FlashVideo::Mechanize->new(); 30 | 31 | $browser->get($search_url); 32 | 33 | if (!$browser->success) { 34 | die "Couldn't get YouTube search Atom XML: " . $browser->response->status_line(); 35 | } 36 | 37 | # XML::Simple keys on 'id' and some other things by default which is 38 | # annoying. 39 | my $xml = from_xml($browser, KeyAttr => [], ForceArray => ['entry']); 40 | 41 | # Only care about actual 4od videos, where the author starts with '4od'. 42 | # (Channel 4 uses multiple authors or usernames depending on the type of 43 | # the video, for example 4oDDrama, 4oDFood and so on.) 44 | # Can't use the "author" search because specifying multiple authors 45 | # (comma separated) does not work, contrary to the GData documentation. 46 | my @matches = map { _process_4od_result($_) } 47 | grep { $_->{author}->{name} =~ /^4oD\w+$/i } @{ $xml->{entry} }; 48 | 49 | return @matches; 50 | } 51 | 52 | sub _process_4od_result { 53 | my $feed_entry = shift; 54 | 55 | my $url = $feed_entry->{'media:group'}->{'media:player'}->{url}; 56 | $url =~ s/&feature=youtube_gdata//; 57 | 58 | my $published_date = $feed_entry->{published}; 59 | $published_date =~ s/T.*$//; # only care about date, not time 60 | 61 | my $title = $feed_entry->{'media:group'}->{'media:title'}->{content}; 62 | my $description = $feed_entry->{'media:group'}->{'media:description'}->{content}; 63 | 64 | my $result_name = "$title ($published_date)"; 65 | 66 | return { name => $result_name, url => $url, description => $description }; 67 | } 68 | 69 | 1; 70 | -------------------------------------------------------------------------------- /lib/FlashVideo/Site/Thirteen.pm: -------------------------------------------------------------------------------- 1 | # Part of get-flash-videos. See get_flash_videos for copyright. 2 | package FlashVideo::Site::Thirteen; 3 | use strict; 4 | use FlashVideo::Utils; 5 | use FlashVideo::JSON; 6 | 7 | sub find_video { 8 | my ($self, $browser, $embed_url, $prefs) = @_; 9 | 10 | my $iframe; 11 | if ($browser->content =~ /