pax_global_header00006660000000000000000000000064132400557340014515gustar00rootroot0000000000000052 comment=5934c2251a92fb390caadba388a49448d9a348f2 get-flash-videos-1.25.98/000077500000000000000000000000001324005573400150445ustar00rootroot00000000000000get-flash-videos-1.25.98/.gitignore000066400000000000000000000005301324005573400170320ustar00rootroot00000000000000App-get_flash_videos-* bin/get_flash_videos combined-get_flash_videos* get_flash_videos-* get_flash_videos.1 .sitemodules .DS_Store wiki *.bak *.old *.mp4 *.flv *.m3u8 *.ogg *.ts *.tsx *.webm *.gz .*sw[op] blib pm_to_blib MANIFEST META.yml MYMETA.* mk/makemaker.mk mk/makemaker.mk.old mk/makemaker-wrap.mk # Emacs files # *~ .#* \#*\# \#* TAGS get-flash-videos-1.25.98/LICENSE000066400000000000000000000261361324005573400160610ustar00rootroot00000000000000 Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. get-flash-videos-1.25.98/MANIFEST.SKIP000066400000000000000000000003701324005573400167420ustar00rootroot00000000000000\.git/ App-get_flash_videos-.*/ blib/ debian/ mk/ wiki/ \.sitemodules Makefile$ pm_to_blib bin/get_flash_videos$ combined-get_flash_videos(|-\d.*)$ get_flash_videos-\d.*$ t/test-\d+/ .*\.(flv|mp\d|mpe?g|wmv|avi|mov) .*\.tar\.gz$ ..*sw[op]$ .*\.bak get-flash-videos-1.25.98/Makefile000066400000000000000000000003471324005573400165100ustar00rootroot00000000000000all:: mk/makemaker-wrap.mk: Makefile.PL @if [ ! -f "mk/makemaker.mk" ]; then GFV_DEVEL_MODE=1 perl Makefile.PL; fi @echo "-include mk/makemaker.mk" > $@ -include mk/makemaker-wrap.mk include mk/targets.mk include mk/release.mk get-flash-videos-1.25.98/Makefile.PL000066400000000000000000000034731324005573400170250ustar00rootroot00000000000000#!perl -w use strict; use ExtUtils::MakeMaker; my %mm_vars = ( AUTHOR => 'Monsieur Video ', NAME => 'App::get_flash_videos', ABSTRACT => "Video downloader for various Flash-based video hosting sites", VERSION_FROM => "get_flash_videos", EXE_FILES => ["bin/get_flash_videos"], PL_FILES => { 'bin/get_flash_videos.PL' => 'bin/get_flash_videos' }, MAN1PODS => { 'doc/get_flash_videos.pod' => 'blib/man1/get_flash_videos.1', }, # Avoid man pages for modules for now. MAN3PODS => {}, PREREQ_PM => { URI => 0, 'LWP::UserAgent' => 0, 'WWW::Mechanize' => 0, 'IO::Socket::SSL' => 0, 'LWP::Protocol::https' => 0, 'LWP::Protocol::socks' => 0, 'Module::Find' => 0, 'Term::ProgressBar' => 0, 'Term::ReadKey' => 0, }, ); # Needed for reasonable UTF-8 support, also modules are used that are # core perl as reported by 'corelist' since 5.8. if($ExtUtils::MakeMaker::VERSION >= 6.48) { $mm_vars{MIN_PERL_VERSION} = 5.008; } if($ExtUtils::MakeMaker::VERSION >= 6.46) { $mm_vars{META_MERGE} = { resources => { license => 'http://www.apache.org/licenses/LICENSE-2.0.html', bugtracker => 'https://github.com/monsieurvideo/get-flash-videos/issues', repository => 'http://github.com/monsieurvideo/get-flash-videos', } }; } my $build_req; if($ExtUtils::MakeMaker::VERSION >= 6.55) { $build_req = $mm_vars{BUILD_REQUIRES} ||= {}; } else { $build_req = $mm_vars{PREREQ_PM}; } # Needed for consistent order in t/rtmpdownloader.t $build_req->{"Tie::IxHash"} = 0; if($ENV{GFV_DEVEL_MODE}) { $mm_vars{FIRST_MAKEFILE} = "mk/makemaker.mk"; } WriteMakefile(%mm_vars); get-flash-videos-1.25.98/Makefile.bsd-wrapper000066400000000000000000000013111324005573400207250ustar00rootroot00000000000000# For OpenBSD wrapper to avoid using Gnu make. # Makefile is overloaded as # perl Makefile.PL overwrites. all:: mk/makemaker-wrap.mk: Makefile.PL @if [ ! -f "mk/makemaker.mk" ]; then GFV_DEVEL_MODE=1 perl Makefile.PL; fi @echo "-include mk/makemaker.mk" > $@ mk/makemaker.mk : Makefile.PL get_flash_videos GFV_DEVEL_MODE=1 perl Makefile.PL # Only used in testiing github creates archives for download. OBSDDISTNAME=${DISTVNAME:S/^App-//} distgit: git archive --format=tar.gz --prefix=${OBSDDISTNAME:S/_/-/g}/ \ -o ${OBSDDISTNAME}.tar.gz ${VERSION}^{tree} # No longer used. cleandistgit: clean rm ${DISTNAME}-${VERSION}.tar.gz -include mk/makemaker-wrap.mk include mk/targets.mk include mk/release.mk get-flash-videos-1.25.98/README.md000066400000000000000000000012341324005573400163230ustar00rootroot00000000000000get-flash-videos ================ `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). Installation ------------ See the [Installation wiki](https://github.com/monsieurvideo/get-flash-videos/wiki/Installation). Development ----------- See the [Development wiki](https://github.com/monsieurvideo/get-flash-videos/wiki/Developing). License ------- [Apache License 2.0](http://www.apache.org/licenses/LICENSE-2.0) get-flash-videos-1.25.98/bin/000077500000000000000000000000001324005573400156145ustar00rootroot00000000000000get-flash-videos-1.25.98/bin/get_flash_videos.PL000077500000000000000000000025461324005573400213700ustar00rootroot00000000000000#!perl -w # Generate the CPAN installed version of get_flash_videos, i.e. set # $SCRIPT_NAME. open my $out, ">", $ARGV[0] or die $!; my $install_type = exists $ENV{GFV_INSTALL_TYPE} ? $ENV{GFV_INSTALL_TYPE} : ""; # So, despite having 3 environment variables that seem to serve the purpose of # identifying which CPAN shell you're using various bugs seem to mean they # aren't set how you'd expect. # cpanplus: Look at the version environment variable only (all the other shells # set CPANPLUS_IS_RUNNING). $install_type ||= "cpan-cpanp" if $ENV{PERL5_CPANPLUS_IS_VERSION}; # cpanminus: Appears to be buggy, only PERL5_CPANPLUS_IS_RUNNING is set. (But # also handle the CPANM variable being set just in case someone fixes this # bug). $install_type ||= "cpan-cpanm" if( ($ENV{PERL5_CPANPLUS_IS_RUNNING} and !$ENV{PERL5_CPAN_IS_RUNNING}) || $ENV{PERL5_CPANM_IS_RUNNING}); # cpan: Just check the original environment variable, we've ruled out the other # shells now. $install_type ||= "cpan-cpan" if $ENV{PERL5_CPAN_IS_RUNNING}; # Not under a shell (probably). $install_type ||= "cpan-manual"; # ...phew # Add our header with the type... print $out <; # throw away first line (shebang) for tidyiness. print $out join "", <$in>; get-flash-videos-1.25.98/debian/000077500000000000000000000000001324005573400162665ustar00rootroot00000000000000get-flash-videos-1.25.98/debian/changelog000066400000000000000000000175541324005573400201540ustar00rootroot00000000000000libapp-get-flash-videos-perl (1.24-1) stable; urgency=low * Switch to CPAN style releases -- MonsieurVideo Tue, 30 November 2010 16:26:51 +0100 get-flash-videos (1.23-1) rotten-reindeer; urgency=low * Fix issue with barewords in combined version -- MonsieurVideo Thu, 22 Jul 2010 23:17:51 +0200 get-flash-videos (1.22-1) quaint-quokka; urgency=low * Fix YouTube, BBC, Blip, Break and others * Add support for Abc, Cartoon Network, CBS, Ctv, Gamespot, ITV, NBC, Pennyarcade, Redbull, Stickam, Tou, Traileraddict, TVA (many thanks to various contributions, see git commit logs for details) * Optional preference to download subtitles * Minimal JSON parser * Recognise more QuickTime formats as media * (Switch to github.com for version control) -- MonsieurVideo Thu, 22 Jul 2010 22:51:48 +0200 get-flash-videos (1.21-1) just-do-it; urgency=low * Fix YouTube, Google Video Search, Muzu, eHow, Liveleak, Xnxx. * Add support for IMA (ima.umn.edu), Mitworld. * Minor improvements to generic support. -- MonsieurVideo Sat, 03 Apr 2010 12:07:09 +0000 get-flash-videos (1.20-1) obvious-orangatang; urgency=low * Fix issues with 4oD search which prevented normal searches working when XML modules were not installed. * Don't abort if downloads fail when downloading multiple videos. * Fix metacafe. -- MonsieurVideo Sun, 10 Jan 2010 16:35:43 +0000 get-flash-videos (1.19-1) needy-newt; urgency=low * Add support for Stagevu, Ustream and Techcast. * Ability to select quality of video to download via the --quality option. The default is to download the highest quality, but this can now be overridden on the command line or via the configuration file. See the man page for full details. * Improved support for search plugins. 4od (via YouTube) is included in the distribution, starting a query with "4od" will search only 4od. * Improvements to generic downloading support, including support for .avi files and searching flash parameters. * Some issues fixed on Windows. -- MonsieurVideo Sun, 10 Jan 2010 14:56:34 +0000 get-flash-videos (1.18-1) megalomanical-moose; urgency=low * Add support for YouTube RTMP videos (e.g. Channel 4). * Support rtmpdump 1.9 or flvstreamer. * Support proxies (HTTP or SOCKS) via --proxy option. * Fix redtube, brightcove. -- MonsieurVideo Wed, 02 Dec 2009 22:51:46 +0000 get-flash-videos (1.17-1) liberal-llama; urgency=low * Fix YouTube (again). -- MonsieurVideo Fri, 23 Oct 2009 19:10:06 +0100 get-flash-videos (1.16-1) killer-kangaroo; urgency=low * Fixes for: - YouTube - Fliqz - Nicovideo - Blip - Metacafe * Added support for: - TED - Videojug - Freevideo.ru - Amazon - Onion * Support for external plugins to make it easier for third parties to add support for sites. * Improvements to Windows support - Filenames now saved in Windows codepage (still impossible to e.g. have Japanese filenames on an English Windows, using a proper OS is recommended). - Use VLC for playing if available. -- MonsieurVideo Thu, 22 Oct 2009 18:33:51 +0100 get-flash-videos (1.15-1) jettisoned-jackdaw; urgency=low * Added support for: - Apple - nfb.ca * Fixes for: - 5min - BBC -- MonsieurVideo Wed, 02 Sep 2009 20:00:48 +0100 get-flash-videos (1.14-1) idiotic-iguana; urgency=low * Added support for: - Last.fm - Expertvillage - Tudou - Truveo (incomplete) * Fixed: - Youku - BBC (more embedding types) * Support for downloading multiple videos. * More sites work with generic. * Misc. clean-ups. -- MonsieurVideo Tue, 21 Jul 2009 18:09:12 +0100 get-flash-videos (1.13-1) hysterical-hyena; urgency=low * Add support for Youku. * Fixes for Break, BBC, YouTube. * Enhancements to generic support to support some more sites. * Bug fix for gzipped downloads. * Bug fix for --filename option. -- MonsieurVideo Mon, 25 May 2009 21:07:26 +0100 get-flash-videos (1.12-1) goaty-goodness; urgency=low * Add missing WWW::Mechanize::Link to the combined script, so search works. -- MonsieurVideo Mon, 18 May 2009 20:55:46 +0100 get-flash-videos (1.11-1) stable; urgency=low * Added support for Flickr, fora.tv, Gawker. * Fixes to support more embedding types for Brightcove. * Fixes to generic to work on more sites. * Some i18n fixes for title extraction. * Fix for the download progress on long filenames. * Fix for a build issue in the combined script. -- MonsieurVideo Mon, 18 May 2009 20:50:40 +0100 get-flash-videos (1.10-1) stable; urgency=low * Support for searching Google Video and downloading matching videos. * Handle rtmpdump 1.5 output (we now need version 1.5, won't work very well on older versions). * Fixes for Mtvnservices sites requiring SWF verification. -- MonsieurVideo Mon, 11 May 2009 18:11:09 +0100 get-flash-videos (1.9-1) stable; urgency=low * Add support for Mtvnservices (used by various sites, including comedycentral). * Fix support for Megavideo and GrindTV which didn't work correctly in the previous release. -- MonsieurVideo Tue, 05 May 2009 20:54:40 -0000 get-flash-videos (1.8-1) stable; urgency=low * Added support for Megavideo, Spike.com and Wat.tv. * Some fixes to generic to support more sites. -- MonsieurVideo Mon, 04 May 2009 20:43:12 -0000 get-flash-videos (1.7-1) stable; urgency=low * Add sites: - Blip (explicit support -- mostly worked with generic before) - GrindTV, Stupidvideos and RingTV (all same platform) * Fix sites: - Dailymotion (embedded videos) - Google Video (some files didn't work) - Break (minor change to embedding method) - BBC (Support for playing live streams, needs a patched rtmpdump: http://get-flash-videos.googlecode.com/svn/misc/rtmpdump-fcsubscribe.patch, this is still rather buggy) * New --play option, for playing the video as well as downloading it. There is also an associated --player option to specify the player to use. * New --debug and --quiet options to print more and less output respectively. * Now reads config files from /etc/get_flash_videosrc and ~/.get_flash_videosrc, in a simple name = value format that matches the command line options. * Report progress for RTMP downloads in the same way as HTTP downloads. * Release now includes a Debian package. -- MonsieurVideo Sun, 26 Apr 2009 21:29:18 +0100 get-flash-videos (1.6-1) stable; urgency=low * Resume support for RTMP downloads. -- zakflashvideo Fri, 17 Apr 2009 20:12:45 -0000 get-flash-videos (1.5-1) stable; urgency=low * Add sites: - Xnxx/Xvideo - Collegehumor - Today's big thing * Fix sites: - Dailymotion (title extraction) * Print friendlier error messages when we are unable to extract a video. -- MonsieurVideo Tue, 14 Apr 2009 20:54:05 -0000 get-flash-videos (1.4-1) stable; urgency=low * Add sites: - Dailymotion - Videolectures - Muzu * Fix sites: - BBC (more embedding methods supported) - Brightcove (another embedding method) * Check the downloaded file is a valid media file. -- MonsieurVideo Fri, 10 Apr 2009 20:12:08 -0000 get-flash-videos (1.3-1) stable; urgency=low * Support for --update option for online updates. -- MonsieurVideo Mon, 06 Apr 2009 21:54:38 -0000 get-flash-videos-1.25.98/debian/compat000066400000000000000000000000021324005573400174640ustar00rootroot000000000000007 get-flash-videos-1.25.98/debian/control000066400000000000000000000022501324005573400176700ustar00rootroot00000000000000Source: libapp-get-flash-videos-perl Section: utils Priority: optional Build-Depends: debhelper (>= 7) Build-Depends-Indep: libmodule-find-perl, libtie-ixhash-perl, liburi-perl, libwww-mechanize-perl, libwww-perl, libxml-simple-perl, perl Maintainer: Monsieur Video Standards-Version: 3.8.3 Homepage: http://code.google.com/p/get-flash-videos/ Package: get-flash-videos Architecture: all Depends: libcrypt-blowfish-pp-perl, libdata-amf-perl, libencode-locale-perl, libhtml-parser-perl, libhtml-tree-perl, libmodule-find-perl, libtie-ixhash-perl, liburi-perl, libwww-mechanize-perl, libwww-perl, ${misc:Depends}, ${perl:Depends} Recommends: get-iplayer, ffmpeg | libav-tools, libcrypt-rijndael-perl, liblwp-protocol-socks-perl, libxml-simple-perl, rtmpdump|flvstreamer Suggests: mplayer Description: Video downloader for various Flash-based video hosting sites Download videos from various Flash-based video hosting sites, without having to use the Flash player. Handy for saving viqeos for watching offline, and means you don't have to keep upgrading Flash for sites that insist on a newer version of the player. get-flash-videos-1.25.98/debian/copyright000066400000000000000000000020251324005573400202200ustar00rootroot00000000000000This package was debianized by MonsieurVideo on Sun, 26 Apr 2009 12:46:52 +0100. It was downloaded from Upstream Author(s): MonsieurVideo zakflash Copyright: Copyright 2009 MonsieurVideo Copyright 2009 zakflash License: Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. The Debian packaging is copyright 2009, MonsieurVideo and is licensed under the GPL, see `/usr/share/common-licenses/GPL'. get-flash-videos-1.25.98/debian/dirs000066400000000000000000000000101324005573400171410ustar00rootroot00000000000000usr/bin get-flash-videos-1.25.98/debian/rules000077500000000000000000000000361324005573400173450ustar00rootroot00000000000000#!/usr/bin/make -f %: dh $@ get-flash-videos-1.25.98/doc/000077500000000000000000000000001324005573400156115ustar00rootroot00000000000000get-flash-videos-1.25.98/doc/get_flash_videos.pod000066400000000000000000000145321324005573400216270ustar00rootroot00000000000000=head1 NAME get_flash_videos - Video downloader for various Flash-based video hosting sites =head1 SYNOPSIS get_flash_videos [OPTION]... URL... get_flash_videos [OPTION]... SEARCH =head1 DESCRIPTION Download the Flash video from the web pages given in C, choosing suitable filenames for each. Alternatively if C is specified (either quoted or unquoted), B will search Google Video for C, and present a list of videos to download. B attempts to support many video sites, therefore there is no list of supported sites in this manual page as it frequently changes, see the website for a list. =head1 OPTIONS =over 4 =item I<-d>, I<--debug> Print extra debugging information. =item I<-f>, I<--filename> Save downloaded file to the specified filename. Usually this shouldn't be necessary, as C tries to use a meaningful name for the video. =item I<-r>, I<--quality> The quality of the video to attempt to download. Some sites offer videos in multiple qualities; this will let you specify which quality to prefer. C will aim to download a video at the specified quality or lower, if no video is available at that quality it will download the next highest quality video available. You can specify a quality as either: =over 4 =item * high =item * medium =item * low =back or a target resolution: =over 4 =item * 1080p (1920x1080) =item * 720p (1280x720) =item * 576p (720x576) =item * 480w (854x480) =item * 480p (640x480) =item * 240w (427x240) =item * 240p (320x240) =back High corresponds to 1080p or 720p, medium to 576p, 480w and 480p and low to 240w and 240p. The default is B. =item I<-p>, I<--play> Begin playing the video once enough of the file has been downloaded. =item I<--player=C> Specify the player to use for the C<--play> option. Any occurrence of C<%s> in this string will be replaced with the filename of the video (appropriately shell escaped). The default on *nix operating systems is to use mplayer: mplayer -really-quiet %s You may wish to automatically delete the video after you have viewed it: mplayer -really-quiet %s; rm %s On Windows, if C<-p> or C<--play> is specified but no player is specified, VLC (if installed) will be used to play the video. There is no need to specify where you have installed VLC - this will be automatically retrieved from the registry. =item I<--proxy> Proxy to use, a SOCKS proxy or HTTP proxy can be specified. To specify a SOCKS proxy, simply provide the host and port in host:port format. If port is not specified, 1080 is assumed. C is required for SOCKS support. To specify an HTTP proxy, provide the proxy URL, for example C. For proxying RTMP downloads, SOCKS is required along with a version of C which supports SOCKS proxying. If no proxy is specified on the command line or the config file the C<$HTTP_PROXY> environment variable will be used. =item I<--subtitles> Download subtitles for the video, if available. Subtitles are converted to SubRip format and saved to a file of the same name as the video file, but with an extension of 'srt'. =item I<--raw> HLS downloads are run through ffmpeg/avconv to cleanup audio by default, this options turn it off. =item I<-t>, I<--type> For sites that have multiple download type force selected type, 'hls' or 'rtmp'. =item I<-q>, I<--quiet> Be quiet, only print errors. =item I<-v>, I<--version> Print the version of B. =item I<-y>, I<--yes> Do not prompt with any questions, just say 'yes'. This means either literally yes, or the default or first option if choosing from a list. =item I<--add-plugin=C> Add an external plugin from a specified URL or local file. =back =head1 CONFIGURATION On startup B will read the configuration files located at F and then F<~/.get_flash_videosrc>. The files follow a simple C convention where the name matches the long version of the command line options. For example if you want to specify the default player, to always say yes and to always run the player the file might look like: player = my-video-player %s 2>/dev/null; rm -f %s yes # Always play the video play Options given on the command line will override these options, with the exception that it is not currently possible to disable an option enabled in the configuration file from the command line. =head1 EXAMPLES Play a video (may prompt for filename still, override with I<-y>): get_flash_videos -p http://some.site/video Download a video (note quotes are required for URLs with special characters like C<&> in): get_flash_videos "http://some.site/video?f=1&v=1234" Play the URL on the clipboard (UNIX): xclip -o | xargs get_flash_videos -y -p Play the URL on the clipboard (OSX): pbpaste | xargs get_flash_videos -y -p (Note if there is text on the clipboard rather than a URL above then get_flash_videos will search for it). Play the first video matching "Open Source": get_flash_videos -y -p Open Source =head1 BUGS Third party sites are a moving target therefore it is possible support for some of the sites may not work correctly. First check that you are using the latest version. If you wish to see open bugs or report a bug visit L. =head1 HACKING If you'd like to change or improve B (for example adding support for another site), please see the project wiki where there's an overview to help you get started, and a detailed tutorial on adding support for a new site: L. =head1 COPYRIGHT Copyright 2009, zakflash and MonsieurVideo Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at L Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. Contributions are welcome and encouraged, but please take care to maintain the JustWorks(tm) nature of the program. get-flash-videos-1.25.98/get_flash_videos000077500000000000000000000526661324005573400203160ustar00rootroot00000000000000#!/usr/bin/env perl # # get_flash_videos -- download all the Flash videos off a web page # # https://github.com/monsieurvideo/get-flash-videos # # Copyright 2009, 2010 zakflash, MonsieurVideo and contributors. # # Licensed under the Apache License, Version 2.0 (the "License"); you may # not use this file except in compliance with the License. You may obtain a # copy of the License at # http://www.apache.org/licenses/LICENSE-2.0 # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, WITHOUT # WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the # License for the specific language governing permissions and limitations # under the License. # # Contributions are welcome and encouraged, but please take care to # maintain the JustWorks(tm) nature of the program. package App::get_flash_videos; use strict; use Encode (); use File::Basename qw(basename); use File::stat; use Getopt::Long; use Text::Wrap; BEGIN { if(!$::SCRIPT_NAME) { # Are we running in development mode? require Cwd; require File::Spec; my($vol, $dir) = (File::Spec->splitpath(Cwd::realpath($0)))[0, 1]; unshift @INC, File::Spec->catpath($vol, File::Spec->catdir($dir, "lib")); } } use FlashVideo::URLFinder; use FlashVideo::Mechanize; use FlashVideo::Downloader; use FlashVideo::RTMPDownloader; use FlashVideo::HLSDownloader; use FlashVideo::DASHDownloader; use FlashVideo::HLSXDownloader; use FlashVideo::Search; use FlashVideo::Utils; use FlashVideo::VideoPreferences; unshift @INC, \&plugin_loader; # single line for MakeMaker to get version use constant CVERSION => "1.25.98"; our $VERSION = CVERSION; our %opt; BEGIN { my $player = "mplayer -really-quiet"; # We have special handling for "VLC" on Windows $player = "VLC" if $^O =~ /MSWin/i; # On OSX we default to open, if mplayer isn't available $player = "open" if $^O =~ /darwin/ && !is_program_on_path("mplayer"); if(is_program_on_path("xdg-open") && !is_program_on_path("mplayer")) { # If mplayer isn't available, but xdg-open is, use that. $player = "xdg-open"; } elsif(is_program_on_path("gnome-open") && !is_program_on_path("mplayer")) { # Alternatively try gnome-open.. $player = "gnome-open"; } elsif(is_program_on_path("kde-open") && !is_program_on_path("mplayer")) { # Alternatively try kde-open.. $player = "kde-open"; } %opt = ( yes => 0, filename => '', version => 0, update => 0, play => 0, player => $player, proxy => '', debug => 0, quiet => 0, quality => "high", raw => 1, type => '', subtitles => 0, info => 0 ); } # constant evaluated at compile time, can't use runtime variables. use constant VER_INFO => "get_flash_videos version " . CVERSION . " (https://github.com/monsieurvideo/get-flash-videos)\n"; use constant USAGE => VER_INFO . < < < \$opt{yes}, "filename|f=s" => \$opt{filename}, "version|v" => \$opt{version}, "help|h" => \$opt{help}, "play|p" => \$opt{play}, "player=s" => \$opt{player}, "proxy=s" => \$opt{proxy}, "debug|d" => \$opt{debug}, "quiet|q" => \$opt{quiet}, "add-plugin=s" => \$opt{add_plugin}, "quality|r=s" => \$opt{quality}, "raw" => \$opt{raw}, "type|t=s" => \$opt{type}, "subtitles" => \$opt{subtitles}, "info|i" => \$opt{info}, ) or die "Try $0 --help for more information.\n"; if($opt{version}) { die VER_INFO; } elsif($opt{update}) { exit update(); } elsif($opt{help}) { die USAGE; } elsif($opt{add_plugin}) { exit add_plugin($opt{add_plugin}); } if ($opt{debug}) { if(my @plugins = get_installed_plugins()) { debug @plugins . " plugin" . (@plugins != 1 && "s") . " installed:"; debug "- $_" for @plugins; } else { debug "No plugins installed"; } } if($^O =~ /MSWin/i) { $opt{filename} = Encode::decode(get_win_codepage(), $opt{filename}); binmode STDERR, ":encoding(" . get_win_codepage() . ")"; binmode STDOUT, ":encoding(" . get_win_codepage() . ")"; } else { $opt{filename} = Encode::decode("utf-8", $opt{filename}); binmode STDERR, '<:encoding(UTF-8)'; binmode STDOUT, '<:encoding(UTF-8)'; } my (@urls) = @ARGV; @urls > 0 or die USAGE; # Search string can either be quoted or unquoted (for ultimate laziness) my $search; if ( ((@urls == 1) and $urls[0] !~ m'\.') or ( (@urls > 1) and ! grep /^http:\/\/|^[\w\-]+\.[\w\-]+/, @urls)) { $search = join ' ', @urls; } my @download_urls; if ($search) { if (my @results = FlashVideo::Search->search($search, 10, 20)) { if ($opt{yes} or @results == 1) { my $message = (@results == 1) ? "Downloading only match for '$search': '$results[0]->{name}'" : "Downloading first match for '$search': '$results[0]->{name}'" ; info $message; push @download_urls, $results[0]->{url}; } else { print "Search for '$search' found these results:\n"; # Need 5 chars for "[nn] ". my $columns = get_terminal_width() - 5; local $Text::Wrap::columns = $columns; my $count = 1; for my $result(@results) { printf "[%2d] %s\n", $count, $result->{name}; if ($result->{description}) { # Show as much of the description as will fit on at least 2 # lines in the current terminal width. (Not exact because # Text::Wrap wraps only after whole words.) print wrap(" ", " ", substr($result->{description}, 0, $columns * 2)), "\n"; } $count++; } print "Enter the number(s) or range (e.g. 1-3) of the videos to download " . "(separate multiple with comma or space): "; chomp(my $choice = ); $choice ||= 1; for(split /[ ,]+/, $choice) { if (/-/) { my ($lower, $upper) = split /-/, $choice; if ($upper > $lower and $upper > 0) { push @download_urls, map { $results[$_]->{url} } $lower - 1 .. $upper - 1; next; } else { print STDERR "Search range '$_' is invalid.\n"; exit 1; } } $_--; if (!$results[$_]) { print STDERR "'$_' is an invalid choice.\n"; exit 1; } push @download_urls, $results[$_]->{url}; } } } else { print STDERR "No results found for '$search'.\n"; exit 1; } } else { @download_urls = @urls; } my $download_count = 0; # Construct a preferences object for these downloads, currently just based on # the command line options. my $prefs = FlashVideo::VideoPreferences->new(%opt); foreach my $url (@download_urls) { if (download($url, $prefs, @download_urls - $download_count)) { $download_count++; } } if($download_count == 0) { info "Couldn't download any videos."; exit 1; } elsif($download_count != @download_urls) { info "Problems downloading some videos."; exit 2; } exit 0; sub download { my($url, $prefs, $remaining) = @_; $url = "http://$url" if $url !~ m!^\w+:!; # Might be downloading from a site that uses Brightcove or other similar # Flash RTMP streaming server. These are handled differently. Need to get # the page to determine this. my $browser = FlashVideo::Mechanize->new; # Figure out what package we need to use to get either the HTTP URL or # rtmpdump data for the video. my($package, $possible_url) = FlashVideo::URLFinder->find_package($url, $browser); # Before fetching the url, give the package a chance if($package->can("pre_find")) { $package->pre_find($browser); } info "Downloading $url"; $browser->get($url); # Handle short url which redirect... if ($browser->response->is_redirect and ($url ne $possible_url)) { info "Downloading redirected $possible_url"; $browser->get($possible_url); } # (Redirect check is for Youtube which sometimes redirects to login page # for "mature" videos.) if (!$browser->success and !$browser->response->is_redirect) { if ($opt{proxy}) { if ($browser->response->header('Client-Warning') eq 'Internal response') { info "Couldn't download $url - might not be able to contact " . "your proxy server ($opt{proxy})"; } } error "Couldn't download '$url': " . $browser->response->status_line; } my($actual_url, @suggested_fnames) = eval { $package->find_video($browser, $possible_url, $prefs); }; if(!$actual_url) { if($@ =~ /^Must have | requires /) { my $error = "$@"; $error =~ s/at $0.*//; print STDERR "$error" . REQ_INFO; return 0; } else { print STDERR "Error: $@" . FRIENDLY_FAILURE; return 0; } } my $suggested_filename = $suggested_fnames[-1]; if (ref($actual_url) eq 'HASH') { $suggested_filename ||= $actual_url->{flv}; } if (!$opt{play}) { if (!$opt{yes} && !$opt{filename} && @suggested_fnames > 1) { print "There are different suggested filenames, please choose:\n"; my $count; foreach my $filename (@suggested_fnames) { $count++; print "$count - $filename\n"; } print "\nWhich filename would you like to use?: "; chomp(my $chosen_fname = ); $suggested_filename = $suggested_fnames[$chosen_fname - 1] || $suggested_fnames[-1]; } } my $save_as = $opt{filename} || $suggested_filename; # Print info instead of downloading if($opt{info}) { if(ref($actual_url) eq 'ARRAY') { for my $data(@$actual_url) { print "Filename: " . $data->{flv} . "\n"; $_ = $suggested_filename || $data->{flv}; s/_/ /g; s/\.[^\.]*$//; print "Title: " . $_ . "\n"; print "Content-Location: " . $data->{rtmp} . "\n"; print "\n"; } } else { print "Filename: " . ($save_as || $actual_url->{flv}) . "\n"; $_ = $suggested_filename || $actual_url->{flv}; s/_/ /g; s/\.[^\.]*$//; print "Title: " . $_ . "\n"; print "Content-Location: "; if(ref($actual_url) eq 'HASH') { print $actual_url->{rtmp} . "\n"; } else { print $actual_url . "\n"; $browser->head($actual_url); if($browser->response->header('Content-Length')) { print "Content-Length: " . $browser->response->header('Content-Length') . "\n"; } } } exit; } my $action = $opt{play} ? "play" : "download"; for my $data((ref($actual_url) eq 'ARRAY' ? @$actual_url : $actual_url)) { my $downloader; my $file = $save_as; if(ref $data eq 'HASH') { if (defined($data->{downloader}) && $data->{downloader} eq "hls") { $downloader = FlashVideo::HLSDownloader->new; } elsif (defined($data->{downloader}) && $data->{downloader} eq "hlsx") { $downloader = FlashVideo::HLSXDownloader->new; } elsif (defined($data->{downloader}) && $data->{downloader} eq "dash") { $downloader = FlashVideo::DASHDownloader->new; } else { # RTMP data $downloader = FlashVideo::RTMPDownloader->new; } $file ||= $data->{flv}; } else { # HTTP $downloader = FlashVideo::Downloader->new; } # XXX: Needs some thought, but this hack works for Youku for now it seems. if (ref $data eq 'ARRAY') { my ($url, $part_number, $part_count, $part_size) = @$data; $data = $url; if (defined $part_number && defined $part_count) { my $part_suffix = sprintf('.part%02d_of_%02d', $part_number, $part_count); substr $file, rindex($file, '.'), 0, $part_suffix if $part_count > 1; } if (defined $part_size && -f $file && -s $file == $part_size) { info "Already downloaded $file ($part_size bytes)"; next; } } my $size = $downloader->$action($data, $file, $browser) || return 0; info "\n" . ($remaining == 1 ? "Done. " : "") . "Saved $size bytes to $downloader->{printable_filename}"; } return 1; } sub read_conf { for my $file("/etc/get_flash_videosrc", "$ENV{HOME}/.get_flash_videosrc") { open my $fh, "<", $file or next; while(<$fh>) { s/\r?\n//; next if /^\s*(#|$)/; my($n, $v) = split /\s*=\s*/; $v = 1 unless defined $v; $opt{$n} = $v; } } } sub add_plugin { my($plugin_url) = @_; my $uri = URI->new($plugin_url); unless(-d get_plugin_dir()) { require File::Path; File::Path::mkpath(get_plugin_dir()) or die "Unable to create plugin dir: $!"; } my $filename = get_plugin_dir() . "/" . basename($uri->path); if($filename !~ /\.pm$/) { die "Plugins must have a file extension of '.pm'\n"; } if(!$uri->scheme) { # Local path given require File::Copy; File::Copy::copy($plugin_url => $filename) || die "Unable to copy plugin to '$filename': $!\n"; info "Plugin installed."; return 0; } else { my $browser = FlashVideo::Mechanize->new; return !install_plugin($browser, $plugin_url, $filename); } } sub update { my %update_types = ( 'cpan-cpan' => [1, "cpan " . __PACKAGE__], 'cpan-cpanp' => [1, "cpanp i " . __PACKAGE__], 'cpan-cpanm' => [1, "cpanm " . __PACKAGE__], 'cpan-manual' => [0, "Manual install"], ); # SCRIPT_NAME is some magic set by combine-perl or via MakeMaker if($::SCRIPT_NAME) { my $browser = FlashVideo::Mechanize->new; $browser->get("https://github.com/monsieurvideo/get-flash-videos/wiki/Version"); if(!$browser->response->is_success) { die "Unable to retrieve version data: " . $browser->response->status_line . "\n"; } my $version = ($browser->content =~ /version: (\S+)/)[0]; my $base = ($browser->content =~ /from: (\S+)/)[0]; my $info = ($browser->content =~ /info: (\S+)/)[0]; my $url = $base . $::SCRIPT_NAME . "-" . $version; die "Unable to parse version data" unless $version and $base; # Split version on . and compare... (can't yet use version, that is only # core since 5.10). my @v = split /\./, $version; my @V = split /\./, $VERSION; my $newer = 0; my $i = 0; for(@v) { $newer = 1 if !defined $V[$i] || $_ > $V[$i]; last if $V[$i] > $v[$i]; $i++; } if($newer) { info "Newer version ($version) available"; debug "(Install type: $::INSTALL_TYPE)"; if($::INSTALL_TYPE =~ /^cpan-/) { my $update_method = $update_types{$::INSTALL_TYPE}; if($update_method->[0]) { info "This was installed via CPAN, you may upgrade by running:"; info $update_method->[1]; my $run_cpan = $opt{yes} || do { info "Shall I run that for you? (Y/n)"; =~ /(?:^\s*$|y)/i; }; if($run_cpan) { system $update_method->[1]; } } else { info "Please visit https://github.com/monsieurvideo/get-flash-videos/releases to upgrade"; } } else { update_script($browser, $url, $info); } } else { print STDERR "You already have the latest version.\n"; } } else { info "Development version, not updated"; } update_plugins(); return 0; # exit code } sub update_script { my($browser, $url, $info) = @_; info "Downloading new version..."; die "Cannot update -- unable to write to $0\n" unless -w $0; my $new_file = $0 . ".new"; $browser->mirror($url, $new_file); if($browser->response->is_success && -f $new_file) { rename $0, "$0.old" or die "Unable to rename $0 to $0.old: $!"; rename $new_file, $0 or die "Unable to rename $new_file to $0: $!"; chmod 0755, $0; info "New version installed as $0"; info "(previous version backed up to $0.old)."; info $info; } else { die "Download failed: " . $browser->response->status_line; } } sub update_plugins { my $browser = FlashVideo::Mechanize->new; foreach my $plugin(get_installed_plugins()) { debug "Seeing if there is an update for $plugin.."; my $file = get_plugin_dir() . "/$plugin"; require $file; my $package = "FlashVideo::Site::" . ($plugin =~ /(.*)\.pm$/)[0]; if($package->can("update")) { # Allow plugin to override generic updater $package->update(); } else { no strict 'refs'; my $downloaded = 0; my $newer_found = 0; foreach my $update_url (@{ "$package\::update_urls" }) { $browser->head($update_url); if (!$browser->response->is_success) { # This shouldn't be fatal debug "Couldn't retrieve $update_url for $plugin: " . $browser->response->status_line; next; } # Compare the last modified time of the plugin to the time of the file on disk my $file_mtime = stat($file)->mtime; my $remote_plugin_mtime = $browser->response->last_modified; if ($remote_plugin_mtime > $file_mtime) { info "Newer version of plugin $plugin found at $update_url, trying to download and install"; $newer_found = 1; if ($downloaded = install_plugin($browser, $update_url, $file)) { last; } } else { debug "Plugin $plugin is already the lastest version."; debug "(Remote: " . $browser->response->header("Last-Modified") . "; Local: " . gmtime($file_mtime) . " GMT)"; } } if ($newer_found and !$downloaded) { die "Couldn't install $plugin plugin"; } } } } # Upgrade a plugin or install a new one. sub install_plugin { my ($browser, $url, $file) = @_; # So we can track newly installed plugins as well as updated ones my $plugin_exists = -f $file; my $new_file = $plugin_exists ? "$file.new" : $file; $browser->mirror($url, $new_file); if ($browser->response->is_success && -f $new_file) { my $short_name = basename($file); if ($plugin_exists) { rename $file, "$file.old" or die "Unable to rename $file to $file.old: $!"; rename $new_file, $file or die "Unable to rename $new_file to $file: $!"; info "New version of $short_name installed as $file"; info "(previous version backed up to $file.old)."; } else { info "New plugin $short_name installed as $file"; } return 1; } # Handle redirects from plugin URL's, e.g. http to https # elsif ($browser->response->is_redirect) { my $redirect_url = $browser->response->header('Location'); # Reconstruct new URI to account for relative redirect URL's # $redirect_url = URI->new_abs($redirect_url, $browser->response->base); info "Plugin download redirected $redirect_url"; return install_plugin($browser, $redirect_url, $file); } else { warn "Download failed: " . $browser->response->status_line; } return 0; } # Coderef to this in @INC means Perl will call it for every module that it # tries to load, including our internal FlashVideo::Site:: modules. Use # this to load plugins off disk to support seperately distributed plugins. sub plugin_loader { my (undef, $module) = @_; if ($module =~ m'^FlashVideo/Site/(.*)') { # Don't want to force people to have a FlashVideo/Site directory # structure in their plugins directory, as this makes it harder to # install plugins manually. my $plugin_name = $1; my $plugin_dir = get_plugin_dir(); debug "Trying to open plugin $plugin_dir/$plugin_name"; if (-s "$plugin_dir/$plugin_name") { if (open my $plugin_fh, '<', "$plugin_dir/$plugin_name") { return $plugin_fh; # Perl then reads the plugin from the FH } info "Failed to open plugin $plugin_dir/$plugin_name $!"; } } return; } sub get_installed_plugins { my $plugin_dir = get_plugin_dir(); my @plugins; if (opendir my $plugin_dir_dh, $plugin_dir) { @plugins = grep /\.pm$/i, readdir $plugin_dir_dh; closedir $plugin_dir_dh; } return @plugins; } # This is called in debug mode to get a list of installed plugins, so have # it as a separate function. sub get_plugin_dir { return get_user_config_dir() . "/plugins"; } get-flash-videos-1.25.98/lib/000077500000000000000000000000001324005573400156125ustar00rootroot00000000000000get-flash-videos-1.25.98/lib/FlashVideo/000077500000000000000000000000001324005573400176365ustar00rootroot00000000000000get-flash-videos-1.25.98/lib/FlashVideo/DASHDownloader.pm000066400000000000000000000006131324005573400227320ustar00rootroot00000000000000# Part of get-flash-videos. See get_flash_videos for copyright. package FlashVideo::DASHDownloader; use strict; use warnings; use base 'FlashVideo::Downloader'; use FlashVideo::Utils; use FlashVideo::JSON; use Term::ProgressBar; my $bitrate_index = { high => 0, medium => 1, low => 2 }; sub download { my ($self, $args, $file, $browser) = @_; info "Not implemented yet"; } 1; get-flash-videos-1.25.98/lib/FlashVideo/Downloader.pm000066400000000000000000000225561324005573400223040ustar00rootroot00000000000000# Part of get-flash-videos. See get_flash_videos for copyright. package FlashVideo::Downloader; use strict; use FlashVideo::Utils; use base "FlashVideo::Site"; sub new { my $class = shift; my $self = { has_readkey => scalar eval { require Term::ReadKey } }; bless $self, $class; return $self; } sub play { my ($self, $url, $file, $browser) = @_; $self->{stream} = sub { $self->{stream} = undef; if ($^O =~ /MSWin/i and $self->player eq "VLC") { # mplayer is the default - but most Windows users won't have it. If no # other player is specified, check to see if VLC is installed, and if so, # use it. In future perhaps this should use Win32::FileOp's # ShellExecute (possibly with SW_SHOWMAXIMIZED depending on video # resolution) to open in the default media player. However, this # isn't ideal as media players tend to pinch each other's file # associations. if (my $vlc_binary = FlashVideo::Utils::get_vlc_exe_from_registry()) { require Win32::Process; require File::Basename; require File::Spec; $file = File::Spec->rel2abs($file); # For absolutely no valid reason, Win32::Process::Create requires # *just* the EXE filename (for example vlc.exe) and then any # subsequent parameters as the "commandline parameters". Since # when is the EXE filename (which, of course, has already been # supplied) a commandline parameter?! my $binary_no_path = File::Basename::basename $vlc_binary; my $binary_just_path = File::Basename::dirname $vlc_binary; # Note info() is used because the player is launched when >=n% of # the video is complete (so the user doesn't have to wait until # it's all downloaded). die() wouldn't be good as we then wouldn't # download the remainder of the video. my $process; Win32::Process::Create( $process, $vlc_binary, "$binary_no_path $file", 1, 32, # NORMAL_PRIORITY_CLASS $binary_just_path, ) or info "Couldn't launch VLC ($vlc_binary): " . Win32::GetLastError(); } } else { # *nix my $pid = fork; die "Fork failed" unless defined $pid; if(!$pid) { exec $self->replace_filename($self->player, $file); die "Exec failed\n"; } } }; $self->download($url, $file, $browser); } sub download { my ($self, $url, $file, $browser) = @_; $self->{printable_filename} = $file; $file = $self->get_filename($file); # Support resuming my $mode = (-e $file) ? '>>' : '>'; my $offset; if ($file ne '-' && -e $file) { $offset = -s $file; my $response = $browser->head($url); # File might be fully downloaded, in which case there's nothing to # resume. if ($offset == $response->header('Content-Length')) { error "File $self->{printable_filename} has been fully downloaded."; $self->{stream}->() if defined $self->{stream}; return; } info "File $self->{printable_filename} already exists, seeing if resuming is supported."; if (!$response->header('Accept-Ranges')) { if(!$self->yes) { error "This server doesn't explicitly support resuming.\n" . "Do you want to try resuming anyway (y/n)?"; chomp(my $answer = ); if (!$answer or lc($answer) eq 'n') { undef $offset; $mode = '>'; } } } else { info "Server supports resuming, attempting to resume."; } } my $video_fh; if($file eq '-') { $video_fh = \*STDOUT; } else { open $video_fh, $mode, $file or die $!; } binmode $video_fh; $self->{fh} = $video_fh; info "Downloading $url..."; if ($offset) { $browser->add_header("Range", "bytes=$offset-"); } my $response = $browser->get($url, ':content_cb' => sub { my ($data, $response) = @_; # If we're resuming, Content-Length will just be the length of the # range the server is sending back, so add on the offset to make % # completed accurate. if (!$self->{content_length}) { $self->{content_length} = $response->header('Content-Length') + $offset; if($response->header('Content-encoding') =~ /gzip/i) { eval { require Compress::Zlib; } or do { error "Must have Compress::Zlib installed to download from this site.\n"; exit 1; }; my($inflate, $status) = Compress::Zlib::inflateInit( -WindowBits => -Compress::Zlib::MAX_WBITS()); error "inflateInit failed: $status" if $status; $self->{filter} = sub { my($data) = @_; if(!$self->{downloaded}) { Compress::Zlib::_removeGzipHeader(\$data); } my($output, $status) = $inflate->inflate($data); return $output; } } } if ($offset and !$response->header('Content-Range')) { error "Resuming failed - please delete $self->{printable_filename} and restart."; exit 1; } else { $self->{downloaded} = $offset unless $self->{downloaded}; } my $len = length $data; if($self->{filter}) { $data = $self->{filter}->($data); } return unless $data; my $fh = $self->{fh}; print $fh $data || die "Unable to write to '$self->{printable_filename}': $!\n"; if(defined $self->{stream}) { if($self->{downloaded} > 300_000) { $self->{stream}->(); } } if(!$self->{downloaded} && length $data > 16) { if(!$self->check_magic($data)) { error "Sorry, file does not look like a media file, aborting."; exit 1; } } $self->{downloaded} += $len; $self->progress; }, ':read_size_hint' => 16384); if($browser->response->header("X-Died")) { error $browser->response->header("X-Died"); } close $self->{fh} || die "Unable to write to '$self->{printable_filename}': $!"; if ($browser->success) { return $self->{downloaded} - $offset; } else { unlink $file unless -s $file; error "Couldn't download $url: " . $browser->response->status_line; return 0; } } sub progress { my($self) = @_; return unless -t STDERR; return if $self->quiet; my $progress_text; if ($self->{content_length}) { my $percent = int( ($self->{downloaded} / $self->{content_length}) * 100 ); if ($percent != $self->{percent} || time != $self->{last_time}) { my $downloaded_kib = _bytes_to_kib($self->{downloaded}); my $total_kib = _bytes_to_kib($self->{content_length}); $progress_text = ": $percent% ($downloaded_kib / $total_kib KiB)"; $self->{last_time} = time; $self->{percent} = $percent; } } else { # Handle lame servers that don't tell us how big the file is my $data_transferred = _bytes_to_kib($self->{downloaded}); if ($data_transferred != $self->{data_transferred}) { $progress_text = ": $data_transferred KiB"; } } if($progress_text) { my $width = get_terminal_width(); my $filename = $self->{printable_filename}; my $filename_len = $width - length($progress_text); if($filename_len < length $filename) { # 3 for "..." my $rem = 3 + length($filename) - $filename_len; # Try and chop off somewhere near the end, but not the very end.. my $pos = length($filename) - $rem - 12; $pos = 0 if $pos < 0; substr($filename, $pos, $rem) = "..."; } syswrite STDERR, "\r$filename$progress_text"; } } sub _bytes_to_kib { return sprintf '%0.2f', ($_[0] / 1024) } sub replace_filename { my($self, $string, $filename) = @_; $string .= " %s" unless $string =~ /%s/; my $esc = $self->shell_escape($filename); $string =~ s/['"]?%s['"]?/$esc/g; return $string; } sub shell_escape { my($self, $file) = @_; # Shell escape the given filename $file =~ s/'/'\\''/g; return "'$file'"; } sub check_file { my($self, $file) = @_; open my $fh, "<", $file; binmode $fh; my $data; read $fh, $data, 16; return $self->check_magic($data); } sub check_magic { my($self, $data) = @_; # This is a very simple check to ensure we have a media file. # The aim is to avoid downloading HTML, Flash, etc and claiming to have # succeeded. # FLV if(substr($data, 0, 3) eq 'FLV') { return 1; # MP3 } elsif(substr($data, 0, 3) eq 'ID3') { return 1; # MP3 without ID3 tags } elsif (substr($data, 0, 2) eq "\xff\xfb") { return 1; # ASF } elsif(substr($data, 0, 4) eq "\x30\x26\xb2\x75") { return 1; # ISO } elsif(substr($data, 4, 4) eq 'ftyp') { return 1; # Other QuickTime } elsif(substr($data, 4, 4) =~ /moov|mdat|wide|free|pnot|skip/) { return 1; # Ogg } elsif(substr($data, 0, 4) eq 'OggS') { return 1; # WebM } elsif(substr($data, 0x1F, 4) eq 'webm') { return 1; # AVI / WAV } elsif(substr($data, 0, 4) eq 'RIFF') { return 1; } return 0; } sub get_filename { my($self, $file) = @_; # On windows the filename needs to be in the codepage of the system.. if($^O =~ /MSWin/i) { $file = Encode::encode(get_win_codepage(), $file); # This may have added '?' as subsition characters, replace with '_' $file =~ s/\?/_/g; } return $file; } 1; get-flash-videos-1.25.98/lib/FlashVideo/Generic.pm000066400000000000000000000222711324005573400215540ustar00rootroot00000000000000# Part of get-flash-videos. See get_flash_videos for copyright. package FlashVideo::Generic; use strict; use FlashVideo::Utils; use URI; use FlashVideo::URLFinder; use URI::Escape qw(uri_unescape); use HTML::Entities qw(decode_entities); our $VERSION = '0.01'; sub Version() { $VERSION; } my $video_re = qr!http[-:/a-z0-9%_.?=&]+@{[EXTENSIONS]} # Grab any params that might be used for auth.. (?:\?[-:/a-z0-9%_.?=&]+)?!xi; sub find_video { my ($self, $browser, $embed_url, $prefs) = @_; # First strategy - identify all the Flash video files, and download the # biggest one. Yes, this is hacky. if (!$browser->success) { $browser->get($browser->response->header('Location')); die "Couldn't download URL: " . $browser->response->status_line unless $browser->success; } my ($possible_filename, $actual_url, $title); $title = extract_title($browser); my @flv_urls = map { (m{http://.+?(http://.+?@{[EXTENSIONS]})}i) ? $1 : $_ } ($browser->content =~ m{($video_re)}gi); if (@flv_urls) { require LWP::Simple; require Memoize; Memoize::memoize("LWP::Simple::head"); @flv_urls = sort { (LWP::Simple::head($a))[1] <=> (LWP::Simple::head($b))[1] } @flv_urls; $possible_filename = (split /\//, $flv_urls[-1])[-1]; # Un-escape URLs if necessary if ($flv_urls[-1] =~ /^http%3a%2f%2f/) { $flv_urls[-1] = uri_unescape($flv_urls[-1]) } $actual_url = url_exists($browser->clone, $flv_urls[-1]); } my $filename_is_reliable; if(!$actual_url) { RE: for my $regex( qr{(?si)]+)}, qr{(?si)]+)}, qr{(?si)]* href=["']?([^"'>]+?@{[EXTENSIONS]})}, qr{(?si)]*>.*?]*value=["']?([^"'>]+)}, qr{(?si)]*>(.*?)}, # Attempt to handle scripts using flashvars / swfobject qr{(?si)]*>(.*?)}) { for my $param($browser->content =~ /$regex/gi) { (my $url, $possible_filename, $filename_is_reliable) = find_file_param($browser->clone, $param, $prefs); if($url) { my $resolved_url = url_exists($browser->clone, $url); if($resolved_url) { $actual_url = $resolved_url; last RE; } } } } if(!$actual_url) { for my $iframe($browser->content =~ /]+src=["']?([^"'>]+)/gi) { $iframe = decode_entities($iframe); $iframe = URI->new_abs($iframe, $browser->uri); $iframe = decode_entities($iframe); debug "Found iframe: $iframe"; my $sub_browser = $browser->clone; $sub_browser->get($iframe); # Recurse! my($package, $possible_url) = FlashVideo::URLFinder->find_package($iframe, $sub_browser); # Before fetching the url, give the package a chance if($package->can("pre_find")) { $package->pre_find($sub_browser); } info "Downloading $iframe"; $sub_browser->get($iframe); my($actual_url, @suggested_fnames) = eval { $package->find_video($sub_browser, $possible_url, $prefs); }; return $actual_url, @suggested_fnames if $actual_url; } } } my @filenames; return $actual_url, $possible_filename if $filename_is_reliable; $possible_filename =~ s/\?.*//; # The actual filename, provided it looks like it might be reasonable # (not just numbers).. push @filenames, $possible_filename if $possible_filename && $possible_filename !~ /^[0-9_.]+@{[EXTENSIONS]}$/; # The title of the page, if it isn't similar to the filename.. my $ext = substr(($actual_url =~ /(@{[EXTENSIONS]})$/)[0], 1); push @filenames, title_to_filename($title, $ext) if $title && $title !~ /\Q$possible_filename\E/i; # A title with just the timestamp in it.. push @filenames, get_video_filename() if !@filenames; return $actual_url, @filenames if $actual_url; # As a last ditch attempt, download the SWF file as in some cases, sites # use an SWF movie file for each FLV. # Get SWF URL(s) my %swf_urls; if (eval { require URI::Find }) { my $finder = URI::Find->new( sub { $swf_urls{$_[1]}++ if $_[1] =~ /\.swf$/i } ); $finder->find(\$browser->content); } else { # Extract URLs in a frail way. my $content = $browser->content; while($content =~ m{(http://[^ "']+?\.swf)}ig) { $swf_urls{$1}++; } } if (%swf_urls) { foreach my $swf_url (keys %swf_urls) { if (my ($flv_url, $title) = search_for_flv_in_swf($browser, $swf_url)) { return $flv_url, title_to_filename($title); } } } die "No URLs found"; } sub search_for_flv_in_swf { my ($browser, $swf_url) = @_; $browser = $browser->clone(); $browser->get($swf_url); if (!$browser->success) { die "Couldn't download SWF URL $swf_url: " . $browser->response->status_line(); } # SWF data might be compressed. my $swf_data = $browser->content; if ('C' eq substr $swf_data, 0, 1) { if (eval { require Compress::Zlib }) { $swf_data = Compress::Zlib::uncompress(substr $swf_data, 8); } else { die "Compress::Zlib is required to uncompress compressed SWF files.\n"; } } if ($swf_data =~ m{(http://.{10,300}?\.flv)}i) { my $flv_url = $1; my $filename = uri_unescape(File::Basename::basename(URI->new($flv_url)->path())); $filename =~ s/\.flv$//i; return ($flv_url, $filename); } return; } sub find_file_param { my($browser, $param, $prefs) = @_; for my $file($param =~ /(?:video|movie|file|path)_?(?:href|src|url)?['"]?\s*[=:,]\s*['"]?([^&'" ]+)/gi, $param =~ /(?:config|playlist|options)['"]?\s*[,:=]\s*['"]?(http[^'"&]+)/gi, $param =~ /['"=](.*?@{[EXTENSIONS]})/gi, $param =~ /([^ ]+@{[EXTENSIONS]})/gi, $param =~ /SWFObject\(["']([^"']+)/) { debug "Found $file"; my ($actual_url, $filename, $filename_is_reliable) = guess_file($browser, $file, '', $prefs); if(!$actual_url && $file =~ /\?(.*)/) { # Maybe we have query params? debug "Trying query param on $1"; for my $query_param(split /[;&]/, $1) { my($query_key, $query_value) = split /=/, $query_param; debug "Found $query_value from $query_key"; ($actual_url, $filename, $filename_is_reliable) = guess_file($browser, $query_value, '', $prefs); last if $actual_url; } } if($actual_url) { my $possible_filename = $filename || (split /\//, $actual_url)[-1]; return $actual_url, $possible_filename, $filename_is_reliable; } } if($param =~ m{(rtmp://[^ &"']+)}) { info "This looks like RTMP ($1), no generic support yet.."; } return; } sub guess_file { my($browser, $file, $once, $prefs) = @_; # Contains lots of URI encoding, so try escaping.. $file = uri_unescape($file) if scalar(() = $file =~ /%[A-F0-9]{2}/gi) > 3; my $orig_uri = URI->new_abs($file, $browser->uri); info "Guessed $orig_uri trying..."; if($orig_uri) { my $uri = url_exists($browser->clone, $orig_uri); if($uri) { # Check to see if this URL is for a supported site. my ($package, $url) = FlashVideo::URLFinder->find_package($uri, $browser->clone); if($package && $package ne __PACKAGE__) { debug "$uri is supported by $package."; (my $browser_on_supported_site = $browser->clone())->get($uri); return $package->find_video($browser_on_supported_site, $uri, $prefs), 1; } my $content_type = $browser->response->header("Content-type"); if($content_type =~ m!^(text|application/xml)!) { # Just in case someone serves the video itself as text/plain. $browser->add_header("Range", "bytes=0-10000"); $browser->get($uri); $browser->delete_header("Range"); if(FlashVideo::Downloader->check_magic($browser->content) || $uri =~ m!$video_re!) { # It's a video.. debug "Found a video at $uri"; return $uri; } # If this looks like HTML we have no hope of guessing right, so # give up now. return if $browser->content =~ /]*>/i; if($browser->content =~ m!($video_re)!) { # Found a video URL return $1; } elsif(!defined $once && $browser->content =~ m!(http[-:/a-zA-Z0-9%_.?=&]+)!i) { # Try once more, one level deeper.. return guess_file($browser, $1, 1, $prefs); } else { info "Tried $uri, but no video URL found"; } } elsif($content_type =~ m!application/! && $uri ne $orig_uri) { # We were redirected, maybe something in the new URL? return((find_file_param($browser, $uri))[0]); } else { return $uri->as_string; } } elsif(not defined $once) { # Try using the location of the .swf file as the base, if it's different. if($browser->content =~ /["']([^ ]+\.swf)/) { my $swf_uri = URI->new_abs($1, $browser->uri); if($swf_uri) { my $new_uri = URI->new_abs($file, $swf_uri); debug "Found SWF: $swf_uri -> $new_uri"; if($new_uri ne $uri) { return guess_file($browser, $new_uri, 1, $prefs); } } } } } return; } 1; get-flash-videos-1.25.98/lib/FlashVideo/HLSDownloader.pm000066400000000000000000000071631324005573400226500ustar00rootroot00000000000000# Part of get-flash-videos. See get_flash_videos for copyright. package FlashVideo::HLSDownloader; use strict; use warnings; use base 'FlashVideo::Downloader'; use FlashVideo::Utils; use FlashVideo::JSON; use Term::ProgressBar; my $bitrate_index = { high => 0, medium => 1, low => 2 }; sub cleanup_audio { my ($in_file, $out_file) = @_; my @args = {}; # Look for executable (ffmpeg or avconv) if (!is_program_on_path("ffmpeg")) { if (!is_program_on_path("avconv")) { die "Could not find ffmpeg nor avconv executable!"; } else { @args = ( "avconv", "-i", $in_file, "-bsf:a", "aac_adtstoasc", "-c", "copy", "-f", "mp4", $out_file ); } } else { @args = ( "ffmpeg", "-i", $in_file, "-absf", "aac_adtstoasc", "-c", "copy", "-f", "mp4", $out_file ); } # Execute command if (system(@args) != 0) { die "Calling @args failed: $?"; } return 1; } sub read_hls_playlist { my($browser, $url) = @_; $browser->get($url); if (!$browser->success) { die "Couldn't download m3u file, $url: " . $browser->response->status_line; } my @lines = split(/\r?\n/, $browser->content); my %urltable = (); my $i = 0; # Fill the url table foreach my $line (@lines) { if ($line =~ /EXT-X-STREAM-INF/ && $line =~ /BANDWIDTH/) { $line =~ /BANDWIDTH=([0-9]*)/; $urltable{int($1)} = $lines[$i + 1]; } $i++; } return %urltable; } sub download { my ($self, $args, $file, $browser) = @_; my $hls_url = $args->{args}->{hls_url}; my $prefs = $args->{args}->{prefs}; $browser->get($hls_url); my %urls = read_hls_playlist($browser, $hls_url); # Sort the urls and select the suitable one based upon quality preference my $quality = $bitrate_index->{$prefs->{quality}}; my $min = $quality < scalar(keys(%urls)) ? $quality : scalar(keys(%urls)); my $key = (sort {int($b) <=> int($a)} keys %urls)[$min]; my ($hls_base, $trail) = ($hls_url =~ m/(.*\/)(.*)\.m3u8/); my $filename_mp4 = $args->{flv}; my $filename_ts = $args->{flv} . ".ts"; my $filename_ts_segment = $args->{flv} . ".tsx"; my $video_url = $urls{$key} =~ m/http(s?):\/\// ? $urls{$key} : $hls_base.$urls{$key}; $browser->get($video_url); if (! $browser->success) { die "Unable to read segments" . $browser->response->status_line; } my @lines = split(/\r?\n/, $browser->content); my @segments = (); # Fill the url table foreach my $line (@lines) { if ($line !~ /#/) { push @segments, $line; } } my $i = 1; my $num_segs = @segments; info "Downloading segments"; my $progress_bar = Term::ProgressBar->new($num_segs); open(my $fh_app, '>', $filename_ts) or die "Could not open file $filename_ts"; binmode($fh_app); my $buffer; foreach my $url (@segments) { # Download and save each segment in a re-used segment file. # Otherwise, the process memory expands monotonically. Large downloads would use up # all memory and kill the process. $browser->get($url, ":content_file" => $filename_ts_segment); # Open the segment and append it to the TS file. open(SEG, '<', $filename_ts_segment) or die "Could not open file $filename_ts_segment"; binmode(SEG); while (read(SEG, $buffer, 16384)) { print $fh_app $buffer; } close(SEG); $progress_bar->update($i); $i++; } # Remove the segment file as it is no longer needed. unlink $filename_ts_segment; close($fh_app); cleanup_audio($filename_ts, $filename_mp4); $self->{printable_filename} = $filename_mp4; unlink $filename_ts; return -s $filename_mp4; } 1; get-flash-videos-1.25.98/lib/FlashVideo/HLSXDownloader.pm000066400000000000000000000204701324005573400227740ustar00rootroot00000000000000# Part of get-flash-videos. See get_flash_videos for copyright. package FlashVideo::HLSXDownloader; use strict; use warnings; use base 'FlashVideo::Downloader'; use FlashVideo::Utils; use FlashVideo::JSON; use FlashVideo::Mechanize; use Term::ProgressBar; use Crypt::Rijndael; my $bitrate_index = { high => 0, medium => 1, low => 2 }; sub cleanup_audio { my ($in_file, $out_file) = @_; my @args = {}; # Look for executable (ffmpeg or avconv) if (!is_program_on_path("ffmpeg")) { if (!is_program_on_path("avconv")) { die "Could not find ffmpeg nor avconv executable!"; } else { @args = ( "avconv", "-i", $in_file, "-bsf:a", "aac_adtstoasc", "-c", "copy", "-f", "mp4", $out_file ); } } else { @args = ( "ffmpeg", "-i", $in_file, "-absf", "aac_adtstoasc", "-c", "copy", "-f", "mp4", $out_file ); } # Execute command if (system(@args) != 0) { die "Calling @args failed: $?"; } return 1; } sub m3u8_attributes { my $a = shift; my $info = shift; while ($a =~ m/([A-Z0-9-]+)=(\"[^\"]+\"|[^\",]+)(?:,|$)/g) { my $key = $1; my $val = $2; $val =~ s/^\"(.*)\"$/$1/; $info->{$key} = $val; } } sub read_hls_playlist { my($browser, $url) = @_; $browser->get($url); if (!$browser->success) { die "Couldn't download m3u file, $url: " . $browser->response->status_line; } debug $browser->content; debug $browser->cookie_jar->as_string(); my @lines = split(/\r?\n/, $browser->content); my %urltable = (); my $i = 0; # Fill the url table foreach my $line (@lines) { if ($line =~ /EXT-X-STREAM-INF/ && $line =~ /BANDWIDTH/) { $line =~ /BANDWIDTH=([0-9]*)/; $urltable{int($1)} = { url => $lines[$i + 1], inf => $line}; } $i++; } return %urltable; } sub download { my ($self, $args, $file, $browser) = @_; my $hls_url = $args->{args}->{hls_url}; my $prefs = $args->{args}->{prefs}; $browser->cookie_jar( {} ); $browser->add_header( Referer => undef); $browser->get($hls_url); my %urls = read_hls_playlist($browser, $hls_url); # Sort the urls and select the suitable one based upon quality preference my @bandwidths = sort {int($a) <=> int($b)} keys %urls; my $cnt = $#bandwidths; my $key = $prefs->{quality}; $key //= 'high'; if ($key =~ /^\s*\d+\s*$/) { my $bandwidth = $bandwidths[0]; foreach (@bandwidths) { if ($key >= $_/1000.00) { $bandwidth = $_; } } $key = $bandwidth; } else { my $num = {high => int($cnt), medium => int(($cnt+1)/2), low => 0}->{$key}; $num //= int($cnt); $key = $bandwidths[$num]; } my ($hls_base, $trail) = ($hls_url =~ m/(.*\/)(.*)\.m3u8/); my $filename_mp4 = $args->{flv}; my $filename_ts = $args->{flv} . ".ts"; my $filename_ts_segment = $args->{flv} . ".tsx"; debug "Select URL ".$urls{$key}->{url}; debug "STREAM INF ".$urls{$key}->{inf}; my $video_url = $urls{$key}->{url} =~ m/http(s?):\/\// ? $urls{$key}->{url} : $hls_base.$urls{$key}->{url}; $browser->add_header( Referer => undef); $browser->get($video_url); if (! $browser->success) { die "Unable to read segments" . $browser->response->status_line; } my @lines = split(/\r?\n/, $browser->content); my @segments = (); # Fill the url table my $hls_key; my $decrypt; foreach my $line (@lines) { if ($line !~ /#/) { # push non-blank lines push @segments, $line if $line !~ /^\s*$/; } } my $i = 1; my $num_segs = @segments; info "Downloading $num_segs segments"; my $progress_bar = Term::ProgressBar->new($num_segs); open(my $fh_app, '>', $filename_ts) or die "Could not open file $filename_ts"; binmode($fh_app); my $buffer; my $media_sequence = 0; my %decrypt_info = ( 'METHOD', 'NONE'); my %byte_range = (); my $segment_index = 0; foreach my $line (@lines) { # skip empty lines if ($line !~ /^\s*$/) { if ( $line !~ /#/) { # segment line $segment_index += 1; # to do skip if restarted # and havent reaach last segment added yet. my $url = $line; if ($line !~ m%https?://%) { # to do add manifest url to front to form url $url = $hls_base.$line; } if (%byte_range) { $browser->add_header('Range' => 'bytes='.$byte_range{'start'}.'-'. $byte_range{'end'}); } else { $browser->delete_header('Range'); } # Download and save each segment in a re-used segment file. # Otherwise, the process memory expands monotonically. Large downloads would use up # all memory and kill the process. $browser->get($url, ":content_file" => $filename_ts_segment); if (! $browser->success()) { die "filed to download segment - aborting"; } # Open the segment and append it to the TS file. open(SEG, '<', $filename_ts_segment) or die "Could not open file $filename_ts_segment"; binmode(SEG); my $crypt; if ($decrypt_info{'METHOD'} eq 'AES-128') { my $iv; if (defined $decrypt_info{'IV'}) { $iv =$decrypt_info{'IV'} } else { # must be packed correctly may need changing # if no 64bit support in perl. $iv = pack('x8q>', $media_sequence); } if (! defined $decrypt_info{'KEY'}) { if (defined $decrypt_info{'URI'}) { $browser->get($decrypt_info{'URI'}); my $hls_key = $browser->content; # pad key if needed. my $len = length($hls_key); if ($len < 16) { $hls_key = "\0" x (16 - $len) . $hls_key; } $decrypt_info{'KEY'} = $hls_key; } } $crypt = Crypt::Rijndael->new($decrypt_info{'KEY'}, Crypt::Rijndael::MODE_CBC() ); $crypt->set_iv($iv); my $size = ( stat SEG)[7]; # 16384 previously had issue with decrypt # decrypt whole segment in one go while (read(SEG, $buffer, $size)) { print $fh_app $crypt->decrypt($buffer); } } else { while (read(SEG, $buffer, 16384)) { print $fh_app $buffer; } } close(SEG); $progress_bar->update($i); $i++; $media_sequence++; } else { # line begins with # if ($line =~ /#EXT-X-KEY:/) { my %m3u8_info; m3u8_attributes($line, \%m3u8_info); $decrypt_info{'METHOD'} = $m3u8_info{'METHOD'}; $decrypt_info{'KEY'} = $m3u8_info{'KEY'}; $decrypt_info{'IV'} = $m3u8_info{'IV'}; $decrypt_info{'URI'} = $m3u8_info{'URI'}; # info "Method ".$decrypt_info{'METHOD'} if defined $decrypt_info{'METHOD'}; # info "Key ".$decrypt_info{'KEY'} if defined $decrypt_info{'KEY'}; # info "IV ".$decrypt_info{'IV'} if defined $decrypt_info{'IV'}; # info "URI ".$decrypt_info{'URI'} if defined $decrypt_info{'URI'}; } elsif ($line =~ /#EXT-X-MEDIA-SEQUENCE/) { my $cmd; ($cmd, $media_sequence) = split(/:/, $line); debug "Media sequence = $media_sequence"; } elsif ($line =~ /#EXT-X-BYTERANGE/) { my ($cmd, $range) = split(/:/, $line); if ($range =~ /@/) { my ($seg_len, $start) = split(/@/, $range); $byte_range{'start'} = $start; $byte_range{'end'} = $start + $seg_len; } else { $byte_range{'start'} = $byte_range{'end'}; $byte_range{'end'} += $range; } # info "Byte Range : ".$byte_range{'start'}." to ".$byte_range{'end'}; } elsif ($line =~ /#EXTINF/) { my ($cmd, $dt) = split(/:/, $line); my ($dur, $stitle) = split(/,/, $dt); # info "Seg duration $dur title $stitle"; } else { # info "Ignored line : $line"; } } } } # Remove the segment file as it is no longer needed. unlink $filename_ts_segment; close($fh_app); if ($prefs->{raw}) { $self->{printable_filename} = $filename_ts; return -s $filename_ts; } else { cleanup_audio($filename_ts, $filename_mp4); $self->{printable_filename} = $filename_mp4; unlink $filename_ts; return -s $filename_mp4; } } 1; get-flash-videos-1.25.98/lib/FlashVideo/JSON.pm000066400000000000000000000034501324005573400207470ustar00rootroot00000000000000package FlashVideo::JSON; # Very simple JSON parser, loosely based on # http://code.google.com/p/json-sans-eval # Public domain. use strict; use base 'Exporter'; our @EXPORT = qw(from_json); my $number = qr{(?:-?\b(?:0|[1-9][0-9]*)(?:\.[0-9]+)?(?:[eE][+-]?[0-9]+)?\b)}; my $oneChar = qr{(?:[^\0-\x08\x0a-\x1f\"\\]|\\(?:["/\\bfnrt]|u[0-9A-Fa-f]{4}))}; my $string = qr{(?:"$oneChar*")}; my $jsonToken = qr{(?:false|true|null|[\{\}\[\]]|$number|$string)}; my $escapeSequence = qr{\\(?:([^u])|u(.{4}))}; my %escapes = ( '\\' => '\\', '"' => '"', '/' => '/', 'b' => "\b", 'f' => "\f", 'n' => "\xA", 'r' => "\xD", 't' => "\t" ); sub from_json { my($in) = @_; my @tokens = $in =~ /$jsonToken/go; my $result = $tokens[0] eq '{' ? {} : []; # Handle something other than array/object at toplevel shift @tokens if $tokens[0] =~ /^[\[\{]/; my $key; # key to use for next value my @stack = $result; for my $t(@tokens) { my $ft = substr $t, 0, 1; my $cont = $stack[0]; if($ft eq '"') { my $s = substr $t, 1, length($t) - 2; $s =~ s/$escapeSequence/$1 ? $escapes{$1} : chr hex $2/geo; if(!defined $key) { if(ref $cont eq 'ARRAY') { $cont->[@$cont] = $s; } else { $key = $s; next; # need to save $key } } else { $cont->{$key} = $s; } } elsif($ft eq '[' || $ft eq '{') { unshift @stack, (ref $cont eq 'ARRAY' ? $cont->[@$cont] : $cont->{$key}) = $ft eq '[' ? [] : {}; } elsif($ft eq ']' || $ft eq '}') { shift @stack; } else { (ref $cont eq 'ARRAY' ? $cont->[@$cont] : $cont->{$key}) = $ft eq 'f' ? 0 # false : $ft eq 'n' ? undef # null : $ft eq 't' ? 1 # true : $t; # sign or digit } undef $key; } return $result; } 1; get-flash-videos-1.25.98/lib/FlashVideo/Mechanize.pm000066400000000000000000000070521324005573400221030ustar00rootroot00000000000000# Part of get-flash-videos. See get_flash_videos for copyright. package FlashVideo::Mechanize; use WWW::Mechanize; use LWP::Protocol::https; use FlashVideo::Downloader; use Encode (); use strict; use base "WWW::Mechanize"; sub new { my $class = shift; my $browser = $class->SUPER::new(autocheck => 0); $browser->agent_alias("Windows Mozilla"); my $proxy = $App::get_flash_videos::opt{proxy}; if ($proxy) { if ($proxy =~ m%^(\w+://)?([.\w-]+)(:\d+)?$%) { # Proxy is in format: # localhost:1337 # localhost # [socks|http|...]://localhost:8080 # Add a scheme so LWP can use it. # Other formats are passed to LWP directly. my ($scheme, $host, $port) = ($1, $2, $3); $scheme ||= "socks://"; my $sndport = ":8080"; $sndport = ":1080" if ($scheme =~ /socks/); $port ||= $sndport; # socks by default $proxy = $scheme.$host.$port; } print STDERR "Using proxy server $proxy\n" if $App::get_flash_videos::opt{debug}; $browser->proxy([qw[http https]] => $proxy); } if($browser->get_socks_proxy) { if(!eval { require LWP::Protocol::socks }) { die "LWP::Protocol::socks is required for SOCKS support, please install it\n"; } } return $browser; } sub redirect_ok { my($self) = @_; return $self->{redirects_ok}; } sub allow_redirects { my($self) = @_; $self->{redirects_ok} = 1; } sub prohibit_redirects { my($self) = @_; $self->{redirects_ok} = 0; } sub get { my($self, @rest) = @_; print STDERR "-> GET $rest[0]\n" if $App::get_flash_videos::opt{debug}; my $r = $self->SUPER::get(@rest); if($App::get_flash_videos::opt{debug}) { my $text = join " ", $self->response->code, $self->response->header("Content-type"), $self->response->header("Content-length"), "(" . length($self->content) . ")"; $text .= ": " . DBI::data_string_desc($self->content) if eval { require DBI }; print STDERR "<- $text\n"; } print STDERR $self->response->header("X-Died")."\n" if(defined $self->response->header("X-Died") && ! $App::get_flash_videos::opt{quiet} ); return $r; } sub update_html { my($self, $html) = @_; my $charset = _parse_charset($self->response->header("Content-type")); # If we have no character set in the header (therefore it is worth looking # for a http-equiv in the body) or the content hasn't been decoded (older # versions of Mech). if($LWP::UserAgent::VERSION < 5.827 && (!$charset || !Encode::is_utf8($html))) { # HTTP::Message helpfully decodes to iso-8859-1 by default. Therefore we # do the inverse. This is fucking frail and will probably break. $html = Encode::encode("iso-8859-1", $html) if Encode::is_utf8($html); # Check this doesn't look like a video.. if(!FlashVideo::Downloader->check_magic($html)) { my $p = HTML::TokeParser->new(\$html); while(my $token = $p->get_tag("meta")) { my($tag, $attr) = @$token; if($tag eq 'meta' && $attr->{"http-equiv"} =~ /Content-type/i) { $charset ||= _parse_charset($attr->{content}); } } if($charset) { eval { $html = Encode::decode($charset, $html) }; FlashVideo::Utils::error("Failed decoding as $charset: $@") if $@; } } } return $self->SUPER::update_html($html); } sub _parse_charset { my($field) = @_; return(($field =~ /;\s*charset=([-_.:a-z0-9]+)/i)[0]); } sub get_socks_proxy { my $self = shift; my $proxy = $self->proxy("http"); if(defined $proxy && $proxy =~ m!^socks://(.*?):(\d+)!) { return "$1:$2"; } return ""; } 1; get-flash-videos-1.25.98/lib/FlashVideo/RTMPDownloader.pm000066400000000000000000000155661324005573400230120ustar00rootroot00000000000000# Part of get-flash-videos. See get_flash_videos for copyright. package FlashVideo::RTMPDownloader; use strict; use base 'FlashVideo::Downloader'; use IPC::Open3; use Fcntl (); use Symbol qw(gensym); use File::Temp qw(tempfile tempdir); use Storable qw(dclone); use FlashVideo::Utils; use constant LATEST_RTMPDUMP => 2.2; sub download { my ($self, $rtmp_data, $file) = @_; $self->{printable_filename} = $file; $file = $rtmp_data->{flv} = $self->get_filename($file); if (-s $file && !$rtmp_data->{live}) { info "RTMP output filename '$self->{printable_filename}' already " . "exists, asking to resume..."; $rtmp_data->{resume} = ''; } if(my $socks = FlashVideo::Mechanize->new->get_socks_proxy) { $rtmp_data->{socks} = $socks; } my($r_fh, $w_fh); # So Perl doesn't close them behind our back.. if ($rtmp_data->{live} && $self->action eq 'play') { # Playing live stream, we pipe this straight to the player, rather than # saving on disk. # XXX: The use of /dev/fd could go away now rtmpdump supports streaming to # STDOUT. pipe($r_fh, $w_fh); my $pid = fork; die "Fork failed" unless defined $pid; if(!$pid) { fcntl $r_fh, Fcntl::F_SETFD(), ~Fcntl::FD_CLOEXEC(); exec $self->replace_filename($self->player, "/dev/fd/" . fileno $r_fh); die "Exec failed\n"; } fcntl $w_fh, Fcntl::F_SETFD(), ~Fcntl::FD_CLOEXEC(); $rtmp_data->{flv} = "/dev/fd/" . fileno $w_fh; $self->{stream} = undef; } my $prog = $self->get_rtmp_program; if($prog eq 'flvstreamer' && ($rtmp_data->{rtmp} =~ /^rtmpe:/ || $rtmp_data->{swfhash})) { error "FLVStreamer does not support " . ($rtmp_data->{swfhash} ? "SWF hashing" : "RTMPE streams") . ", please install rtmpdump."; exit 1; } if($self->debug) { $rtmp_data->{verbose} = undef; } my($return, @errors) = $self->run($prog, $rtmp_data); if($return != 0 && "@errors" =~ /failed to connect/i) { # Try port 443 as an alternative info "Couldn't connect on RTMP port, trying port 443 instead"; $rtmp_data->{port} = 443; ($return, @errors) = $self->run($prog, $rtmp_data); } if($file ne '-' && (-s $file < 100 || !$self->check_file($file))) { # This avoids trying to resume an invalid file error "Download failed, no valid file downloaded"; unlink $rtmp_data->{flv}; return 0; } if($return == 2) { info "\nDownload incomplete -- try running again to resume."; return 0; } elsif($return) { info "\nDownload failed."; return 0; } return -s $file; } # Check if a stream is active by downloading a sample sub try_download { my ($self, $rtmp_data_orig) = @_; my $rtmp_data = dclone($rtmp_data_orig); # Create a temporary file for the test my ($fh, $filename) = tempfile(); $rtmp_data->{flv} = $filename; # Just download a second of video $rtmp_data->{stop} = "1"; if(my $socks = FlashVideo::Mechanize->new->get_socks_proxy) { $rtmp_data->{socks} = $socks; } my $prog = $self->get_rtmp_program; if($prog eq 'flvstreamer' && ($rtmp_data->{rtmp} =~ /^rtmpe:/ || $rtmp_data->{swfhash})) { error "FLVStreamer does not support " . ($rtmp_data->{swfhash} ? "SWF hashing" : "RTMPE streams") . ", please install rtmpdump."; exit 1; } if($self->debug) { $rtmp_data->{verbose} = undef; } my($return, @errors) = $self->run($prog, $rtmp_data); if($return != 0 && "@errors" =~ /failed to connect/i) { # Try port 443 as an alternative info "Couldn't connect on RTMP port, trying port 443 instead"; $rtmp_data->{port} = 443; ($return, @errors) = $self->run($prog, $rtmp_data); } # If we got an unrecoverable error return false if($return == 1) { info "\n Tested stream failed."; return 0; } return 1; } sub get_rtmp_program { if(is_program_on_path("rtmpdump")) { return "rtmpdump"; } elsif(is_program_on_path("flvstreamer")) { return "flvstreamer"; } # Default to rtmpdump return "rtmpdump"; } sub get_command { my($self, $rtmp_data, $debug) = @_; return map { my $arg = $_; (ref $rtmp_data->{$arg} eq 'ARRAY' # Arrayref means multiple options of the same type ? (map { ("--$arg" => $debug ? $self->shell_escape($_) : $_) } @{$rtmp_data->{$arg}}) # Single argument : ("--$arg" => (($debug && $rtmp_data->{$arg}) ? $self->shell_escape($rtmp_data->{$arg}) : $rtmp_data->{$arg}) || ())) } keys %$rtmp_data; } sub run { my($self, $prog, $rtmp_data) = @_; debug "Running $prog", join(" ", $self->get_command($rtmp_data, 1)); my($in, $out, $err); $err = gensym; my $pid = open3($in, $out, $err, $prog, $self->get_command($rtmp_data)); # Windows doesn't send signals to child processes, so we need to do it # manually to ensure that we don't have stray rtmpdump processes. local $SIG{INT}; if ($^O =~ /mswin/i) { $SIG{INT} = sub { kill 'TERM', $pid; exit; }; } my $complete = 0; my $buf = ""; my @error; while(sysread($err, $buf, 128, length $buf) > 0) { $buf =~ s/\015\012/\012/g; my @parts = split /\015/, $buf; $buf = ""; for(@parts) { # Hide almost everything from rtmpdump, it's less confusing this way. if(/^((?:DEBUG:|WARNING:|Closing connection|ERROR: No playpath found).*)\n/) { debug "$prog: $1"; } elsif(/^(ERROR: .*)\012/) { push @error, $1; info "$prog: $1"; } elsif(/^([0-9.]+) kB(?:\s+\/ \S+ sec)?(?: \(([0-9.]+)%\))?/i) { $self->{downloaded} = $1 * 1024; my $percent = $2; if($self->{downloaded} && $percent != 0) { # An approximation, but should be reasonable if we don't have the size. $self->{content_length} = $self->{downloaded} / ($percent / 100); } $self->progress; } elsif(/\012$/) { for my $l(split /\012/) { if($l =~ /^[A-F0-9]{0,2}(?:\s+[A-F0-9]{2})*\s*$/) { debug $l; } elsif($l =~ /Download complete/) { $complete = 1; } elsif($l =~ /\s+filesize\s+(\d+)/) { $self->{content_length} = $1; } elsif($l =~ /\w/) { print STDERR "\r" if $self->{downloaded}; info $l; if($l =~ /^RTMPDump v([0-9.]+)/ && $1 < LATEST_RTMPDUMP) { error "==== Using the latest version of RTMPDump (version " . LATEST_RTMPDUMP . ") is recommended. ===="; } } } if(/open3/) { error "\nMake sure you have 'rtmpdump' or 'flvstreamer' installed and available on your PATH."; return 0; } } else { # Hack; assume lack of newline means it was an incomplete read.. $buf = $_; } } # Should be about enough.. if(defined $self->{stream} && $self->{downloaded} > 300_000) { $self->{stream}->(); } } waitpid $pid, 0; return $? >> 8, @error; } 1; get-flash-videos-1.25.98/lib/FlashVideo/Search.pm000066400000000000000000000051301324005573400214000ustar00rootroot00000000000000# Part of get-flash-videos. See get_flash_videos for copyright. package FlashVideo::Search; use strict; use Carp; use FlashVideo::Utils; # Sites which support searching my @sites_with_search = ('4oD', 'GoogleVideoSearch'); sub search { my ($class, $search, $max_per_site, $max_results) = @_; # Preload search sites my @search_sites = map { FlashVideo::URLFinder::_load($_) } @sites_with_search; # If a user searches for "foo something", check to see if "foo" is a site # we support. If it is, only search that site. if ($search =~ /^(\w+) \w+/) { my $possible_site = ucfirst lc $1; debug "Checking to see if '$possible_site' in '$search' is a search-supported site."; my $possible_package = FlashVideo::URLFinder::_load($possible_site); if ($possible_package->can("search")) { # Only search this site debug "Search for '$search' will only search $possible_site."; # Remove the site name from the search string $search =~ s/^\w+ //; return search_site($possible_package, $search, "site", $max_results); } } # Check to see if any plugins have a search function defined. my @plugins = App::get_flash_videos::get_installed_plugins(); foreach my $plugin (@plugins) { $plugin =~ s/\.pm$//; my $plugin_package = FlashVideo::URLFinder::_load($plugin); if ($plugin_package->can("search")) { debug "Plugin '$plugin' has a search method."; unshift @search_sites, $plugin_package; } else { debug "Plugin '$plugin' doesn't have a search method."; } } # Call each site's search method - this includes plugins and sites # defined in @sites_with_search. my @results = map { search_site($_, $search, "all", $max_per_site) } @search_sites; # Return all results, trimming if necessary. trim_resultset(\@results, $max_results); return @results; } sub search_site { my($search_site, $search, $type, $max) = @_; debug "Searching '$search_site' for '$search'."; if (my @site_results = eval { $search_site->search($search, $type) }) { debug "Found " . @site_results . " results for $search."; trim_resultset(\@site_results, $max); return @site_results; } elsif($@) { info "Searching '$search_site' failed with: $@"; } else { debug "No results found for '$search'."; } return (); } sub trim_resultset { my ($results, $max) = @_; croak "Must be supplied a reference to resultset" unless ref($results) eq 'ARRAY'; croak "No max supplied" unless $max; if (@$results > $max) { debug "Found " . @$results . " results, trimming to $max."; splice @$results, $max; } } 1; get-flash-videos-1.25.98/lib/FlashVideo/Site.pm000066400000000000000000000010251324005573400210760ustar00rootroot00000000000000# Part of get-flash-videos. See get_flash_videos for copyright. package FlashVideo::Site; use strict; # Various accessors to avoid plugins needing to know about the exact command # line options. This will improve at some point (i.e. more OO) sub debug { $App::get_flash_videos::opt{debug}; } sub action { $App::get_flash_videos::opt{play} ? "play" : "download"; } sub player { $App::get_flash_videos::opt{player}; } sub yes { $App::get_flash_videos::opt{yes}; } sub quiet { $App::get_flash_videos::opt{quiet}; } 1; get-flash-videos-1.25.98/lib/FlashVideo/Site/000077500000000000000000000000001324005573400205425ustar00rootroot00000000000000get-flash-videos-1.25.98/lib/FlashVideo/Site/4od.pm000066400000000000000000000041521324005573400215700ustar00rootroot00000000000000# Part of get-flash-videos. See get_flash_videos for copyright. package FlashVideo::Site::4od; # Search support for 4oD (Channel 4 On Demand) on YouTube. # Downloading is handled by FlashVideo::Site::Youtube. use strict; use FlashVideo::Utils; use URI::Escape; sub search { my ($self, $search, $type) = @_; unless(eval { from_xml("") }) { if($type eq 'site') { die $@; } else { debug $@; return; } } # Use GData API to search # Note that 50 is the maximum value for max-results. my $gdata_template_url = "http://gdata.youtube.com/feeds/api/videos?q=%s&orderby=published&start-index=1&max-results=50&v=2"; my $search_url = sprintf $gdata_template_url, uri_escape($search); my $browser = FlashVideo::Mechanize->new(); $browser->get($search_url); if (!$browser->success) { die "Couldn't get YouTube search Atom XML: " . $browser->response->status_line(); } # XML::Simple keys on 'id' and some other things by default which is # annoying. my $xml = from_xml($browser, KeyAttr => [], ForceArray => ['entry']); # Only care about actual 4od videos, where the author starts with '4od'. # (Channel 4 uses multiple authors or usernames depending on the type of # the video, for example 4oDDrama, 4oDFood and so on.) # Can't use the "author" search because specifying multiple authors # (comma separated) does not work, contrary to the GData documentation. my @matches = map { _process_4od_result($_) } grep { $_->{author}->{name} =~ /^4oD\w+$/i } @{ $xml->{entry} }; return @matches; } sub _process_4od_result { my $feed_entry = shift; my $url = $feed_entry->{'media:group'}->{'media:player'}->{url}; $url =~ s/&feature=youtube_gdata//; my $published_date = $feed_entry->{published}; $published_date =~ s/T.*$//; # only care about date, not time my $title = $feed_entry->{'media:group'}->{'media:title'}->{content}; my $description = $feed_entry->{'media:group'}->{'media:description'}->{content}; my $result_name = "$title ($published_date)"; return { name => $result_name, url => $url, description => $description }; } 1; get-flash-videos-1.25.98/lib/FlashVideo/Site/5min.pm000066400000000000000000000006651324005573400217570ustar00rootroot00000000000000# Part of get-flash-videos. See get_flash_videos for copyright. package FlashVideo::Site::5min; use strict; use FlashVideo::Utils; sub find_video { my ($self, $browser) = @_; my $filename = title_to_filename(extract_info($browser)->{meta_title}); # They now pass the URL as a param, so the generic code can extract it. my $url = (FlashVideo::Generic->find_video($browser, $browser->uri))[0]; return $url, $filename; } 1; get-flash-videos-1.25.98/lib/FlashVideo/Site/Abc.pm000066400000000000000000000057271324005573400216000ustar00rootroot00000000000000# Part of get-flash-videos. See get_flash_videos for copyright. package FlashVideo::Site::Abc; use strict; use FlashVideo::Utils; sub find_video { my ($self, $browser, $embed_url) = @_; # Clips are handled differently to full episodes if ($browser->uri->as_string =~ m'/watch/clip/[\w\-]+/(\w+)/(\w+)/(\w+)') { my $show_id = $1; my $playlist_id = $2; my $video_id = $3; return handle_abc_clip($browser, $show_id, $playlist_id, $video_id); } my $playpath; if ($browser->content =~ /http:\/\/cdn\.video\.abc\.com\/abcvideo\/video_fep\/thumbnails\/220x124\/([^"]*)220x124\.jpg/) { $playpath = "mp4:/abcvideo/video_fep/mov/" . lc($1) . "768x432_700.mov"; } $browser->content =~ /

([^<]*)<\/h2>/; my $title = $1; my $rtmpurl = "rtmp://abcondemandfs.fplive.net:1935/abcondemand"; return { rtmp => $rtmpurl, playpath => $playpath, flv => title_to_filename($title) }; } sub handle_abc_clip { my ($browser, $show_id, $playlist_id, $video_id) = @_; # Note 'limit' has been changed to 1 instead of the default of 12. This # ensures that only the desired video is returned. Otherwise unrelated # videos are returned too. my $abc_clip_rss_url_template = "http://ll.static.abc.com/vp2/ws/s/contents/1000/videomrss?" . "brand=001&device=001&width=644&height=362&clipId=%s" . "&start=0&limit=1&fk=CATEGORIES&fv=%s"; my $abc_clip_rss_url = sprintf $abc_clip_rss_url_template, $video_id, $playlist_id; $browser->get($abc_clip_rss_url); if (!$browser->success) { die "Couldn't download ABC clip RSS: " . $browser->response->status_line; } my $xml = from_xml($browser); my $video_url = $xml->{channel}->{item}->{'media:content'}->{url}; my $type = $video_url =~ /\.mp4$/ ? 'mp4' : 'flv'; if (!$video_url) { die "Couldn't determine ABC clip URL"; } # Try to get a decent filename my $episode_name; if ($video_url =~ /FLF_\d+[A-Za-z]{0,5}_([^_]+)/) { $episode_name = $1; } my $category = $xml->{channel}->{item}->{category}; my $title = $xml->{channel}->{item}->{'media:title'}->{content}; if (ref($category) eq 'HASH' and ! keys %$category) { $category = ''; } # Description isn't actually very long - see media:text for that for when # gfv has support for writing Dublin Core-compliant metadata. my $description = $xml->{channel}->{item}->{'media:description'}->{content}; # Remove HTML in evil way. for ($category, $description, $title) { s/<\/?\w+>//g; } my $video_title = make_title($category, $episode_name, $title, $description); return $video_url, title_to_filename($video_title, $type); } # Produces the title, taking into account items that don't exist sub make_title { return join " - ", grep /./, @_; } sub can_handle { my($self, $browser, $url) = @_; # This is only ABC as in the US broadcaster, not abc.net.au return $url && URI->new($url)->host =~ /\babc\.(?:go\.)?com$/; } 1; get-flash-videos-1.25.98/lib/FlashVideo/Site/Abclocal.pm000066400000000000000000000016031324005573400226000ustar00rootroot00000000000000# Part of get-flash-videos. See get_flash_videos for copyright. package FlashVideo::Site::Abclocal; use strict; use FlashVideo::Utils; use Data::Dumper; use File::Basename; sub find_video { my ($self, $browser, $embed_url, $prefs) = @_; my($station,$id) = $browser->content =~ m{http://cdn.abclocal.go.com/[^"']*station=([^&;"']+)[^"']*mediaId=([^&;"']+)}s; die "No media id and station found" unless $id; $browser->get("http://cdn.abclocal.go.com/$station/playlistSyndicated?id=$id"); my @tmp = $browser->content =~ m{