commit 787a690ec94d904da883b726dc88aa4098ff8056 Author: Petr Písař <ppisar@xxxxxxxxxx> Date: Mon Apr 15 14:43:16 2013 +0200 Teach rpmlint .build-0.38-1.fc20.log | 94 ++ .build-0.42-1.fc20.log | 94 ++ .rpmlint | 2 + File-Fetch-0.38/CHANGES | 214 +++ File-Fetch-0.38/MANIFEST | 9 + File-Fetch-0.38/META.json | 54 + File-Fetch-0.38/META.yml | 32 + File-Fetch-0.38/MYMETA.json | 54 + File-Fetch-0.38/MYMETA.yml | 32 + File-Fetch-0.38/Makefile | 898 +++++++++++ File-Fetch-0.38/Makefile.PL | 56 + File-Fetch-0.38/README | 40 + File-Fetch-0.38/blib/lib/File/Fetch.pm | 1658 ++++++++++++++++++++ File-Fetch-0.38/blib/man3/File::Fetch.3pm | 456 ++++++ File-Fetch-0.38/lib/File/Fetch.pm | 1658 ++++++++++++++++++++ File-Fetch-0.38/t/01_File-Fetch.t | 281 ++++ File-Fetch-0.38/t/null_subclass.t | 23 + File-Fetch-0.42/CHANGES | 222 +++ File-Fetch-0.42/MANIFEST | 9 + File-Fetch-0.42/META.json | 54 + File-Fetch-0.42/META.yml | 32 + File-Fetch-0.42/MYMETA.json | 54 + File-Fetch-0.42/MYMETA.yml | 32 + File-Fetch-0.42/Makefile | 898 +++++++++++ File-Fetch-0.42/Makefile.PL | 56 + File-Fetch-0.42/README | 40 + File-Fetch-0.42/blib/lib/File/Fetch.pm | 1708 +++++++++++++++++++++ File-Fetch-0.42/blib/man3/File::Fetch.3pm | 459 ++++++ File-Fetch-0.42/lib/File/Fetch.pm | 1708 +++++++++++++++++++++ File-Fetch-0.42/t/01_File-Fetch.t | 303 ++++ File-Fetch-0.42/t/null_subclass.t | 23 + noarch/perl-File-Fetch-0.38-1.fc20.noarch.rpm | Bin 0 -> 25572 bytes noarch/perl-File-Fetch-0.42-1.fc20.noarch.rpm | Bin 0 -> 25792 bytes perl-File-Fetch-0.38-1.fc20.src.rpm | Bin 0 -> 23731 bytes perl-File-Fetch-0.42-1.fc20.src.rpm | Bin 0 -> 24063 bytes 35 files changed, 11253 insertions(+), 0 deletions(-) --- diff --git a/.build-0.38-1.fc20.log b/.build-0.38-1.fc20.log new file mode 100644 index 0000000..5bbbce1 --- /dev/null +++ b/.build-0.38-1.fc20.log @@ -0,0 +1,94 @@ + + +Provádění(%prep): /bin/sh -e /var/tmp/rpm-tmp.UqULff ++ umask 022 ++ cd /home/petr/fedora/perl-File-Fetch ++ cd /home/petr/fedora/perl-File-Fetch ++ rm -rf File-Fetch-0.38 ++ /usr/bin/gzip -dc /home/petr/fedora/perl-File-Fetch/File-Fetch-0.38.tar.gz ++ /usr/bin/tar -xf - ++ STATUS=0 ++ '[' 0 -ne 0 ']' ++ cd File-Fetch-0.38 ++ /usr/bin/chmod -Rf a+rX,u+w,g-w,o-w . ++ exit 0 +Provádění(%build): /bin/sh -e /var/tmp/rpm-tmp.4FMg91 ++ umask 022 ++ cd /home/petr/fedora/perl-File-Fetch ++ cd File-Fetch-0.38 ++ perl Makefile.PL INSTALLDIRS=vendor +Checking if your kit is complete... +Looks good +Writing Makefile for File::Fetch +Writing MYMETA.yml and MYMETA.json ++ make -j5 +cp lib/File/Fetch.pm blib/lib/File/Fetch.pm +Manifying blib/man3/File::Fetch.3pm ++ exit 0 +Provádění(%install): /bin/sh -e /var/tmp/rpm-tmp.coAhfQ ++ umask 022 ++ cd /home/petr/fedora/perl-File-Fetch ++ '[' /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64 '!=' / ']' ++ rm -rf /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64 +++ dirname /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64 ++ mkdir -p /home/petr/rpmbuild/BUILDROOT ++ mkdir /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64 ++ cd File-Fetch-0.38 ++ make pure_install DESTDIR=/home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64 +Manifying blib/man3/File::Fetch.3pm +Installing /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64/usr/share/perl5/vendor_perl/File/Fetch.pm +Installing /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64/usr/share/man/man3/File::Fetch.3pm ++ find /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64 -type f -name .packlist -exec rm -f '{}' ';' ++ /usr/bin/chmod -Rf a+rX,u+w,g-w,o-w /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64/usr ++ /usr/lib/rpm/find-debuginfo.sh --strict-build-id -m --run-dwz --dwz-low-mem-die-limit 10000000 --dwz-max-die-limit 110000000 /home/petr/fedora/perl-File-Fetch/File-Fetch-0.38 ++ /usr/lib/rpm/check-rpaths /usr/lib/rpm/check-buildroot ++ /usr/lib/rpm/redhat/brp-compress ++ /usr/lib/rpm/redhat/brp-strip-static-archive /usr/bin/strip ++ /usr/lib/rpm/brp-python-bytecompile /usr/bin/python 1 ++ /usr/lib/rpm/redhat/brp-python-hardlink ++ /usr/lib/rpm/redhat/brp-java-repack-jars +Provádění(%check): /bin/sh -e /var/tmp/rpm-tmp.0P0n9E ++ umask 022 ++ cd /home/petr/fedora/perl-File-Fetch ++ cd File-Fetch-0.38 ++ make test +PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t + + +####################### NOTE ############################## + +Some of these tests assume you are connected to the +internet. If you are not, or if certain protocols or hosts +are blocked and/or firewalled, these tests could fail due +to no fault of the module itself. + +########################################################### + +t/01_File-Fetch.t .. ok +t/null_subclass.t .. ok +All tests successful. +Files=2, Tests=450, 27 wallclock secs ( 0.09 usr 0.01 sys + 0.68 cusr 0.41 csys = 1.19 CPU) +Result: PASS ++ exit 0 +Processing files: perl-File-Fetch-0.38-1.fc20.noarch +Provádění(%doc): /bin/sh -e /var/tmp/rpm-tmp.8lWAIN ++ umask 022 ++ cd /home/petr/fedora/perl-File-Fetch ++ cd File-Fetch-0.38 ++ DOCDIR=/home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64/usr/share/doc/perl-File-Fetch-0.38 ++ export DOCDIR ++ /usr/bin/mkdir -p /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64/usr/share/doc/perl-File-Fetch-0.38 ++ cp -pr CHANGES README /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64/usr/share/doc/perl-File-Fetch-0.38 ++ exit 0 +Provides: perl(File::Fetch) = 0.38 perl-File-Fetch = 0.38-1.fc20 +Requires(rpmlib): rpmlib(CompressedFileNames) <= 3.0.4-1 rpmlib(PayloadFilesHavePrefix) <= 4.0-1 +Requires: perl(Carp) perl(Cwd) perl(File::Basename) perl(File::Copy) perl(File::Path) perl(File::Spec::Unix) perl(File::Temp) perl(FileHandle) perl(Locale::Maketext::Simple) perl(constant) perl(strict) perl(vars) +Kontroluji nezabalené soubory: /usr/lib/rpm/check-files /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64 +Zapsáno: /home/petr/fedora/perl-File-Fetch/perl-File-Fetch-0.38-1.fc20.src.rpm +Zapsáno: /home/petr/fedora/perl-File-Fetch/noarch/perl-File-Fetch-0.38-1.fc20.noarch.rpm +Provádění(%clean): /bin/sh -e /var/tmp/rpm-tmp.gwOJXd ++ umask 022 ++ cd /home/petr/fedora/perl-File-Fetch ++ cd File-Fetch-0.38 ++ /usr/bin/rm -rf /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.38-1.fc20.x86_64 ++ exit 0 diff --git a/.build-0.42-1.fc20.log b/.build-0.42-1.fc20.log new file mode 100644 index 0000000..518dfb8 --- /dev/null +++ b/.build-0.42-1.fc20.log @@ -0,0 +1,94 @@ + + +Provádění(%prep): /bin/sh -e /var/tmp/rpm-tmp.eHPRZy ++ umask 022 ++ cd /home/petr/fedora/perl-File-Fetch ++ cd /home/petr/fedora/perl-File-Fetch ++ rm -rf File-Fetch-0.42 ++ /usr/bin/gzip -dc /home/petr/fedora/perl-File-Fetch/File-Fetch-0.42.tar.gz ++ /usr/bin/tar -xf - ++ STATUS=0 ++ '[' 0 -ne 0 ']' ++ cd File-Fetch-0.42 ++ /usr/bin/chmod -Rf a+rX,u+w,g-w,o-w . ++ exit 0 +Provádění(%build): /bin/sh -e /var/tmp/rpm-tmp.o2lDpS ++ umask 022 ++ cd /home/petr/fedora/perl-File-Fetch ++ cd File-Fetch-0.42 ++ perl Makefile.PL INSTALLDIRS=vendor +Checking if your kit is complete... +Looks good +Writing Makefile for File::Fetch +Writing MYMETA.yml and MYMETA.json ++ make -j5 +cp lib/File/Fetch.pm blib/lib/File/Fetch.pm +Manifying blib/man3/File::Fetch.3pm ++ exit 0 +Provádění(%install): /bin/sh -e /var/tmp/rpm-tmp.gmoy0c ++ umask 022 ++ cd /home/petr/fedora/perl-File-Fetch ++ '[' /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64 '!=' / ']' ++ rm -rf /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64 +++ dirname /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64 ++ mkdir -p /home/petr/rpmbuild/BUILDROOT ++ mkdir /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64 ++ cd File-Fetch-0.42 ++ make pure_install DESTDIR=/home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64 +Manifying blib/man3/File::Fetch.3pm +Installing /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64/usr/share/perl5/vendor_perl/File/Fetch.pm +Installing /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64/usr/share/man/man3/File::Fetch.3pm ++ find /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64 -type f -name .packlist -exec rm -f '{}' ';' ++ /usr/bin/chmod -Rf a+rX,u+w,g-w,o-w /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64/usr ++ /usr/lib/rpm/find-debuginfo.sh --strict-build-id -m --run-dwz --dwz-low-mem-die-limit 10000000 --dwz-max-die-limit 110000000 /home/petr/fedora/perl-File-Fetch/File-Fetch-0.42 ++ /usr/lib/rpm/check-rpaths /usr/lib/rpm/check-buildroot ++ /usr/lib/rpm/redhat/brp-compress ++ /usr/lib/rpm/redhat/brp-strip-static-archive /usr/bin/strip ++ /usr/lib/rpm/brp-python-bytecompile /usr/bin/python 1 ++ /usr/lib/rpm/redhat/brp-python-hardlink ++ /usr/lib/rpm/redhat/brp-java-repack-jars +Provádění(%check): /bin/sh -e /var/tmp/rpm-tmp.gKkeoy ++ umask 022 ++ cd /home/petr/fedora/perl-File-Fetch ++ cd File-Fetch-0.42 ++ make test +PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t + + +####################### NOTE ############################## + +Some of these tests assume you are connected to the +internet. If you are not, or if certain protocols or hosts +are blocked and/or firewalled, these tests could fail due +to no fault of the module itself. + +########################################################### + +t/01_File-Fetch.t .. ok +t/null_subclass.t .. ok +All tests successful. +Files=2, Tests=472, 34 wallclock secs ( 0.09 usr 0.01 sys + 0.69 cusr 0.52 csys = 1.31 CPU) +Result: PASS ++ exit 0 +Processing files: perl-File-Fetch-0.42-1.fc20.noarch +Provádění(%doc): /bin/sh -e /var/tmp/rpm-tmp.4fCaBv ++ umask 022 ++ cd /home/petr/fedora/perl-File-Fetch ++ cd File-Fetch-0.42 ++ DOCDIR=/home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64/usr/share/doc/perl-File-Fetch-0.42 ++ export DOCDIR ++ /usr/bin/mkdir -p /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64/usr/share/doc/perl-File-Fetch-0.42 ++ cp -pr CHANGES README /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64/usr/share/doc/perl-File-Fetch-0.42 ++ exit 0 +Provides: perl(File::Fetch) = 0.42 perl-File-Fetch = 0.42-1.fc20 +Requires(rpmlib): rpmlib(CompressedFileNames) <= 3.0.4-1 rpmlib(PayloadFilesHavePrefix) <= 4.0-1 +Requires: perl(Carp) perl(Cwd) perl(File::Basename) perl(File::Copy) perl(File::Path) perl(File::Spec::Unix) perl(File::Temp) perl(FileHandle) perl(Locale::Maketext::Simple) perl(constant) perl(strict) perl(vars) +Kontroluji nezabalené soubory: /usr/lib/rpm/check-files /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64 +Zapsáno: /home/petr/fedora/perl-File-Fetch/perl-File-Fetch-0.42-1.fc20.src.rpm +Zapsáno: /home/petr/fedora/perl-File-Fetch/noarch/perl-File-Fetch-0.42-1.fc20.noarch.rpm +Provádění(%clean): /bin/sh -e /var/tmp/rpm-tmp.26zpQn ++ umask 022 ++ cd /home/petr/fedora/perl-File-Fetch ++ cd File-Fetch-0.42 ++ /usr/bin/rm -rf /home/petr/rpmbuild/BUILDROOT/perl-File-Fetch-0.42-1.fc20.x86_64 ++ exit 0 diff --git a/.rpmlint b/.rpmlint new file mode 100644 index 0000000..21e112e --- /dev/null +++ b/.rpmlint @@ -0,0 +1,2 @@ +from Config import * +addFilter("spelling-error .* (http|rsync)"); diff --git a/File-Fetch-0.38/CHANGES b/File-Fetch-0.38/CHANGES new file mode 100644 index 0000000..c35ee01 --- /dev/null +++ b/File-Fetch-0.38/CHANGES @@ -0,0 +1,214 @@ +Changes for 0.38 Thu Jan 10 20:52:53 2013 +================================================= +* Add support for an optional tempdir_root + parameter (Kent Fredric) + +Changes for 0.36 Thu Jun 28 13:41:31 2012 +================================================= +* Added 'file_default' option for URLs that do + not have a file component (Andrew Kirkpatrick) + +Changes for 0.34 Thu Apr 12 22:25:01 2012 +================================================= +* Added heuristics to skip tests when no + Internet access + +Changes for 0.32 Mon Jan 17 10:26:40 2011 +================================================= +* Added support for HTTP::Tiny + +Changes for 0.30 Fri Jan 7 21:00:27 2011 +================================================= +* Apply blead patches from Peter Acklam + +Changes for 0.28 Sun Nov 7 21:22:26 2010 +================================================= +* Added support for FreeBSDs 'fetch' command for + both http and ftp schemes. + +Changes for 0.26 Sat Nov 6 23:30:59 2010 +================================================= +* Added support for HTTP::Lite +* Resolved issue with '-l' switch and iosock fetch + +Changes for 0.24 Wed Jan 6 23:32:19 2010 +================================================= +* Applied a patch from brian d foy RT #53427 + that makes new() respect sub-classes. + +Changes for 0.22 Sat Nov 14 23:13:16 2009 +================================================= +* Bumped to stable version + +Changes for 0.21_02 Thu Nov 12 12:55:57 2009 +================================================= +* Additional checks for the iosock retriever + +Changes for 0.21_01 Wed Nov 11 23:38:27 2009 +================================================= +* Added a simple IO::Socket/IO::Select based http retriever, + based on code suggested by Paul 'Leonerd' Evans + +Changes for 0.20 Sat Jun 27 16:30:59 2009 +================================================= +* Promote 0.19_01 to stable + +Changes for 0.19_01 Mon Feb 9 18:04:01 2009 +================================================= +* Address: #42268: Wishlist: slurp to scalar + File::Fetch can now fetch to scalars as well + +Changes for 0.18 Wed Dec 17 14:00:40 2008 +================================================= +* Address #41412: User agent string contains uninterpolated + $VERSION. +* Use IPC::Cmd 0.42's supplied QUOTE constant, rather than + rolling our own + +Changes for 0.16 Fri Oct 10 13:54:40 2008 +================================================= +* Promote 0.15_04 to stable. + +Changes for 0.15_04 Mon Sep 22 15:08:49 2008 +================================================= +* Address: #37649: Feature request: Support lftp + File::Fetch now supports lftp, with one minor caveat: it uses + a temporary file to store the commands for lftp, as they are + multiline commands. Without this, we run into portability issues + with 'special' characters on various platforms, like ; and &. + +Changes for 0.15_03 Sun Jul 13 15:56:41 2008 +================================================= +* Add -q to curl, to inhibit the reading of .curlrc, + which may interfere with the options we pass ourselves. + This addresses #36902 + +Changes for 0.15_02 Sun May 18 13:42:30 2008 +================================================= +* Address #35018: Treat HTTP 404 Message as fail with lynx + lynx now does a -head request first to make sure the file + exists before proceeding + +Changes for 0.15_01 Sun Apr 6 13:55:36 2008 +================================================= +* Address: #32755: File-Fetch tests cannot fail if + unable to connect to internet. Tests are now skipped + if it looks as the failure is due to a lacking network + connection. +* New IPC::Cmd (0.41) fixes an IPC::Open3 bug, which we + now rely on. + +Changes for 0.14 Fri Dec 14 13:42:30 2007 +================================================= +* Promote 0.13_04 to stable. + +Changes for 0.13_04 Wed Nov 14 20:07:02 2007 +================================================= +* VMS patches for file:// uris by John M. + +Changes for 0.13_03 2007-11-04 21:32:40 +================================================= +* Restore OS specific file:// URI behaviour. The + RFC's specify that the url definition is host OS + specific, so what a url means on one machine will + mean something different on another. + VMS is now treated according to RFC 1738 + (http://www.faqs.org/rfcs/rfc1738.html). + +Changes for 0.13_02 Sun Nov 4 10:38:40 CET 2007 +================================================= +* Apply a perl 5.5.x compatibility fix. Users with + perl 5.6.0 or higher do not need to upgrade. + +Changes for 0.13_01 Sat Nov 3 18:55:10 CET 2007 +================================================= +* Apply a modified version of dmq's patch to deal + properly with file:// URIs on Win32. +* Add test cases for Win32 file:// URIs + +Changes for 0.12 Mon Oct 15 14:32:23 CEST 2007 +================================================= +* Treat VMS like UNIX when dealing with file URIs + +Changes for 0.10 Fri Jan 26 13:51:19 CET 2007 +================================================ +* Promote 0.09_02 to stable. + +Changes for 0.09_02 Sun Jan 7 18:44:09 CET 2007 +================================================ +* The quotation as done in 0.09_01 doesn't play + nicely with Win32 and IPC::Run. IPC::Run is + therefor disabled during the fetch() call. +* Remove File::Fetch::Item as a class. All objects + are now plain File::Fetch objects. This has no + impact on user-end code, except code that checks + the class of objects. +* URI encoding is not always clear or trivial. Add + a FAQ entry about it. +* Add $ff->output_file as accessor, which is the + requested file, stripped from query parameters. +* Errors are now stored per object rather than + class wide. + +Changes for 0.09_01 Wed Jan 3 17:17:31 CET 2007 +================================================ +* address: #23864: File:Fetch does not use quotation + marks while using wget: + * the handlers for lynx, wget, curl and rsync now + quote their URIs. + +Changes for 0.08 Wed Jul 5 13:56:36 CEST 2006 +================================================ +* address: #18942: unproper handling of http errors + in external handlers: + * the wget handler, on a failed attempt, now + unlinks its outputfile + * the curl handler is updated to follow '302 moved' + and such like status messages + * lynx use is further discouraged, as it doesn't + communicate http status messages back to the caller + at all. +* address #11483: File::Fetch 0.07 cannot do an FTP + fetch on Win32. FTP fetching using Net::FTP should + now work properly on win32. +* update test suite so it runs safely under PERL_CORE + +Changes for 0.07 Thu Dec 23 09:31:00 PST 2004 +================================================ + +* Add $TIMEOUT to specify the network timeout + +Changes for 0.06 Thu Dec 16 03:21:00 PST 2004 +================================================ + +* Add rsync support + +Changes for 0.05 Fri Jun 18 13:55:51 CEST 2004 +================================================= + +* Update faq +* Silence silly warnings + +Changes for 0.04 Fri Jun 11 22:40:34 CEST 2004 +================================================= + +* Add file support using File::Copy + +Changes for 0.03 Fri Jun 11 20:40:22 CEST 2004 +================================================= + +* Add I18N support +* Add better error handling + +Changes for 0.02 Sat May 22 14:40:29 CEST 2004 +================================================= + +* Add an extra 'FAQ' entry +* Include a 'use File::Fetch::Item' + + +Changes for 0.01 Tue May 4 15:48:24 CEST 2004 +================================================= + +* Initial release + diff --git a/File-Fetch-0.38/MANIFEST b/File-Fetch-0.38/MANIFEST new file mode 100644 index 0000000..702c16f --- /dev/null +++ b/File-Fetch-0.38/MANIFEST @@ -0,0 +1,9 @@ +CHANGES +lib/File/Fetch.pm +Makefile.PL +MANIFEST This list of files +README +t/01_File-Fetch.t +t/null_subclass.t +META.yml Module YAML meta-data (added by MakeMaker) +META.json Module JSON meta-data (added by MakeMaker) diff --git a/File-Fetch-0.38/META.json b/File-Fetch-0.38/META.json new file mode 100644 index 0000000..665f737 --- /dev/null +++ b/File-Fetch-0.38/META.json @@ -0,0 +1,54 @@ +{ + "abstract" : "Generic file fetching code", + "author" : [ + "Jos Boumans <kane[at]cpan.org>" + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "File-Fetch", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : { + "File::Basename" : "0", + "File::Copy" : "0", + "File::Path" : "0", + "File::Spec" : "0.82", + "IPC::Cmd" : "0.42", + "Locale::Maketext::Simple" : "0", + "Module::Load::Conditional" : "0.04", + "Params::Check" : "0.07", + "Test::More" : "0" + } + } + }, + "release_status" : "stable", + "resources" : { + "repository" : { + "url" : "https://github.com/jib/file-fetch" + } + }, + "version" : "0.38" +} diff --git a/File-Fetch-0.38/META.yml b/File-Fetch-0.38/META.yml new file mode 100644 index 0000000..fa7e613 --- /dev/null +++ b/File-Fetch-0.38/META.yml @@ -0,0 +1,32 @@ +--- +abstract: 'Generic file fetching code' +author: + - 'Jos Boumans <kane[at]cpan.org>' +build_requires: + ExtUtils::MakeMaker: 0 +configure_requires: + ExtUtils::MakeMaker: 0 +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: File-Fetch +no_index: + directory: + - t + - inc +requires: + File::Basename: 0 + File::Copy: 0 + File::Path: 0 + File::Spec: 0.82 + IPC::Cmd: 0.42 + Locale::Maketext::Simple: 0 + Module::Load::Conditional: 0.04 + Params::Check: 0.07 + Test::More: 0 +resources: + repository: https://github.com/jib/file-fetch +version: 0.38 diff --git a/File-Fetch-0.38/MYMETA.json b/File-Fetch-0.38/MYMETA.json new file mode 100644 index 0000000..7366c09 --- /dev/null +++ b/File-Fetch-0.38/MYMETA.json @@ -0,0 +1,54 @@ +{ + "abstract" : "Generic file fetching code", + "author" : [ + "Jos Boumans <kane[at]cpan.org>" + ], + "dynamic_config" : 0, + "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "File-Fetch", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : { + "File::Basename" : "0", + "File::Copy" : "0", + "File::Path" : "0", + "File::Spec" : "0.82", + "IPC::Cmd" : "0.42", + "Locale::Maketext::Simple" : "0", + "Module::Load::Conditional" : "0.04", + "Params::Check" : "0.07", + "Test::More" : "0" + } + } + }, + "release_status" : "stable", + "resources" : { + "repository" : { + "url" : "https://github.com/jib/file-fetch" + } + }, + "version" : "0.38" +} diff --git a/File-Fetch-0.38/MYMETA.yml b/File-Fetch-0.38/MYMETA.yml new file mode 100644 index 0000000..9c497fd --- /dev/null +++ b/File-Fetch-0.38/MYMETA.yml @@ -0,0 +1,32 @@ +--- +abstract: 'Generic file fetching code' +author: + - 'Jos Boumans <kane[at]cpan.org>' +build_requires: + ExtUtils::MakeMaker: 0 +configure_requires: + ExtUtils::MakeMaker: 0 +dynamic_config: 0 +generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: File-Fetch +no_index: + directory: + - t + - inc +requires: + File::Basename: 0 + File::Copy: 0 + File::Path: 0 + File::Spec: 0.82 + IPC::Cmd: 0.42 + Locale::Maketext::Simple: 0 + Module::Load::Conditional: 0.04 + Params::Check: 0.07 + Test::More: 0 +resources: + repository: https://github.com/jib/file-fetch +version: 0.38 diff --git a/File-Fetch-0.38/Makefile b/File-Fetch-0.38/Makefile new file mode 100644 index 0000000..e50e4f9 --- /dev/null +++ b/File-Fetch-0.38/Makefile @@ -0,0 +1,898 @@ +# This Makefile is for the File::Fetch extension to perl. +# +# It was generated automatically by MakeMaker version +# 6.6302 (Revision: 66302) from the contents of +# Makefile.PL. Don't edit this file, edit Makefile.PL instead. +# +# ANY CHANGES MADE HERE WILL BE LOST! +# +# MakeMaker ARGV: (q[INSTALLDIRS=vendor]) +# + +# MakeMaker Parameters: + +# ABSTRACT => q[Generic file fetching code] +# AUTHOR => [q[Jos Boumans <kane[at]cpan.org>]] +# BUILD_REQUIRES => { } +# CONFIGURE_REQUIRES => { } +# INSTALLDIRS => q[perl] +# LICENSE => q[perl] +# META_MERGE => { resources=>{ repository=>q[https://github.com/jib/file-fetch] } } +# NAME => q[File::Fetch] +# PREREQ_PM => { File::Copy=>q[0], File::Spec=>q[0.82], Locale::Maketext::Simple=>q[0], IPC::Cmd=>q[0.42], Params::Check=>q[0.07], Test::More=>q[0], File::Path=>q[0], Module::Load::Conditional=>q[0.04], File::Basename=>q[0] } +# VERSION_FROM => q[lib/File/Fetch.pm] +# clean => { FILES=>q[t/tmp] } +# dist => { COMPRESS=>q[gzip -9f], SUFFIX=>q[gz] } + +# --- MakeMaker post_initialize section: + + +# --- MakeMaker const_config section: + +# These definitions are from config.sh (via /usr/lib64/perl5/Config.pm). +# They may have been overridden via Makefile.PL or on the command line. +AR = ar +CC = gcc +CCCDLFLAGS = -fPIC +CCDLFLAGS = -Wl,--enable-new-dtags -Wl,-rpath,/usr/lib64/perl5/CORE +DLEXT = so +DLSRC = dl_dlopen.xs +EXE_EXT = +FULL_AR = /usr/bin/ar +LD = gcc +LDDLFLAGS = -shared -O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic -Wl,-z,relro +LDFLAGS = -fstack-protector +LIBC = +LIB_EXT = .a +OBJ_EXT = .o +OSNAME = linux +OSVERS = 2.6.32-358.2.1.el6.x86_64 +RANLIB = : +SITELIBEXP = /usr/local/share/perl5 +SITEARCHEXP = /usr/local/lib64/perl5 +SO = so +VENDORARCHEXP = /usr/lib64/perl5/vendor_perl +VENDORLIBEXP = /usr/share/perl5/vendor_perl + + +# --- MakeMaker constants section: +AR_STATIC_ARGS = cr +DIRFILESEP = / +DFSEP = $(DIRFILESEP) +NAME = File::Fetch +NAME_SYM = File_Fetch +VERSION = 0.38 +VERSION_MACRO = VERSION +VERSION_SYM = 0_38 +DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" +XS_VERSION = 0.38 +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" +INST_ARCHLIB = blib/arch +INST_SCRIPT = blib/script +INST_BIN = blib/bin +INST_LIB = blib/lib +INST_MAN1DIR = blib/man1 +INST_MAN3DIR = blib/man3 +MAN1EXT = 1 +MAN3EXT = 3pm +INSTALLDIRS = vendor +DESTDIR = +PREFIX = $(VENDORPREFIX) +PERLPREFIX = /usr +SITEPREFIX = /usr/local +VENDORPREFIX = /usr +INSTALLPRIVLIB = /usr/share/perl5 +DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB) +INSTALLSITELIB = /usr/local/share/perl5 +DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB) +INSTALLVENDORLIB = /usr/share/perl5/vendor_perl +DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB) +INSTALLARCHLIB = /usr/lib64/perl5 +DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB) +INSTALLSITEARCH = /usr/local/lib64/perl5 +DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH) +INSTALLVENDORARCH = /usr/lib64/perl5/vendor_perl +DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH) +INSTALLBIN = /usr/bin +DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN) +INSTALLSITEBIN = /usr/local/bin +DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN) +INSTALLVENDORBIN = /usr/bin +DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN) +INSTALLSCRIPT = /usr/bin +DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT) +INSTALLSITESCRIPT = /usr/local/bin +DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT) +INSTALLVENDORSCRIPT = /usr/bin +DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT) +INSTALLMAN1DIR = /usr/share/man/man1 +DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR) +INSTALLSITEMAN1DIR = /usr/local/share/man/man1 +DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR) +INSTALLVENDORMAN1DIR = /usr/share/man/man1 +DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR) +INSTALLMAN3DIR = /usr/share/man/man3 +DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR) +INSTALLSITEMAN3DIR = /usr/local/share/man/man3 +DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR) +INSTALLVENDORMAN3DIR = /usr/share/man/man3 +DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR) +PERL_LIB = /usr/share/perl5 +PERL_ARCHLIB = /usr/lib64/perl5 +LIBPERL_A = libperl.a +FIRST_MAKEFILE = Makefile +MAKEFILE_OLD = Makefile.old +MAKE_APERL_FILE = Makefile.aperl +PERLMAINCC = $(CC) +PERL_INC = /usr/lib64/perl5/CORE +PERL = /usr/bin/perl +FULLPERL = /usr/bin/perl +ABSPERL = $(PERL) +PERLRUN = $(PERL) +FULLPERLRUN = $(FULLPERL) +ABSPERLRUN = $(ABSPERL) +PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +PERL_CORE = 0 +PERM_DIR = 755 +PERM_RW = 644 +PERM_RWX = 755 + +MAKEMAKER = /usr/share/perl5/ExtUtils/MakeMaker.pm +MM_VERSION = 6.6302 +MM_REVISION = 66302 + +# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +MAKE = make +FULLEXT = File/Fetch +BASEEXT = Fetch +PARENT_NAME = File +DLBASE = $(BASEEXT) +VERSION_FROM = lib/File/Fetch.pm +OBJECT = +LDFROM = $(OBJECT) +LINKTYPE = dynamic +BOOTDEP = + +# Handy lists of source code files: +XS_FILES = +C_FILES = +O_FILES = +H_FILES = +MAN1PODS = +MAN3PODS = lib/File/Fetch.pm + +# Where is the Config information that we are using/depend on +CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h + +# Where to build things +INST_LIBDIR = $(INST_LIB)/File +INST_ARCHLIBDIR = $(INST_ARCHLIB)/File + +INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) +INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) + +INST_STATIC = +INST_DYNAMIC = +INST_BOOT = + +# Extra linker info +EXPORT_LIST = +PERL_ARCHIVE = +PERL_ARCHIVE_AFTER = + + +TO_INST_PM = lib/File/Fetch.pm + +PM_TO_BLIB = lib/File/Fetch.pm \ + blib/lib/File/Fetch.pm + + +# --- MakeMaker platform_constants section: +MM_Unix_VERSION = 6.6302 +PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc + + +# --- MakeMaker tool_autosplit section: +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$$$ARGV[0], $$$$ARGV[1], 0, 1, 1)' -- + + + +# --- MakeMaker tool_xsubpp section: + + +# --- MakeMaker tools_other section: +SHELL = /bin/sh +CHMOD = chmod +CP = cp +MV = mv +NOOP = $(TRUE) +NOECHO = @ +RM_F = rm -f +RM_RF = rm -rf +TEST_F = test -f +TOUCH = touch +UMASK_NULL = umask 0 +DEV_NULL = > /dev/null 2>&1 +MKPATH = $(ABSPERLRUN) -MExtUtils::Command -e 'mkpath' -- +EQUALIZE_TIMESTAMP = $(ABSPERLRUN) -MExtUtils::Command -e 'eqtime' -- +FALSE = false +TRUE = true +ECHO = echo +ECHO_N = echo -n +UNINST = 0 +VERBINST = 0 +MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install([ from_to => {@ARGV}, verbose => '\''$(VERBINST)'\'', uninstall_shadows => '\''$(UNINST)'\'', dir_mode => '\''$(PERM_DIR)'\'' ]);' -- +DOC_INSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'perllocal_install' -- +UNINSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'uninstall' -- +WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'warn_if_old_packlist' -- +MACROSTART = +MACROEND = +USEMAKEFILE = -f +FIXIN = $(ABSPERLRUN) -MExtUtils::MY -e 'MY->fixin(shift)' -- + + +# --- MakeMaker makemakerdflt section: +makemakerdflt : all + $(NOECHO) $(NOOP) + + +# --- MakeMaker dist section: +TAR = tar +TARFLAGS = cvf +ZIP = zip +ZIPFLAGS = -r +COMPRESS = gzip -9f +SUFFIX = gz +SHAR = shar +PREOP = $(NOECHO) $(NOOP) +POSTOP = $(NOECHO) $(NOOP) +TO_UNIX = $(NOECHO) $(NOOP) +CI = ci -u +RCS_LABEL = rcs -Nv$(VERSION_SYM): -q +DIST_CP = best +DIST_DEFAULT = tardist +DISTNAME = File-Fetch +DISTVNAME = File-Fetch-0.38 + + +# --- MakeMaker macro section: + + +# --- MakeMaker depend section: + + +# --- MakeMaker cflags section: + + +# --- MakeMaker const_loadlibs section: + + +# --- MakeMaker const_cccmd section: + + +# --- MakeMaker post_constants section: + + +# --- MakeMaker pasthru section: + +PASTHRU = LIBPERL_A="$(LIBPERL_A)"\ + LINKTYPE="$(LINKTYPE)"\ + PREFIX="$(PREFIX)" + + +# --- MakeMaker special_targets section: +.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) + +.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir + + + +# --- MakeMaker c_o section: + + +# --- MakeMaker xs_c section: + + +# --- MakeMaker xs_o section: + + +# --- MakeMaker top_targets section: +all :: pure_all manifypods + $(NOECHO) $(NOOP) + + +pure_all :: config pm_to_blib subdirs linkext + $(NOECHO) $(NOOP) + +subdirs :: $(MYEXTLIB) + $(NOECHO) $(NOOP) + +config :: $(FIRST_MAKEFILE) blibdirs + $(NOECHO) $(NOOP) + +help : + perldoc ExtUtils::MakeMaker + + +# --- MakeMaker blibdirs section: +blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists + $(NOECHO) $(NOOP) + +# Backwards compat with 6.18 through 6.25 +blibdirs.ts : blibdirs + $(NOECHO) $(NOOP) + +$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_LIBDIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_LIBDIR) + $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists + +$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHLIB) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHLIB) + $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists + +$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_AUTODIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_AUTODIR) + $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists + +$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHAUTODIR) + $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists + +$(INST_BIN)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_BIN) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_BIN) + $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists + +$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_SCRIPT) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_SCRIPT) + $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists + +$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN1DIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN1DIR) + $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists + +$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN3DIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN3DIR) + $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists + + + +# --- MakeMaker linkext section: + +linkext :: $(LINKTYPE) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dlsyms section: + + +# --- MakeMaker dynamic section: + +dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dynamic_bs section: + +BOOTSTRAP = + + +# --- MakeMaker dynamic_lib section: + + +# --- MakeMaker static section: + +## $(INST_PM) has been moved to the all: target. +## It remains here for awhile to allow for old usage: "make static" +static :: $(FIRST_MAKEFILE) $(INST_STATIC) + $(NOECHO) $(NOOP) + + +# --- MakeMaker static_lib section: + + +# --- MakeMaker manifypods section: + +POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" +POD2MAN = $(POD2MAN_EXE) + + +manifypods : pure_all \ + lib/File/Fetch.pm + $(NOECHO) $(POD2MAN) --section=3 --perm_rw=$(PERM_RW) \ + lib/File/Fetch.pm $(INST_MAN3DIR)/File::Fetch.$(MAN3EXT) + + + + +# --- MakeMaker processPL section: + + +# --- MakeMaker installbin section: + + +# --- MakeMaker subdirs section: + +# none + +# --- MakeMaker clean_subdirs section: +clean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker clean section: + +# Delete temporary files but do not touch installed files. We don't delete +# the Makefile here so a later make realclean still has a makefile to use. + +clean :: clean_subdirs + - $(RM_F) \ + *$(LIB_EXT) core \ + core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \ + core.[0-9][0-9] $(BASEEXT).bso \ + pm_to_blib.ts MYMETA.json \ + core.[0-9][0-9][0-9][0-9] MYMETA.yml \ + $(BASEEXT).x $(BOOTSTRAP) \ + perl$(EXE_EXT) tmon.out \ + *$(OBJ_EXT) pm_to_blib \ + $(INST_ARCHAUTODIR)/extralibs.ld blibdirs.ts \ + core.[0-9][0-9][0-9][0-9][0-9] *perl.core \ + core.*perl.*.? $(MAKE_APERL_FILE) \ + $(BASEEXT).def perl \ + core.[0-9][0-9][0-9] mon.out \ + lib$(BASEEXT).def perlmain.c \ + perl.exe so_locations \ + $(BASEEXT).exp + - $(RM_RF) \ + t/tmp blib + - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) + + +# --- MakeMaker realclean_subdirs section: +realclean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker realclean section: +# Delete temporary files (via clean) and also delete dist files +realclean purge :: clean realclean_subdirs + - $(RM_F) \ + $(MAKEFILE_OLD) $(FIRST_MAKEFILE) + - $(RM_RF) \ + $(DISTVNAME) + + +# --- MakeMaker metafile section: +metafile : create_distdir + $(NOECHO) $(ECHO) Generating META.yml + $(NOECHO) $(ECHO) '---' > META_new.yml + $(NOECHO) $(ECHO) 'abstract: '\''Generic file fetching code'\''' >> META_new.yml + $(NOECHO) $(ECHO) 'author:' >> META_new.yml + $(NOECHO) $(ECHO) ' - '\''Jos Boumans <kane[at]cpan.org>'\''' >> META_new.yml + $(NOECHO) $(ECHO) 'build_requires:' >> META_new.yml + $(NOECHO) $(ECHO) ' ExtUtils::MakeMaker: 0' >> META_new.yml + $(NOECHO) $(ECHO) 'configure_requires:' >> META_new.yml + $(NOECHO) $(ECHO) ' ExtUtils::MakeMaker: 0' >> META_new.yml + $(NOECHO) $(ECHO) 'dynamic_config: 1' >> META_new.yml + $(NOECHO) $(ECHO) 'generated_by: '\''ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921'\''' >> META_new.yml + $(NOECHO) $(ECHO) 'license: perl' >> META_new.yml + $(NOECHO) $(ECHO) 'meta-spec:' >> META_new.yml + $(NOECHO) $(ECHO) ' url: http://module-build.sourceforge.net/META-spec-v1.4.html' >> META_new.yml + $(NOECHO) $(ECHO) ' version: 1.4' >> META_new.yml + $(NOECHO) $(ECHO) 'name: File-Fetch' >> META_new.yml + $(NOECHO) $(ECHO) 'no_index:' >> META_new.yml + $(NOECHO) $(ECHO) ' directory:' >> META_new.yml + $(NOECHO) $(ECHO) ' - t' >> META_new.yml + $(NOECHO) $(ECHO) ' - inc' >> META_new.yml + $(NOECHO) $(ECHO) 'requires:' >> META_new.yml + $(NOECHO) $(ECHO) ' File::Basename: 0' >> META_new.yml + $(NOECHO) $(ECHO) ' File::Copy: 0' >> META_new.yml + $(NOECHO) $(ECHO) ' File::Path: 0' >> META_new.yml + $(NOECHO) $(ECHO) ' File::Spec: 0.82' >> META_new.yml + $(NOECHO) $(ECHO) ' IPC::Cmd: 0.42' >> META_new.yml + $(NOECHO) $(ECHO) ' Locale::Maketext::Simple: 0' >> META_new.yml + $(NOECHO) $(ECHO) ' Module::Load::Conditional: 0.04' >> META_new.yml + $(NOECHO) $(ECHO) ' Params::Check: 0.07' >> META_new.yml + $(NOECHO) $(ECHO) ' Test::More: 0' >> META_new.yml + $(NOECHO) $(ECHO) 'resources:' >> META_new.yml + $(NOECHO) $(ECHO) ' repository: https://github.com/jib/file-fetch' >> META_new.yml + $(NOECHO) $(ECHO) 'version: 0.38' >> META_new.yml + -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml + $(NOECHO) $(ECHO) Generating META.json + $(NOECHO) $(ECHO) '{' > META_new.json + $(NOECHO) $(ECHO) ' "abstract" : "Generic file fetching code",' >> META_new.json + $(NOECHO) $(ECHO) ' "author" : [' >> META_new.json + $(NOECHO) $(ECHO) ' "Jos Boumans <kane[at]cpan.org>"' >> META_new.json + $(NOECHO) $(ECHO) ' ],' >> META_new.json + $(NOECHO) $(ECHO) ' "dynamic_config" : 1,' >> META_new.json + $(NOECHO) $(ECHO) ' "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921",' >> META_new.json + $(NOECHO) $(ECHO) ' "license" : [' >> META_new.json + $(NOECHO) $(ECHO) ' "perl_5"' >> META_new.json + $(NOECHO) $(ECHO) ' ],' >> META_new.json + $(NOECHO) $(ECHO) ' "meta-spec" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",' >> META_new.json + $(NOECHO) $(ECHO) ' "version" : "2"' >> META_new.json + $(NOECHO) $(ECHO) ' },' >> META_new.json + $(NOECHO) $(ECHO) ' "name" : "File-Fetch",' >> META_new.json + $(NOECHO) $(ECHO) ' "no_index" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "directory" : [' >> META_new.json + $(NOECHO) $(ECHO) ' "t",' >> META_new.json + $(NOECHO) $(ECHO) ' "inc"' >> META_new.json + $(NOECHO) $(ECHO) ' ]' >> META_new.json + $(NOECHO) $(ECHO) ' },' >> META_new.json + $(NOECHO) $(ECHO) ' "prereqs" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "build" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "ExtUtils::MakeMaker" : "0"' >> META_new.json + $(NOECHO) $(ECHO) ' }' >> META_new.json + $(NOECHO) $(ECHO) ' },' >> META_new.json + $(NOECHO) $(ECHO) ' "configure" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "ExtUtils::MakeMaker" : "0"' >> META_new.json + $(NOECHO) $(ECHO) ' }' >> META_new.json + $(NOECHO) $(ECHO) ' },' >> META_new.json + $(NOECHO) $(ECHO) ' "runtime" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "File::Basename" : "0",' >> META_new.json + $(NOECHO) $(ECHO) ' "File::Copy" : "0",' >> META_new.json + $(NOECHO) $(ECHO) ' "File::Path" : "0",' >> META_new.json + $(NOECHO) $(ECHO) ' "File::Spec" : "0.82",' >> META_new.json + $(NOECHO) $(ECHO) ' "IPC::Cmd" : "0.42",' >> META_new.json + $(NOECHO) $(ECHO) ' "Locale::Maketext::Simple" : "0",' >> META_new.json + $(NOECHO) $(ECHO) ' "Module::Load::Conditional" : "0.04",' >> META_new.json + $(NOECHO) $(ECHO) ' "Params::Check" : "0.07",' >> META_new.json + $(NOECHO) $(ECHO) ' "Test::More" : "0"' >> META_new.json + $(NOECHO) $(ECHO) ' }' >> META_new.json + $(NOECHO) $(ECHO) ' }' >> META_new.json + $(NOECHO) $(ECHO) ' },' >> META_new.json + $(NOECHO) $(ECHO) ' "release_status" : "stable",' >> META_new.json + $(NOECHO) $(ECHO) ' "resources" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "repository" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "url" : "https://github.com/jib/file-fetch"' >> META_new.json + $(NOECHO) $(ECHO) ' }' >> META_new.json + $(NOECHO) $(ECHO) ' },' >> META_new.json + $(NOECHO) $(ECHO) ' "version" : "0.38"' >> META_new.json + $(NOECHO) $(ECHO) '}' >> META_new.json + -$(NOECHO) $(MV) META_new.json $(DISTVNAME)/META.json + + +# --- MakeMaker signature section: +signature : + cpansign -s + + +# --- MakeMaker dist_basics section: +distclean :: realclean distcheck + $(NOECHO) $(NOOP) + +distcheck : + $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck + +skipcheck : + $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck + +manifest : + $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest + +veryclean : realclean + $(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old + + + +# --- MakeMaker dist_core section: + +dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE) + $(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \ + -e ' if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';' -- + +tardist : $(DISTVNAME).tar$(SUFFIX) + $(NOECHO) $(NOOP) + +uutardist : $(DISTVNAME).tar$(SUFFIX) + uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu + +$(DISTVNAME).tar$(SUFFIX) : distdir + $(PREOP) + $(TO_UNIX) + $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(COMPRESS) $(DISTVNAME).tar + $(POSTOP) + +zipdist : $(DISTVNAME).zip + $(NOECHO) $(NOOP) + +$(DISTVNAME).zip : distdir + $(PREOP) + $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(POSTOP) + +shdist : distdir + $(PREOP) + $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar + $(RM_RF) $(DISTVNAME) + $(POSTOP) + + +# --- MakeMaker distdir section: +create_distdir : + $(RM_RF) $(DISTVNAME) + $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \ + -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" + +distdir : create_distdir distmeta + $(NOECHO) $(NOOP) + + + +# --- MakeMaker dist_test section: +disttest : distdir + cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL "INSTALLDIRS=vendor" + cd $(DISTVNAME) && $(MAKE) $(PASTHRU) + cd $(DISTVNAME) && $(MAKE) test $(PASTHRU) + + + +# --- MakeMaker dist_ci section: + +ci : + $(PERLRUN) "-MExtUtils::Manifest=maniread" \ + -e "@all = keys %{ maniread() };" \ + -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \ + -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});" + + +# --- MakeMaker distmeta section: +distmeta : create_distdir metafile + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -e q{META.yml};' \ + -e 'eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) }' \ + -e ' or print "Could not add META.yml to MANIFEST: $$$${'\''@'\''}\n"' -- + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -f q{META.json};' \ + -e 'eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) }' \ + -e ' or print "Could not add META.json to MANIFEST: $$$${'\''@'\''}\n"' -- + + + +# --- MakeMaker distsignature section: +distsignature : create_distdir + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add SIGNATURE to MANIFEST: $$$${'\''@'\''}\n"' -- + $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE + cd $(DISTVNAME) && cpansign -s + + + +# --- MakeMaker install section: + +install :: pure_install doc_install + $(NOECHO) $(NOOP) + +install_perl :: pure_perl_install doc_perl_install + $(NOECHO) $(NOOP) + +install_site :: pure_site_install doc_site_install + $(NOECHO) $(NOOP) + +install_vendor :: pure_vendor_install doc_vendor_install + $(NOECHO) $(NOOP) + +pure_install :: pure_$(INSTALLDIRS)_install + $(NOECHO) $(NOOP) + +doc_install :: doc_$(INSTALLDIRS)_install + $(NOECHO) $(NOOP) + +pure__install : pure_site_install + $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +doc__install : doc_site_install + $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +pure_perl_install :: all + $(NOECHO) $(MOD_INSTALL) \ + read $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist \ + write $(DESTINSTALLARCHLIB)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(DESTINSTALLPRIVLIB) \ + $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \ + $(INST_BIN) $(DESTINSTALLBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) + $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ + $(SITEARCHEXP)/auto/$(FULLEXT) + + +pure_site_install :: all + $(NOECHO) $(MOD_INSTALL) \ + read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \ + write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(DESTINSTALLSITELIB) \ + $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \ + $(INST_BIN) $(DESTINSTALLSITEBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) + $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ + $(PERL_ARCHLIB)/auto/$(FULLEXT) + +pure_vendor_install :: all + $(NOECHO) $(MOD_INSTALL) \ + read $(VENDORARCHEXP)/auto/$(FULLEXT)/.packlist \ + write $(DESTINSTALLVENDORARCH)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(DESTINSTALLVENDORLIB) \ + $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \ + $(INST_BIN) $(DESTINSTALLVENDORBIN) \ + $(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) + +doc_perl_install :: all + $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod + -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) + -$(NOECHO) $(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLPRIVLIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(DESTINSTALLARCHLIB)/perllocal.pod + +doc_site_install :: all + $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod + -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) + -$(NOECHO) $(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLSITELIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(DESTINSTALLARCHLIB)/perllocal.pod + +doc_vendor_install :: all + $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod + -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) + -$(NOECHO) $(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLVENDORLIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(DESTINSTALLARCHLIB)/perllocal.pod + + +uninstall :: uninstall_from_$(INSTALLDIRS)dirs + $(NOECHO) $(NOOP) + +uninstall_from_perldirs :: + $(NOECHO) $(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist + +uninstall_from_sitedirs :: + $(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist + +uninstall_from_vendordirs :: + $(NOECHO) $(UNINSTALL) $(VENDORARCHEXP)/auto/$(FULLEXT)/.packlist + + +# --- MakeMaker force section: +# Phony target to force checking subdirectories. +FORCE : + $(NOECHO) $(NOOP) + + +# --- MakeMaker perldepend section: + + +# --- MakeMaker makefile section: +# We take a very conservative approach here, but it's worth it. +# We move Makefile to Makefile.old here to avoid gnu make looping. +$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) + $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?" + $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..." + -$(NOECHO) $(RM_F) $(MAKEFILE_OLD) + -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) + - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL) + $(PERLRUN) Makefile.PL "INSTALLDIRS=vendor" + $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" + $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <==" + $(FALSE) + + + +# --- MakeMaker staticmake section: + +# --- MakeMaker makeaperl section --- +MAP_TARGET = perl +FULLPERL = /usr/bin/perl + +$(MAP_TARGET) :: static $(MAKE_APERL_FILE) + $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@ + +$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib + $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) + $(NOECHO) $(PERLRUNINST) \ + Makefile.PL DIR= \ + MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ + MAKEAPERL=1 NORECURS=1 CCCDLFLAGS= \ + INSTALLDIRS=vendor + + +# --- MakeMaker test section: + +TEST_VERBOSE=0 +TEST_TYPE=test_$(LINKTYPE) +TEST_FILE = test.pl +TEST_FILES = t/*.t +TESTDB_SW = -d + +testdb :: testdb_$(LINKTYPE) + +test :: $(TEST_TYPE) subdirs-test + +subdirs-test :: + $(NOECHO) $(NOOP) + + +test_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES) + +testdb_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE) + +test_ : test_dynamic + +test_static :: test_dynamic +testdb_static :: testdb_dynamic + + +# --- MakeMaker ppd section: +# Creates a PPD (Perl Package Description) for a binary distribution. +ppd : + $(NOECHO) $(ECHO) '<SOFTPKG NAME="$(DISTNAME)" VERSION="$(VERSION)">' > $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <ABSTRACT>Generic file fetching code</ABSTRACT>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <AUTHOR>Jos Boumans <kane[at]cpan.org></AUTHOR>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <IMPLEMENTATION>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="File::Basename" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="File::Copy" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="File::Path" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="File::Spec" VERSION="0.82" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="IPC::Cmd" VERSION="0.42" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="Locale::Maketext::Simple" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="Module::Load::Conditional" VERSION="0.04" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="Params::Check" VERSION="0.07" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="Test::More" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <ARCHITECTURE NAME="x86_64-linux-thread-multi-5.16" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <CODEBASE HREF="" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' </IMPLEMENTATION>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) '</SOFTPKG>' >> $(DISTNAME).ppd + + +# --- MakeMaker pm_to_blib section: + +pm_to_blib : $(FIRST_MAKEFILE) $(TO_INST_PM) + $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', q[$(PM_FILTER)], '\''$(PERM_DIR)'\'')' -- \ + lib/File/Fetch.pm blib/lib/File/Fetch.pm + $(NOECHO) $(TOUCH) pm_to_blib + + +# --- MakeMaker selfdocument section: + + +# --- MakeMaker postamble section: + + +# End. diff --git a/File-Fetch-0.38/Makefile.PL b/File-Fetch-0.38/Makefile.PL new file mode 100644 index 0000000..336d6ff --- /dev/null +++ b/File-Fetch-0.38/Makefile.PL @@ -0,0 +1,56 @@ +use ExtUtils::MakeMaker; +use strict; + +WriteMakefile1( + LICENSE => 'perl', + META_MERGE => { + resources => { + repository => 'https://github.com/jib/file-fetch', + }, + }, + #BUILD_REQUIRES => { + #}, + + NAME => 'File::Fetch', + VERSION_FROM => 'lib/File/Fetch.pm', # finds $VERSION + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz' }, + PREREQ_PM => { + 'IPC::Cmd' => 0.42, # ipc::open3 bugfix + 'Test::More' => 0, + 'File::Copy' => 0, + 'File::Spec' => 0.82, + 'File::Path' => 0, + 'File::Basename' => 0, + 'Params::Check' => 0.07, + 'Module::Load::Conditional' => 0.04, + 'Locale::Maketext::Simple' => 0, + }, + INSTALLDIRS => ( $] >= 5.009005 ? 'perl' : 'site' ), + AUTHOR => 'Jos Boumans <kane[at]cpan.org>', + ABSTRACT => 'Generic file fetching code', + clean => {FILES => 't/tmp'}, +); + +sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade. + my %params=@_; + my $eumm_version=$ExtUtils::MakeMaker::VERSION; + $eumm_version=eval $eumm_version; + die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; + die "License not specified" if not exists $params{LICENSE}; + if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { + #EUMM 6.5502 has problems with BUILD_REQUIRES + $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; + delete $params{BUILD_REQUIRES}; + } + delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; + delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; + delete $params{META_MERGE} if $eumm_version < 6.46; + delete $params{META_ADD} if $eumm_version < 6.46; + delete $params{LICENSE} if $eumm_version < 6.31; + delete $params{AUTHOR} if $] < 5.005; + delete $params{ABSTRACT_FROM} if $] < 5.005; + delete $params{BINARY_LOCATION} if $] < 5.005; + + WriteMakefile(%params); +} + diff --git a/File-Fetch-0.38/README b/File-Fetch-0.38/README new file mode 100644 index 0000000..84a6a63 --- /dev/null +++ b/File-Fetch-0.38/README @@ -0,0 +1,40 @@ +This is the README file for File::Fetch, a perl module for generic +file fetching. + +Please refer to 'perldoc File::Fetch' after installation for details. + +##################################################################### + +* Description + +File::Fetch + + File::Fetch is a generic file fetching mechanism. + + It allows you to fetch any file pointed to by a ftp, http + or file uri by a number of different means. + +##################################################################### + +* Installation + +File::Fetch follows the standard perl module install process + +perl Makefile.PL +make +make test +make install + +The module uses no C or XS parts, so no c-compiler is required. + +###################################################################### + +AUTHOR + This module by Jos Boumans <kane@xxxxxxxx>. + +COPYRIGHT + This module is copyright (c) 2002 Jos Boumans <kane@xxxxxxxx>. All + rights reserved. + + This library is free software; you may redistribute and/or modify it + under the same terms as Perl itself. diff --git a/File-Fetch-0.38/blib/arch/.exists b/File-Fetch-0.38/blib/arch/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.38/blib/arch/auto/File/Fetch/.exists b/File-Fetch-0.38/blib/arch/auto/File/Fetch/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.38/blib/bin/.exists b/File-Fetch-0.38/blib/bin/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.38/blib/lib/File/.exists b/File-Fetch-0.38/blib/lib/File/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.38/blib/lib/File/Fetch.pm b/File-Fetch-0.38/blib/lib/File/Fetch.pm new file mode 100644 index 0000000..37f7bc6 --- /dev/null +++ b/File-Fetch-0.38/blib/lib/File/Fetch.pm @@ -0,0 +1,1658 @@ +package File::Fetch; + +use strict; +use FileHandle; +use File::Temp; +use File::Copy; +use File::Spec; +use File::Spec::Unix; +use File::Basename qw[dirname]; + +use Cwd qw[cwd]; +use Carp qw[carp]; +use IPC::Cmd qw[can_run run QUOTE]; +use File::Path qw[mkpath]; +use File::Temp qw[tempdir]; +use Params::Check qw[check]; +use Module::Load::Conditional qw[can_load]; +use Locale::Maketext::Simple Style => 'gettext'; + +use vars qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT + $BLACKLIST $METHOD_FAIL $VERSION $METHODS + $FTP_PASSIVE $TIMEOUT $DEBUG $WARN + ]; + +$VERSION = '0.38'; +$VERSION = eval $VERSION; # avoid warnings with development releases +$PREFER_BIN = 0; # XXX TODO implement +$FROM_EMAIL = 'File-Fetch@xxxxxxxxxxx'; +$USER_AGENT = "File::Fetch/$VERSION"; +$BLACKLIST = [qw|ftp|]; +$METHOD_FAIL = { }; +$FTP_PASSIVE = 1; +$TIMEOUT = 0; +$DEBUG = 0; +$WARN = 1; + +### methods available to fetch the file depending on the scheme +$METHODS = { + http => [ qw|lwp httptiny wget curl lftp fetch httplite lynx iosock| ], + ftp => [ qw|lwp netftp wget curl lftp fetch ncftp ftp| ], + file => [ qw|lwp lftp file| ], + rsync => [ qw|rsync| ] +}; + +### silly warnings ### +local $Params::Check::VERBOSE = 1; +local $Params::Check::VERBOSE = 1; +local $Module::Load::Conditional::VERBOSE = 0; +local $Module::Load::Conditional::VERBOSE = 0; + +### see what OS we are on, important for file:// uris ### +use constant ON_WIN => ($^O eq 'MSWin32'); +use constant ON_VMS => ($^O eq 'VMS'); +use constant ON_UNIX => (!ON_WIN); +use constant HAS_VOL => (ON_WIN); +use constant HAS_SHARE => (ON_WIN); +use constant HAS_FETCH => ( $^O =~ m!^(freebsd|netbsd|dragonfly)$! ); + +=pod + +=head1 NAME + +File::Fetch - A generic file fetching mechanism + +=head1 SYNOPSIS + + use File::Fetch; + + ### build a File::Fetch object ### + my $ff = File::Fetch->new(uri => 'http://some.where.com/dir/a.txt'); + + ### fetch the uri to cwd() ### + my $where = $ff->fetch() or die $ff->error; + + ### fetch the uri to /tmp ### + my $where = $ff->fetch( to => '/tmp' ); + + ### parsed bits from the uri ### + $ff->uri; + $ff->scheme; + $ff->host; + $ff->path; + $ff->file; + +=head1 DESCRIPTION + +File::Fetch is a generic file fetching mechanism. + +It allows you to fetch any file pointed to by a C<ftp>, C<http>, +C<file>, or C<rsync> uri by a number of different means. + +See the C<HOW IT WORKS> section further down for details. + +=head1 ACCESSORS + +A C<File::Fetch> object has the following accessors + +=over 4 + +=item $ff->uri + +The uri you passed to the constructor + +=item $ff->scheme + +The scheme from the uri (like 'file', 'http', etc) + +=item $ff->host + +The hostname in the uri. Will be empty if host was originally +'localhost' for a 'file://' url. + +=item $ff->vol + +On operating systems with the concept of a volume the second element +of a file:// is considered to the be volume specification for the file. +Thus on Win32 this routine returns the volume, on other operating +systems this returns nothing. + +On Windows this value may be empty if the uri is to a network share, in +which case the 'share' property will be defined. Additionally, volume +specifications that use '|' as ':' will be converted on read to use ':'. + +On VMS, which has a volume concept, this field will be empty because VMS +file specifications are converted to absolute UNIX format and the volume +information is transparently included. + +=item $ff->share + +On systems with the concept of a network share (currently only Windows) returns +the sharename from a file://// url. On other operating systems returns empty. + +=item $ff->path + +The path from the uri, will be at least a single '/'. + +=item $ff->file + +The name of the remote file. For the local file name, the +result of $ff->output_file will be used. + +=item $ff->file_default + +The name of the default local file, that $ff->output_file falls back to if +it would otherwise return no filename. For example when fetching a URI like +http://www.abc.net.au/ the contents retrieved may be from a remote file called +'index.html'. The default value of this attribute is literally 'file_default'. + +=cut + + +########################## +### Object & Accessors ### +########################## + +{ + ### template for autogenerated accessors ### + my $Tmpl = { + scheme => { default => 'http' }, + host => { default => 'localhost' }, + path => { default => '/' }, + file => { required => 1 }, + uri => { required => 1 }, + vol => { default => '' }, # windows for file:// uris + share => { default => '' }, # windows for file:// uris + file_default => { default => 'file_default' }, + tempdir_root => { required => 1 }, # Should be lazy-set at ->new() + _error_msg => { no_override => 1 }, + _error_msg_long => { no_override => 1 }, + }; + + for my $method ( keys %$Tmpl ) { + no strict 'refs'; + *$method = sub { + my $self = shift; + $self->{$method} = $_[0] if @_; + return $self->{$method}; + } + } + + sub _create { + my $class = shift; + my %hash = @_; + + my $args = check( $Tmpl, \%hash ) or return; + + bless $args, $class; + + if( lc($args->scheme) ne 'file' and not $args->host ) { + return $class->_error(loc( + "Hostname required when fetching from '%1'",$args->scheme)); + } + + for (qw[path]) { + unless( $args->$_() ) { # 5.5.x needs the () + return $class->_error(loc("No '%1' specified",$_)); + } + } + + return $args; + } +} + +=item $ff->output_file + +The name of the output file. This is the same as $ff->file, +but any query parameters are stripped off. For example: + + http://example.com/index.html?x=y + +would make the output file be C<index.html> rather than +C<index.html?x=y>. + +=back + +=cut + +sub output_file { + my $self = shift; + my $file = $self->file; + + $file =~ s/\?.*$//g; + + $file ||= $self->file_default; + + return $file; +} + +### XXX do this or just point to URI::Escape? +# =head2 $esc_uri = $ff->escaped_uri +# +# =cut +# +# ### most of this is stolen straight from URI::escape +# { ### Build a char->hex map +# my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255; +# +# sub escaped_uri { +# my $self = shift; +# my $uri = $self->uri; +# +# ### Default unsafe characters. RFC 2732 ^(uric - reserved) +# $uri =~ s/([^A-Za-z0-9\-_.!~*'()])/ +# $escapes{$1} || $self->_fail_hi($1)/ge; +# +# return $uri; +# } +# +# sub _fail_hi { +# my $self = shift; +# my $char = shift; +# +# $self->_error(loc( +# "Can't escape '%1', try using the '%2' module instead", +# sprintf("\\x{%04X}", ord($char)), 'URI::Escape' +# )); +# } +# +# sub output_file { +# +# } +# +# +# } + +=head1 METHODS + +=head2 $ff = File::Fetch->new( uri => 'http://some.where.com/dir/file.txt' ); + +Parses the uri and creates a corresponding File::Fetch::Item object, +that is ready to be C<fetch>ed and returns it. + +Returns false on failure. + +=cut + +sub new { + my $class = shift; + my %hash = @_; + + my ($uri, $file_default, $tempdir_root); + my $tmpl = { + uri => { required => 1, store => \$uri }, + file_default => { required => 0, store => \$file_default }, + tempdir_root => { required => 0, store => \$tempdir_root }, + }; + + check( $tmpl, \%hash ) or return; + + ### parse the uri to usable parts ### + my $href = $class->_parse_uri( $uri ) or return; + + $href->{file_default} = $file_default if $file_default; + $href->{tempdir_root} = File::Spec->rel2abs( $tempdir_root ) if $tempdir_root; + $href->{tempdir_root} = File::Spec->rel2abs( Cwd::cwd ) if not $href->{tempdir_root}; + + ### make it into a FFI object ### + my $ff = $class->_create( %$href ) or return; + + + ### return the object ### + return $ff; +} + +### parses an uri to a hash structure: +### +### $class->_parse_uri( 'ftp://ftp.cpan.org/pub/mirror/index.txt' ) +### +### becomes: +### +### $href = { +### scheme => 'ftp', +### host => 'ftp.cpan.org', +### path => '/pub/mirror', +### file => 'index.html' +### }; +### +### In the case of file:// urls there maybe be additional fields +### +### For systems with volume specifications such as Win32 there will be +### a volume specifier provided in the 'vol' field. +### +### 'vol' => 'volumename' +### +### For windows file shares there may be a 'share' key specified +### +### 'share' => 'sharename' +### +### Note that the rules of what a file:// url means vary by the operating system +### of the host being addressed. Thus file:///d|/foo/bar.txt means the obvious +### 'D:\foo\bar.txt' on windows, but on unix it means '/d|/foo/bar.txt' and +### not '/foo/bar.txt' +### +### Similarly if the host interpreting the url is VMS then +### file:///disk$user/my/notes/note12345.txt' means +### 'DISK$USER:[MY.NOTES]NOTE123456.TXT' but will be returned the same as +### if it is unix where it means /disk$user/my/notes/note12345.txt'. +### Except for some cases in the File::Spec methods, Perl on VMS will generally +### handle UNIX format file specifications. +### +### This means it is impossible to serve certain file:// urls on certain systems. +### +### Thus are the problems with a protocol-less specification. :-( +### + +sub _parse_uri { + my $self = shift; + my $uri = shift or return; + + my $href = { uri => $uri }; + + ### find the scheme ### + $uri =~ s|^(\w+)://||; + $href->{scheme} = $1; + + ### See rfc 1738 section 3.10 + ### http://www.faqs.org/rfcs/rfc1738.html + ### And wikipedia for more on windows file:// urls + ### http://en.wikipedia.org/wiki/File:// + if( $href->{scheme} eq 'file' ) { + + my @parts = split '/',$uri; + + ### file://hostname/... + ### file://hostname/... + ### normalize file://localhost with file:/// + $href->{host} = $parts[0] || ''; + + ### index in @parts where the path components begin; + my $index = 1; + + ### file:////hostname/sharename/blah.txt + if ( HAS_SHARE and not length $parts[0] and not length $parts[1] ) { + + $href->{host} = $parts[2] || ''; # avoid warnings + $href->{share} = $parts[3] || ''; # avoid warnings + + $index = 4 # index after the share + + ### file:///D|/blah.txt + ### file:///D:/blah.txt + } elsif (HAS_VOL) { + + ### this code comes from dmq's patch, but: + ### XXX if volume is empty, wouldn't that be an error? --kane + ### if so, our file://localhost test needs to be fixed as wel + $href->{vol} = $parts[1] || ''; + + ### correct D| style colume descriptors + $href->{vol} =~ s/\A([A-Z])\|\z/$1:/i if ON_WIN; + + $index = 2; # index after the volume + } + + ### rebuild the path from the leftover parts; + $href->{path} = join '/', '', splice( @parts, $index, $#parts ); + + } else { + ### using anything but qw() in hash slices may produce warnings + ### in older perls :-( + @{$href}{ qw(host path) } = $uri =~ m|([^/]*)(/.*)$|s; + } + + ### split the path into file + dir ### + { my @parts = File::Spec::Unix->splitpath( delete $href->{path} ); + $href->{path} = $parts[1]; + $href->{file} = $parts[2]; + } + + ### host will be empty if the target was 'localhost' and the + ### scheme was 'file' + $href->{host} = '' if ($href->{host} eq 'localhost') and + ($href->{scheme} eq 'file'); + + return $href; +} + +=head2 $where = $ff->fetch( [to => /my/output/dir/ | \$scalar] ) + +Fetches the file you requested and returns the full path to the file. + +By default it writes to C<cwd()>, but you can override that by specifying +the C<to> argument: + + ### file fetch to /tmp, full path to the file in $where + $where = $ff->fetch( to => '/tmp' ); + + ### file slurped into $scalar, full path to the file in $where + ### file is downloaded to a temp directory and cleaned up at exit time + $where = $ff->fetch( to => \$scalar ); + +Returns the full path to the downloaded file on success, and false +on failure. + +=cut + +sub fetch { + my $self = shift or return; + my %hash = @_; + + my $target; + my $tmpl = { + to => { default => cwd(), store => \$target }, + }; + + check( $tmpl, \%hash ) or return; + + my ($to, $fh); + ### you want us to slurp the contents + if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) { + $to = tempdir( 'FileFetch.XXXXXX', DIR => $self->tempdir_root, CLEANUP => 1 ); + + ### plain old fetch + } else { + $to = $target; + + ### On VMS force to VMS format so File::Spec will work. + $to = VMS::Filespec::vmspath($to) if ON_VMS; + + ### create the path if it doesn't exist yet ### + unless( -d $to ) { + eval { mkpath( $to ) }; + + return $self->_error(loc("Could not create path '%1'",$to)) if $@; + } + } + + ### set passive ftp if required ### + local $ENV{FTP_PASSIVE} = $FTP_PASSIVE; + + ### we dont use catfile on win32 because if we are using a cygwin tool + ### under cmd.exe they wont understand windows style separators. + my $out_to = ON_WIN ? $to.'/'.$self->output_file + : File::Spec->catfile( $to, $self->output_file ); + + for my $method ( @{ $METHODS->{$self->scheme} } ) { + my $sub = '_'.$method.'_fetch'; + + unless( __PACKAGE__->can($sub) ) { + $self->_error(loc("Cannot call method for '%1' -- WEIRD!", + $method)); + next; + } + + ### method is blacklisted ### + next if grep { lc $_ eq $method } @$BLACKLIST; + + ### method is known to fail ### + next if $METHOD_FAIL->{$method}; + + ### there's serious issues with IPC::Run and quoting of command + ### line arguments. using quotes in the wrong place breaks things, + ### and in the case of say, + ### C:\cygwin\bin\wget.EXE --quiet --passive-ftp --output-document + ### "index.html" "http://www.cpan.org/index.html?q=1&y=2" + ### it doesn't matter how you quote, it always fails. + local $IPC::Cmd::USE_IPC_RUN = 0; + + if( my $file = $self->$sub( + to => $out_to + )){ + + unless( -e $file && -s _ ) { + $self->_error(loc("'%1' said it fetched '%2', ". + "but it was not created",$method,$file)); + + ### mark the failure ### + $METHOD_FAIL->{$method} = 1; + + next; + + } else { + + ### slurp mode? + if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) { + + ### open the file + open my $fh, "<$file" or do { + $self->_error( + loc("Could not open '%1': %2", $file, $!)); + return; + }; + + ### slurp + $$target = do { local $/; <$fh> }; + + } + + my $abs = File::Spec->rel2abs( $file ); + return $abs; + + } + } + } + + + ### if we got here, we looped over all methods, but we weren't able + ### to fetch it. + return; +} + +######################## +### _*_fetch methods ### +######################## + +### LWP fetching ### +sub _lwp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### modules required to download with lwp ### + my $use_list = { + LWP => '0.0', + 'LWP::UserAgent' => '0.0', + 'HTTP::Request' => '0.0', + 'HTTP::Status' => '0.0', + URI => '0.0', + + }; + + unless( can_load( modules => $use_list ) ) { + $METHOD_FAIL->{'lwp'} = 1; + return; + } + + ### setup the uri object + my $uri = URI->new( File::Spec::Unix->catfile( + $self->path, $self->file + ) ); + + ### special rules apply for file:// uris ### + $uri->scheme( $self->scheme ); + $uri->host( $self->scheme eq 'file' ? '' : $self->host ); + $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file'; + + ### set up the useragent object + my $ua = LWP::UserAgent->new(); + $ua->timeout( $TIMEOUT ) if $TIMEOUT; + $ua->agent( $USER_AGENT ); + $ua->from( $FROM_EMAIL ); + $ua->env_proxy; + + my $res = $ua->mirror($uri, $to) or return; + + ### uptodate or fetched ok ### + if ( $res->code == 304 or $res->code == 200 ) { + return $to; + + } else { + return $self->_error(loc("Fetch failed! HTTP response: %1 %2 [%3]", + $res->code, HTTP::Status::status_message($res->code), + $res->status_line)); + } + +} + +### HTTP::Tiny fetching ### +sub _httptiny_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + my $use_list = { + 'HTTP::Tiny' => '0.008', + + }; + + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'httptiny'} = 1; + return; + } + + my $uri = $self->uri; + + my $http = HTTP::Tiny->new( ( $TIMEOUT ? ( timeout => $TIMEOUT ) : () ) ); + + my $rc = $http->mirror( $uri, $to ); + + unless ( $rc->{success} ) { + + return $self->_error(loc( "Fetch failed! HTTP response: %1 [%2]", + $rc->{status}, $rc->{reason} ) ); + + } + + return $to; + +} + +### HTTP::Lite fetching ### +sub _httplite_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### modules required to download with lwp ### + my $use_list = { + 'HTTP::Lite' => '2.2', + + }; + + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'httplite'} = 1; + return; + } + + my $uri = $self->uri; + my $retries = 0; + + RETRIES: while ( $retries++ < 5 ) { + + my $http = HTTP::Lite->new(); + # Naughty naughty but there isn't any accessor/setter + $http->{timeout} = $TIMEOUT if $TIMEOUT; + $http->http11_mode(1); + + my $fh = FileHandle->new; + + unless ( $fh->open($to,'>') ) { + return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + } + + $fh->autoflush(1); + + binmode $fh; + + my $rc = $http->request( $uri, sub { my ($self,$dref,$cbargs) = @_; local $\; print {$cbargs} $$dref }, $fh ); + + close $fh; + + if ( $rc == 301 || $rc == 302 ) { + my $loc; + HEADERS: for ($http->headers_array) { + /Location: (\S+)/ and $loc = $1, last HEADERS; + } + #$loc or last; # Think we should squeal here. + if ($loc =~ m!^/!) { + $uri =~ s{^(\w+?://[^/]+)/.*$}{$1}; + $uri .= $loc; + } + else { + $uri = $loc; + } + next RETRIES; + } + elsif ( $rc == 200 ) { + return $to; + } + else { + return $self->_error(loc("Fetch failed! HTTP response: %1 [%2]", + $rc, $http->status_message)); + } + + } # Loop for 5 retries. + + return $self->_error("Fetch failed! Gave up after 5 tries"); + +} + +### Simple IO::Socket::INET fetching ### +sub _iosock_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + my $use_list = { + 'IO::Socket::INET' => '0.0', + 'IO::Select' => '0.0', + }; + + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'iosock'} = 1; + return; + } + + my $sock = IO::Socket::INET->new( + PeerHost => $self->host, + ( $self->host =~ /:/ ? () : ( PeerPort => 80 ) ), + ); + + unless ( $sock ) { + return $self->_error(loc("Could not open socket to '%1', '%2'",$self->host,$!)); + } + + my $fh = FileHandle->new; + + # Check open() + + unless ( $fh->open($to,'>') ) { + return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + } + + $fh->autoflush(1); + binmode $fh; + + my $path = File::Spec::Unix->catfile( $self->path, $self->file ); + my $req = "GET $path HTTP/1.0\x0d\x0aHost: " . $self->host . "\x0d\x0a\x0d\x0a"; + $sock->send( $req ); + + my $select = IO::Select->new( $sock ); + + my $resp = ''; + my $normal = 0; + while ( $select->can_read( $TIMEOUT || 60 ) ) { + my $ret = $sock->sysread( $resp, 4096, length($resp) ); + if ( !defined $ret or $ret == 0 ) { + $select->remove( $sock ); + $normal++; + } + } + close $sock; + + unless ( $normal ) { + return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 ))); + } + + # Check the "response" + # Strip preceding blank lines apparently they are allowed (RFC 2616 4.1) + $resp =~ s/^(\x0d?\x0a)+//; + # Check it is an HTTP response + unless ( $resp =~ m!^HTTP/(\d+)\.(\d+)!i ) { + return $self->_error(loc("Did not get a HTTP response from '%1'",$self->host)); + } + + # Check for OK + my ($code) = $resp =~ m!^HTTP/\d+\.\d+\s+(\d+)!i; + unless ( $code eq '200' ) { + return $self->_error(loc("Got a '%1' from '%2' expected '200'",$code,$self->host)); + } + + { + local $\; + print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0]; + } + close $fh; + return $to; +} + +### Net::FTP fetching +sub _netftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### required modules ### + my $use_list = { 'Net::FTP' => 0 }; + + unless( can_load( modules => $use_list ) ) { + $METHOD_FAIL->{'netftp'} = 1; + return; + } + + ### make connection ### + my $ftp; + my @options = ($self->host); + push(@options, Timeout => $TIMEOUT) if $TIMEOUT; + unless( $ftp = Net::FTP->new( @options ) ) { + return $self->_error(loc("Ftp creation failed: %1",$@)); + } + + ### login ### + unless( $ftp->login( anonymous => $FROM_EMAIL ) ) { + return $self->_error(loc("Could not login to '%1'",$self->host)); + } + + ### set binary mode, just in case ### + $ftp->binary; + + ### create the remote path + ### remember remote paths are unix paths! [#11483] + my $remote = File::Spec::Unix->catfile( $self->path, $self->file ); + + ### fetch the file ### + my $target; + unless( $target = $ftp->get( $remote, $to ) ) { + return $self->_error(loc("Could not fetch '%1' from '%2'", + $remote, $self->host)); + } + + ### log out ### + $ftp->quit; + + return $target; + +} + +### /bin/wget fetch ### +sub _wget_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + my $wget; + ### see if we have a wget binary ### + unless( $wget = can_run('wget') ) { + $METHOD_FAIL->{'wget'} = 1; + return; + } + + ### no verboseness, thanks ### + my $cmd = [ $wget, '--quiet' ]; + + ### if a timeout is set, add it ### + push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; + + ### run passive if specified ### + push @$cmd, '--passive-ftp' if $FTP_PASSIVE; + + ### set the output document, add the uri ### + push @$cmd, '--output-document', $to, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; + + return $self->_error(loc( "Command failed: %1", $captured || '' )); + } + + return $to; +} + +### /bin/lftp fetch ### +sub _lftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a lftp binary ### + my $lftp; + unless( $lftp = can_run('lftp') ) { + $METHOD_FAIL->{'lftp'} = 1; + return; + } + + ### no verboseness, thanks ### + my $cmd = [ $lftp, '-f' ]; + + my $fh = File::Temp->new; + + my $str; + + ### if a timeout is set, add it ### + $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT; + + ### run passive if specified ### + $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE; + + ### set the output document, add the uri ### + ### quote the URI, because lftp supports certain shell + ### expansions, most notably & for backgrounding. + ### ' quote does nto work, must be " + $str .= q[get ']. $self->uri .q[' -o ]. $to . $/; + + if( $DEBUG ) { + my $pp_str = join ' ', split $/, $str; + print "# lftp command: $pp_str\n"; + } + + ### write straight to the file. + $fh->autoflush(1); + print $fh $str; + + ### the command needs to be 1 string to be executed + push @$cmd, $fh->filename; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; + + return $self->_error(loc( "Command failed: %1", $captured || '' )); + } + + return $to; +} + + + +### /bin/ftp fetch ### +sub _ftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a ftp binary ### + my $ftp; + unless( $ftp = can_run('ftp') ) { + $METHOD_FAIL->{'ftp'} = 1; + return; + } + + my $fh = FileHandle->new; + + local $SIG{CHLD} = 'IGNORE'; + + unless ($fh->open("$ftp -n", '|-')) { + return $self->_error(loc("%1 creation failed: %2", $ftp, $!)); + } + + my @dialog = ( + "lcd " . dirname($to), + "open " . $self->host, + "user anonymous $FROM_EMAIL", + "cd /", + "cd " . $self->path, + "binary", + "get " . $self->file . " " . $self->output_file, + "quit", + ); + + foreach (@dialog) { $fh->print($_, "\n") } + $fh->close or return; + + return $to; +} + +### lynx is stupid - it decompresses any .gz file it finds to be text +### use /bin/lynx to fetch files +sub _lynx_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a lynx binary ### + my $lynx; + unless ( $lynx = can_run('lynx') ){ + $METHOD_FAIL->{'lynx'} = 1; + return; + } + + unless( IPC::Cmd->can_capture_buffer ) { + $METHOD_FAIL->{'lynx'} = 1; + + return $self->_error(loc( + "Can not capture buffers. Can not use '%1' to fetch files", + 'lynx' )); + } + + ### check if the HTTP resource exists ### + if ($self->uri =~ /^https?:\/\//i) { + my $cmd = [ + $lynx, + '-head', + '-source', + "-auth=anonymous:$FROM_EMAIL", + ]; + + push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT; + + push @$cmd, $self->uri; + + ### shell out ### + my $head; + unless(run( command => $cmd, + buffer => \$head, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $head || '')); + } + + unless($head =~ /^HTTP\/\d+\.\d+ 200\b/) { + return $self->_error(loc("Command failed: %1", $head || '')); + } + } + + ### write to the output file ourselves, since lynx ass_u_mes to much + my $local = FileHandle->new( $to, 'w' ) + or return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + + ### dump to stdout ### + my $cmd = [ + $lynx, + '-source', + "-auth=anonymous:$FROM_EMAIL", + ]; + + push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT; + + ### DO NOT quote things for IPC::Run, it breaks stuff. + push @$cmd, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? $self->uri + # : QUOTE. $self->uri .QUOTE; + + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $captured || '')); + } + + ### print to local file ### + ### XXX on a 404 with a special error page, $captured will actually + ### hold the contents of that page, and make it *appear* like the + ### request was a success, when really it wasn't :( + ### there doesn't seem to be an option for lynx to change the exit + ### code based on a 4XX status or so. + ### the closest we can come is using --error_file and parsing that, + ### which is very unreliable ;( + $local->print( $captured ); + $local->close or return; + + return $to; +} + +### use /bin/ncftp to fetch files +sub _ncftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### we can only set passive mode in interactive sessions, so bail out + ### if $FTP_PASSIVE is set + return if $FTP_PASSIVE; + + ### see if we have a ncftp binary ### + my $ncftp; + unless( $ncftp = can_run('ncftp') ) { + $METHOD_FAIL->{'ncftp'} = 1; + return; + } + + my $cmd = [ + $ncftp, + '-V', # do not be verbose + '-p', $FROM_EMAIL, # email as password + $self->host, # hostname + dirname($to), # local dir for the file + # remote path to the file + ### DO NOT quote things for IPC::Run, it breaks stuff. + $IPC::Cmd::USE_IPC_RUN + ? File::Spec::Unix->catdir( $self->path, $self->file ) + : QUOTE. File::Spec::Unix->catdir( + $self->path, $self->file ) .QUOTE + + ]; + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $captured || '')); + } + + return $to; + +} + +### use /bin/curl to fetch files +sub _curl_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + my $curl; + unless ( $curl = can_run('curl') ) { + $METHOD_FAIL->{'curl'} = 1; + return; + } + + ### these long opts are self explanatory - I like that -jmb + my $cmd = [ $curl, '-q' ]; + + push(@$cmd, '--connect-timeout', $TIMEOUT) if $TIMEOUT; + + push(@$cmd, '--silent') unless $DEBUG; + + ### curl does the right thing with passive, regardless ### + if ($self->scheme eq 'ftp') { + push(@$cmd, '--user', "anonymous:$FROM_EMAIL"); + } + + ### curl doesn't follow 302 (temporarily moved) etc automatically + ### so we add --location to enable that. + push @$cmd, '--fail', '--location', '--output', $to, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + + return $self->_error(loc("Command failed: %1", $captured || '')); + } + + return $to; + +} + +### /usr/bin/fetch fetch! ### +sub _fetch_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a fetch binary ### + my $fetch; + unless( HAS_FETCH and $fetch = can_run('fetch') ) { + $METHOD_FAIL->{'fetch'} = 1; + return; + } + + ### no verboseness, thanks ### + my $cmd = [ $fetch, '-q' ]; + + ### if a timeout is set, add it ### + push(@$cmd, '-T', $TIMEOUT) if $TIMEOUT; + + ### run passive if specified ### + #push @$cmd, '-p' if $FTP_PASSIVE; + local $ENV{'FTP_PASSIVE_MODE'} = 1 if $FTP_PASSIVE; + + ### set the output document, add the uri ### + push @$cmd, '-o', $to, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; + + return $self->_error(loc( "Command failed: %1", $captured || '' )); + } + + return $to; +} + +### use File::Copy for fetching file:// urls ### +### +### See section 3.10 of RFC 1738 (http://www.faqs.org/rfcs/rfc1738.html) +### Also see wikipedia on file:// (http://en.wikipedia.org/wiki/File://) +### + +sub _file_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + + + ### prefix a / on unix systems with a file uri, since it would + ### look somewhat like this: + ### file:///home/kane/file + ### whereas windows file uris for 'c:\some\dir\file' might look like: + ### file:///C:/some/dir/file + ### file:///C|/some/dir/file + ### or for a network share '\\host\share\some\dir\file': + ### file:////host/share/some/dir/file + ### + ### VMS file uri's for 'DISK$USER:[MY.NOTES]NOTE123456.TXT' might look like: + ### file://vms.host.edu/disk$user/my/notes/note12345.txt + ### + + my $path = $self->path; + my $vol = $self->vol; + my $share = $self->share; + + my $remote; + if (!$share and $self->host) { + return $self->_error(loc( + "Currently %1 cannot handle hosts in %2 urls", + 'File::Fetch', 'file://' + )); + } + + if( $vol ) { + $path = File::Spec->catdir( split /\//, $path ); + $remote = File::Spec->catpath( $vol, $path, $self->file); + + } elsif( $share ) { + ### win32 specific, and a share name, so we wont bother with File::Spec + $path =~ s|/+|\\|g; + $remote = "\\\\".$self->host."\\$share\\$path"; + + } else { + ### File::Spec on VMS can not currently handle UNIX syntax. + my $file_class = ON_VMS + ? 'File::Spec::Unix' + : 'File::Spec'; + + $remote = $file_class->catfile( $path, $self->file ); + } + + ### File::Copy is littered with 'die' statements :( ### + my $rv = eval { File::Copy::copy( $remote, $to ) }; + + ### something went wrong ### + if( !$rv or $@ ) { + return $self->_error(loc("Could not copy '%1' to '%2': %3 %4", + $remote, $to, $!, $@)); + } + + return $to; +} + +### use /usr/bin/rsync to fetch files +sub _rsync_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + my $rsync; + unless ( $rsync = can_run('rsync') ) { + $METHOD_FAIL->{'rsync'} = 1; + return; + } + + my $cmd = [ $rsync ]; + + ### XXX: rsync has no I/O timeouts at all, by default + push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; + + push(@$cmd, '--quiet') unless $DEBUG; + + ### DO NOT quote things for IPC::Run, it breaks stuff. + push @$cmd, $self->uri, $to; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + + return $self->_error(loc("Command %1 failed: %2", + "@$cmd" || '', $captured || '')); + } + + return $to; + +} + +################################# +# +# Error code +# +################################# + +=pod + +=head2 $ff->error([BOOL]) + +Returns the last encountered error as string. +Pass it a true value to get the C<Carp::longmess()> output instead. + +=cut + +### error handling the way Archive::Extract does it +sub _error { + my $self = shift; + my $error = shift; + + $self->_error_msg( $error ); + $self->_error_msg_long( Carp::longmess($error) ); + + if( $WARN ) { + carp $DEBUG ? $self->_error_msg_long : $self->_error_msg; + } + + return; +} + +sub error { + my $self = shift; + return shift() ? $self->_error_msg_long : $self->_error_msg; +} + + +1; + +=pod + +=head1 HOW IT WORKS + +File::Fetch is able to fetch a variety of uris, by using several +external programs and modules. + +Below is a mapping of what utilities will be used in what order +for what schemes, if available: + + file => LWP, lftp, file + http => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock + ftp => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp + rsync => rsync + +If you'd like to disable the use of one or more of these utilities +and/or modules, see the C<$BLACKLIST> variable further down. + +If a utility or module isn't available, it will be marked in a cache +(see the C<$METHOD_FAIL> variable further down), so it will not be +tried again. The C<fetch> method will only fail when all options are +exhausted, and it was not able to retrieve the file. + +The C<fetch> utility is available on FreeBSD. NetBSD and Dragonfly BSD +may also have it from C<pkgsrc>. We only check for C<fetch> on those +three platforms. + +C<iosock> is a very limited L<IO::Socket::INET> based mechanism for +retrieving C<http> schemed urls. It doesn't follow redirects for instance. + +A special note about fetching files from an ftp uri: + +By default, all ftp connections are done in passive mode. To change +that, see the C<$FTP_PASSIVE> variable further down. + +Furthermore, ftp uris only support anonymous connections, so no +named user/password pair can be passed along. + +C</bin/ftp> is blacklisted by default; see the C<$BLACKLIST> variable +further down. + +=head1 GLOBAL VARIABLES + +The behaviour of File::Fetch can be altered by changing the following +global variables: + +=head2 $File::Fetch::FROM_EMAIL + +This is the email address that will be sent as your anonymous ftp +password. + +Default is C<File-Fetch@xxxxxxxxxxx>. + +=head2 $File::Fetch::USER_AGENT + +This is the useragent as C<LWP> will report it. + +Default is C<File::Fetch/$VERSION>. + +=head2 $File::Fetch::FTP_PASSIVE + +This variable controls whether the environment variable C<FTP_PASSIVE> +and any passive switches to commandline tools will be set to true. + +Default value is 1. + +Note: When $FTP_PASSIVE is true, C<ncftp> will not be used to fetch +files, since passive mode can only be set interactively for this binary + +=head2 $File::Fetch::TIMEOUT + +When set, controls the network timeout (counted in seconds). + +Default value is 0. + +=head2 $File::Fetch::WARN + +This variable controls whether errors encountered internally by +C<File::Fetch> should be C<carp>'d or not. + +Set to false to silence warnings. Inspect the output of the C<error()> +method manually to see what went wrong. + +Defaults to C<true>. + +=head2 $File::Fetch::DEBUG + +This enables debugging output when calling commandline utilities to +fetch files. +This also enables C<Carp::longmess> errors, instead of the regular +C<carp> errors. + +Good for tracking down why things don't work with your particular +setup. + +Default is 0. + +=head2 $File::Fetch::BLACKLIST + +This is an array ref holding blacklisted modules/utilities for fetching +files with. + +To disallow the use of, for example, C<LWP> and C<Net::FTP>, you could +set $File::Fetch::BLACKLIST to: + + $File::Fetch::BLACKLIST = [qw|lwp netftp|] + +The default blacklist is [qw|ftp|], as C</bin/ftp> is rather unreliable. + +See the note on C<MAPPING> below. + +=head2 $File::Fetch::METHOD_FAIL + +This is a hashref registering what modules/utilities were known to fail +for fetching files (mostly because they weren't installed). + +You can reset this cache by assigning an empty hashref to it, or +individually remove keys. + +See the note on C<MAPPING> below. + +=head1 MAPPING + + +Here's a quick mapping for the utilities/modules, and their names for +the $BLACKLIST, $METHOD_FAIL and other internal functions. + + LWP => lwp + HTTP::Lite => httplite + HTTP::Tiny => httptiny + Net::FTP => netftp + wget => wget + lynx => lynx + ncftp => ncftp + ftp => ftp + curl => curl + rsync => rsync + lftp => lftp + fetch => fetch + IO::Socket => iosock + +=head1 FREQUENTLY ASKED QUESTIONS + +=head2 So how do I use a proxy with File::Fetch? + +C<File::Fetch> currently only supports proxies with LWP::UserAgent. +You will need to set your environment variables accordingly. For +example, to use an ftp proxy: + + $ENV{ftp_proxy} = 'foo.com'; + +Refer to the LWP::UserAgent manpage for more details. + +=head2 I used 'lynx' to fetch a file, but its contents is all wrong! + +C<lynx> can only fetch remote files by dumping its contents to C<STDOUT>, +which we in turn capture. If that content is a 'custom' error file +(like, say, a C<404 handler>), you will get that contents instead. + +Sadly, C<lynx> doesn't support any options to return a different exit +code on non-C<200 OK> status, giving us no way to tell the difference +between a 'successful' fetch and a custom error page. + +Therefor, we recommend to only use C<lynx> as a last resort. This is +why it is at the back of our list of methods to try as well. + +=head2 Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do? + +C<File::Fetch> is relatively smart about things. When trying to write +a file to disk, it removes the C<query parameters> (see the +C<output_file> method for details) from the file name before creating +it. In most cases this suffices. + +If you have any other characters you need to escape, please install +the C<URI::Escape> module from CPAN, and pre-encode your URI before +passing it to C<File::Fetch>. You can read about the details of URIs +and URI encoding here: + + http://www.faqs.org/rfcs/rfc2396.html + +=head1 TODO + +=over 4 + +=item Implement $PREFER_BIN + +To indicate to rather use commandline tools than modules + +=back + +=head1 BUG REPORTS + +Please report bugs or other issues to E<lt>bug-file-fetch@xxxxxxxxxxx<gt>. + +=head1 AUTHOR + +This module by Jos Boumans E<lt>kane@xxxxxxxxx<gt>. + +=head1 COPYRIGHT + +This library is free software; you may redistribute and/or modify it +under the same terms as Perl itself. + + +=cut + +# Local variables: +# c-indentation-style: bsd +# c-basic-offset: 4 +# indent-tabs-mode: nil +# End: +# vim: expandtab shiftwidth=4: + + + + diff --git a/File-Fetch-0.38/blib/lib/auto/File/Fetch/.exists b/File-Fetch-0.38/blib/lib/auto/File/Fetch/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.38/blib/man1/.exists b/File-Fetch-0.38/blib/man1/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.38/blib/man3/.exists b/File-Fetch-0.38/blib/man3/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.38/blib/man3/File::Fetch.3pm b/File-Fetch-0.38/blib/man3/File::Fetch.3pm new file mode 100644 index 0000000..e13072f --- /dev/null +++ b/File-Fetch-0.38/blib/man3/File::Fetch.3pm @@ -0,0 +1,456 @@ +.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.20) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "File::Fetch 3" +.TH File::Fetch 3 "2013-01-10" "perl v5.16.3" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +File::Fetch \- A generic file fetching mechanism +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.Vb 1 +\& use File::Fetch; +\& +\& ### build a File::Fetch object ### +\& my $ff = File::Fetch\->new(uri => \*(Aqhttp://some.where.com/dir/a.txt\*(Aq); +\& +\& ### fetch the uri to cwd() ### +\& my $where = $ff\->fetch() or die $ff\->error; +\& +\& ### fetch the uri to /tmp ### +\& my $where = $ff\->fetch( to => \*(Aq/tmp\*(Aq ); +\& +\& ### parsed bits from the uri ### +\& $ff\->uri; +\& $ff\->scheme; +\& $ff\->host; +\& $ff\->path; +\& $ff\->file; +.Ve +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +File::Fetch is a generic file fetching mechanism. +.PP +It allows you to fetch any file pointed to by a \f(CW\*(C`ftp\*(C'\fR, \f(CW\*(C`http\*(C'\fR, +\&\f(CW\*(C`file\*(C'\fR, or \f(CW\*(C`rsync\*(C'\fR uri by a number of different means. +.PP +See the \f(CW\*(C`HOW IT WORKS\*(C'\fR section further down for details. +.SH "ACCESSORS" +.IX Header "ACCESSORS" +A \f(CW\*(C`File::Fetch\*(C'\fR object has the following accessors +.ie n .IP "$ff\->uri" 4 +.el .IP "\f(CW$ff\fR\->uri" 4 +.IX Item "$ff->uri" +The uri you passed to the constructor +.ie n .IP "$ff\->scheme" 4 +.el .IP "\f(CW$ff\fR\->scheme" 4 +.IX Item "$ff->scheme" +The scheme from the uri (like 'file', 'http', etc) +.ie n .IP "$ff\->host" 4 +.el .IP "\f(CW$ff\fR\->host" 4 +.IX Item "$ff->host" +The hostname in the uri. Will be empty if host was originally +\&'localhost' for a 'file://' url. +.ie n .IP "$ff\->vol" 4 +.el .IP "\f(CW$ff\fR\->vol" 4 +.IX Item "$ff->vol" +On operating systems with the concept of a volume the second element +of a file:// is considered to the be volume specification for the file. +Thus on Win32 this routine returns the volume, on other operating +systems this returns nothing. +.Sp +On Windows this value may be empty if the uri is to a network share, in +which case the 'share' property will be defined. Additionally, volume +specifications that use '|' as ':' will be converted on read to use ':'. +.Sp +On \s-1VMS\s0, which has a volume concept, this field will be empty because \s-1VMS\s0 +file specifications are converted to absolute \s-1UNIX\s0 format and the volume +information is transparently included. +.ie n .IP "$ff\->share" 4 +.el .IP "\f(CW$ff\fR\->share" 4 +.IX Item "$ff->share" +On systems with the concept of a network share (currently only Windows) returns +the sharename from a file://// url. On other operating systems returns empty. +.ie n .IP "$ff\->path" 4 +.el .IP "\f(CW$ff\fR\->path" 4 +.IX Item "$ff->path" +The path from the uri, will be at least a single '/'. +.ie n .IP "$ff\->file" 4 +.el .IP "\f(CW$ff\fR\->file" 4 +.IX Item "$ff->file" +The name of the remote file. For the local file name, the +result of \f(CW$ff\fR\->output_file will be used. +.ie n .IP "$ff\->file_default" 4 +.el .IP "\f(CW$ff\fR\->file_default" 4 +.IX Item "$ff->file_default" +The name of the default local file, that \f(CW$ff\fR\->output_file falls back to if +it would otherwise return no filename. For example when fetching a \s-1URI\s0 like +http://www.abc.net.au/ the contents retrieved may be from a remote file called +\&'index.html'. The default value of this attribute is literally 'file_default'. +.ie n .IP "$ff\->output_file" 4 +.el .IP "\f(CW$ff\fR\->output_file" 4 +.IX Item "$ff->output_file" +The name of the output file. This is the same as \f(CW$ff\fR\->file, +but any query parameters are stripped off. For example: +.Sp +.Vb 1 +\& http://example.com/index.html?x=y +.Ve +.Sp +would make the output file be \f(CW\*(C`index.html\*(C'\fR rather than +\&\f(CW\*(C`index.html?x=y\*(C'\fR. +.SH "METHODS" +.IX Header "METHODS" +.ie n .SS "$ff = File::Fetch\->new( uri => 'http://some.where.com/dir/file.txt' );" +.el .SS "\f(CW$ff\fP = File::Fetch\->new( uri => 'http://some.where.com/dir/file.txt' );" +.IX Subsection "$ff = File::Fetch->new( uri => 'http://some.where.com/dir/file.txt' );" +Parses the uri and creates a corresponding File::Fetch::Item object, +that is ready to be \f(CW\*(C`fetch\*(C'\fRed and returns it. +.PP +Returns false on failure. +.ie n .SS "$where = $ff\->fetch( [to => /my/output/dir/ | \e$scalar] )" +.el .SS "\f(CW$where\fP = \f(CW$ff\fP\->fetch( [to => /my/output/dir/ | \e$scalar] )" +.IX Subsection "$where = $ff->fetch( [to => /my/output/dir/ | $scalar] )" +Fetches the file you requested and returns the full path to the file. +.PP +By default it writes to \f(CW\*(C`cwd()\*(C'\fR, but you can override that by specifying +the \f(CW\*(C`to\*(C'\fR argument: +.PP +.Vb 2 +\& ### file fetch to /tmp, full path to the file in $where +\& $where = $ff\->fetch( to => \*(Aq/tmp\*(Aq ); +\& +\& ### file slurped into $scalar, full path to the file in $where +\& ### file is downloaded to a temp directory and cleaned up at exit time +\& $where = $ff\->fetch( to => \e$scalar ); +.Ve +.PP +Returns the full path to the downloaded file on success, and false +on failure. +.ie n .SS "$ff\->error([\s-1BOOL\s0])" +.el .SS "\f(CW$ff\fP\->error([\s-1BOOL\s0])" +.IX Subsection "$ff->error([BOOL])" +Returns the last encountered error as string. +Pass it a true value to get the \f(CW\*(C`Carp::longmess()\*(C'\fR output instead. +.SH "HOW IT WORKS" +.IX Header "HOW IT WORKS" +File::Fetch is able to fetch a variety of uris, by using several +external programs and modules. +.PP +Below is a mapping of what utilities will be used in what order +for what schemes, if available: +.PP +.Vb 4 +\& file => LWP, lftp, file +\& http => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock +\& ftp => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp +\& rsync => rsync +.Ve +.PP +If you'd like to disable the use of one or more of these utilities +and/or modules, see the \f(CW$BLACKLIST\fR variable further down. +.PP +If a utility or module isn't available, it will be marked in a cache +(see the \f(CW$METHOD_FAIL\fR variable further down), so it will not be +tried again. The \f(CW\*(C`fetch\*(C'\fR method will only fail when all options are +exhausted, and it was not able to retrieve the file. +.PP +The \f(CW\*(C`fetch\*(C'\fR utility is available on FreeBSD. NetBSD and Dragonfly \s-1BSD\s0 +may also have it from \f(CW\*(C`pkgsrc\*(C'\fR. We only check for \f(CW\*(C`fetch\*(C'\fR on those +three platforms. +.PP +\&\f(CW\*(C`iosock\*(C'\fR is a very limited IO::Socket::INET based mechanism for +retrieving \f(CW\*(C`http\*(C'\fR schemed urls. It doesn't follow redirects for instance. +.PP +A special note about fetching files from an ftp uri: +.PP +By default, all ftp connections are done in passive mode. To change +that, see the \f(CW$FTP_PASSIVE\fR variable further down. +.PP +Furthermore, ftp uris only support anonymous connections, so no +named user/password pair can be passed along. +.PP +\&\f(CW\*(C`/bin/ftp\*(C'\fR is blacklisted by default; see the \f(CW$BLACKLIST\fR variable +further down. +.SH "GLOBAL VARIABLES" +.IX Header "GLOBAL VARIABLES" +The behaviour of File::Fetch can be altered by changing the following +global variables: +.ie n .SS "$File::Fetch::FROM_EMAIL" +.el .SS "\f(CW$File::Fetch::FROM_EMAIL\fP" +.IX Subsection "$File::Fetch::FROM_EMAIL" +This is the email address that will be sent as your anonymous ftp +password. +.PP +Default is \f(CW\*(C`File\-Fetch@xxxxxxxxxxx\*(C'\fR. +.ie n .SS "$File::Fetch::USER_AGENT" +.el .SS "\f(CW$File::Fetch::USER_AGENT\fP" +.IX Subsection "$File::Fetch::USER_AGENT" +This is the useragent as \f(CW\*(C`LWP\*(C'\fR will report it. +.PP +Default is \f(CW\*(C`File::Fetch/$VERSION\*(C'\fR. +.ie n .SS "$File::Fetch::FTP_PASSIVE" +.el .SS "\f(CW$File::Fetch::FTP_PASSIVE\fP" +.IX Subsection "$File::Fetch::FTP_PASSIVE" +This variable controls whether the environment variable \f(CW\*(C`FTP_PASSIVE\*(C'\fR +and any passive switches to commandline tools will be set to true. +.PP +Default value is 1. +.PP +Note: When \f(CW$FTP_PASSIVE\fR is true, \f(CW\*(C`ncftp\*(C'\fR will not be used to fetch +files, since passive mode can only be set interactively for this binary +.ie n .SS "$File::Fetch::TIMEOUT" +.el .SS "\f(CW$File::Fetch::TIMEOUT\fP" +.IX Subsection "$File::Fetch::TIMEOUT" +When set, controls the network timeout (counted in seconds). +.PP +Default value is 0. +.ie n .SS "$File::Fetch::WARN" +.el .SS "\f(CW$File::Fetch::WARN\fP" +.IX Subsection "$File::Fetch::WARN" +This variable controls whether errors encountered internally by +\&\f(CW\*(C`File::Fetch\*(C'\fR should be \f(CW\*(C`carp\*(C'\fR'd or not. +.PP +Set to false to silence warnings. Inspect the output of the \f(CW\*(C`error()\*(C'\fR +method manually to see what went wrong. +.PP +Defaults to \f(CW\*(C`true\*(C'\fR. +.ie n .SS "$File::Fetch::DEBUG" +.el .SS "\f(CW$File::Fetch::DEBUG\fP" +.IX Subsection "$File::Fetch::DEBUG" +This enables debugging output when calling commandline utilities to +fetch files. +This also enables \f(CW\*(C`Carp::longmess\*(C'\fR errors, instead of the regular +\&\f(CW\*(C`carp\*(C'\fR errors. +.PP +Good for tracking down why things don't work with your particular +setup. +.PP +Default is 0. +.ie n .SS "$File::Fetch::BLACKLIST" +.el .SS "\f(CW$File::Fetch::BLACKLIST\fP" +.IX Subsection "$File::Fetch::BLACKLIST" +This is an array ref holding blacklisted modules/utilities for fetching +files with. +.PP +To disallow the use of, for example, \f(CW\*(C`LWP\*(C'\fR and \f(CW\*(C`Net::FTP\*(C'\fR, you could +set \f(CW$File::Fetch::BLACKLIST\fR to: +.PP +.Vb 1 +\& $File::Fetch::BLACKLIST = [qw|lwp netftp|] +.Ve +.PP +The default blacklist is [qw|ftp|], as \f(CW\*(C`/bin/ftp\*(C'\fR is rather unreliable. +.PP +See the note on \f(CW\*(C`MAPPING\*(C'\fR below. +.ie n .SS "$File::Fetch::METHOD_FAIL" +.el .SS "\f(CW$File::Fetch::METHOD_FAIL\fP" +.IX Subsection "$File::Fetch::METHOD_FAIL" +This is a hashref registering what modules/utilities were known to fail +for fetching files (mostly because they weren't installed). +.PP +You can reset this cache by assigning an empty hashref to it, or +individually remove keys. +.PP +See the note on \f(CW\*(C`MAPPING\*(C'\fR below. +.SH "MAPPING" +.IX Header "MAPPING" +Here's a quick mapping for the utilities/modules, and their names for +the \f(CW$BLACKLIST\fR, \f(CW$METHOD_FAIL\fR and other internal functions. +.PP +.Vb 10 +\& LWP => lwp +\& HTTP::Lite => httplite +\& HTTP::Tiny => httptiny +\& Net::FTP => netftp +\& wget => wget +\& lynx => lynx +\& ncftp => ncftp +\& ftp => ftp +\& curl => curl +\& rsync => rsync +\& lftp => lftp +\& fetch => fetch +\& IO::Socket => iosock +.Ve +.SH "FREQUENTLY ASKED QUESTIONS" +.IX Header "FREQUENTLY ASKED QUESTIONS" +.SS "So how do I use a proxy with File::Fetch?" +.IX Subsection "So how do I use a proxy with File::Fetch?" +\&\f(CW\*(C`File::Fetch\*(C'\fR currently only supports proxies with LWP::UserAgent. +You will need to set your environment variables accordingly. For +example, to use an ftp proxy: +.PP +.Vb 1 +\& $ENV{ftp_proxy} = \*(Aqfoo.com\*(Aq; +.Ve +.PP +Refer to the LWP::UserAgent manpage for more details. +.SS "I used 'lynx' to fetch a file, but its contents is all wrong!" +.IX Subsection "I used 'lynx' to fetch a file, but its contents is all wrong!" +\&\f(CW\*(C`lynx\*(C'\fR can only fetch remote files by dumping its contents to \f(CW\*(C`STDOUT\*(C'\fR, +which we in turn capture. If that content is a 'custom' error file +(like, say, a \f(CW\*(C`404 handler\*(C'\fR), you will get that contents instead. +.PP +Sadly, \f(CW\*(C`lynx\*(C'\fR doesn't support any options to return a different exit +code on non\-\f(CW\*(C`200 OK\*(C'\fR status, giving us no way to tell the difference +between a 'successful' fetch and a custom error page. +.PP +Therefor, we recommend to only use \f(CW\*(C`lynx\*(C'\fR as a last resort. This is +why it is at the back of our list of methods to try as well. +.SS "Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do?" +.IX Subsection "Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do?" +\&\f(CW\*(C`File::Fetch\*(C'\fR is relatively smart about things. When trying to write +a file to disk, it removes the \f(CW\*(C`query parameters\*(C'\fR (see the +\&\f(CW\*(C`output_file\*(C'\fR method for details) from the file name before creating +it. In most cases this suffices. +.PP +If you have any other characters you need to escape, please install +the \f(CW\*(C`URI::Escape\*(C'\fR module from \s-1CPAN\s0, and pre-encode your \s-1URI\s0 before +passing it to \f(CW\*(C`File::Fetch\*(C'\fR. You can read about the details of URIs +and \s-1URI\s0 encoding here: +.PP +.Vb 1 +\& http://www.faqs.org/rfcs/rfc2396.html +.Ve +.SH "TODO" +.IX Header "TODO" +.ie n .IP "Implement $PREFER_BIN" 4 +.el .IP "Implement \f(CW$PREFER_BIN\fR" 4 +.IX Item "Implement $PREFER_BIN" +To indicate to rather use commandline tools than modules +.SH "BUG REPORTS" +.IX Header "BUG REPORTS" +Please report bugs or other issues to <bug\-file\-fetch@xxxxxxxxxxx<gt>. +.SH "AUTHOR" +.IX Header "AUTHOR" +This module by Jos Boumans <kane@xxxxxxxx>. +.SH "COPYRIGHT" +.IX Header "COPYRIGHT" +This library is free software; you may redistribute and/or modify it +under the same terms as Perl itself. diff --git a/File-Fetch-0.38/blib/script/.exists b/File-Fetch-0.38/blib/script/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.38/debugfiles.list b/File-Fetch-0.38/debugfiles.list new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.38/debuglinks.list b/File-Fetch-0.38/debuglinks.list new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.38/debugsources.list b/File-Fetch-0.38/debugsources.list new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.38/lib/File/Fetch.pm b/File-Fetch-0.38/lib/File/Fetch.pm new file mode 100644 index 0000000..37f7bc6 --- /dev/null +++ b/File-Fetch-0.38/lib/File/Fetch.pm @@ -0,0 +1,1658 @@ +package File::Fetch; + +use strict; +use FileHandle; +use File::Temp; +use File::Copy; +use File::Spec; +use File::Spec::Unix; +use File::Basename qw[dirname]; + +use Cwd qw[cwd]; +use Carp qw[carp]; +use IPC::Cmd qw[can_run run QUOTE]; +use File::Path qw[mkpath]; +use File::Temp qw[tempdir]; +use Params::Check qw[check]; +use Module::Load::Conditional qw[can_load]; +use Locale::Maketext::Simple Style => 'gettext'; + +use vars qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT + $BLACKLIST $METHOD_FAIL $VERSION $METHODS + $FTP_PASSIVE $TIMEOUT $DEBUG $WARN + ]; + +$VERSION = '0.38'; +$VERSION = eval $VERSION; # avoid warnings with development releases +$PREFER_BIN = 0; # XXX TODO implement +$FROM_EMAIL = 'File-Fetch@xxxxxxxxxxx'; +$USER_AGENT = "File::Fetch/$VERSION"; +$BLACKLIST = [qw|ftp|]; +$METHOD_FAIL = { }; +$FTP_PASSIVE = 1; +$TIMEOUT = 0; +$DEBUG = 0; +$WARN = 1; + +### methods available to fetch the file depending on the scheme +$METHODS = { + http => [ qw|lwp httptiny wget curl lftp fetch httplite lynx iosock| ], + ftp => [ qw|lwp netftp wget curl lftp fetch ncftp ftp| ], + file => [ qw|lwp lftp file| ], + rsync => [ qw|rsync| ] +}; + +### silly warnings ### +local $Params::Check::VERBOSE = 1; +local $Params::Check::VERBOSE = 1; +local $Module::Load::Conditional::VERBOSE = 0; +local $Module::Load::Conditional::VERBOSE = 0; + +### see what OS we are on, important for file:// uris ### +use constant ON_WIN => ($^O eq 'MSWin32'); +use constant ON_VMS => ($^O eq 'VMS'); +use constant ON_UNIX => (!ON_WIN); +use constant HAS_VOL => (ON_WIN); +use constant HAS_SHARE => (ON_WIN); +use constant HAS_FETCH => ( $^O =~ m!^(freebsd|netbsd|dragonfly)$! ); + +=pod + +=head1 NAME + +File::Fetch - A generic file fetching mechanism + +=head1 SYNOPSIS + + use File::Fetch; + + ### build a File::Fetch object ### + my $ff = File::Fetch->new(uri => 'http://some.where.com/dir/a.txt'); + + ### fetch the uri to cwd() ### + my $where = $ff->fetch() or die $ff->error; + + ### fetch the uri to /tmp ### + my $where = $ff->fetch( to => '/tmp' ); + + ### parsed bits from the uri ### + $ff->uri; + $ff->scheme; + $ff->host; + $ff->path; + $ff->file; + +=head1 DESCRIPTION + +File::Fetch is a generic file fetching mechanism. + +It allows you to fetch any file pointed to by a C<ftp>, C<http>, +C<file>, or C<rsync> uri by a number of different means. + +See the C<HOW IT WORKS> section further down for details. + +=head1 ACCESSORS + +A C<File::Fetch> object has the following accessors + +=over 4 + +=item $ff->uri + +The uri you passed to the constructor + +=item $ff->scheme + +The scheme from the uri (like 'file', 'http', etc) + +=item $ff->host + +The hostname in the uri. Will be empty if host was originally +'localhost' for a 'file://' url. + +=item $ff->vol + +On operating systems with the concept of a volume the second element +of a file:// is considered to the be volume specification for the file. +Thus on Win32 this routine returns the volume, on other operating +systems this returns nothing. + +On Windows this value may be empty if the uri is to a network share, in +which case the 'share' property will be defined. Additionally, volume +specifications that use '|' as ':' will be converted on read to use ':'. + +On VMS, which has a volume concept, this field will be empty because VMS +file specifications are converted to absolute UNIX format and the volume +information is transparently included. + +=item $ff->share + +On systems with the concept of a network share (currently only Windows) returns +the sharename from a file://// url. On other operating systems returns empty. + +=item $ff->path + +The path from the uri, will be at least a single '/'. + +=item $ff->file + +The name of the remote file. For the local file name, the +result of $ff->output_file will be used. + +=item $ff->file_default + +The name of the default local file, that $ff->output_file falls back to if +it would otherwise return no filename. For example when fetching a URI like +http://www.abc.net.au/ the contents retrieved may be from a remote file called +'index.html'. The default value of this attribute is literally 'file_default'. + +=cut + + +########################## +### Object & Accessors ### +########################## + +{ + ### template for autogenerated accessors ### + my $Tmpl = { + scheme => { default => 'http' }, + host => { default => 'localhost' }, + path => { default => '/' }, + file => { required => 1 }, + uri => { required => 1 }, + vol => { default => '' }, # windows for file:// uris + share => { default => '' }, # windows for file:// uris + file_default => { default => 'file_default' }, + tempdir_root => { required => 1 }, # Should be lazy-set at ->new() + _error_msg => { no_override => 1 }, + _error_msg_long => { no_override => 1 }, + }; + + for my $method ( keys %$Tmpl ) { + no strict 'refs'; + *$method = sub { + my $self = shift; + $self->{$method} = $_[0] if @_; + return $self->{$method}; + } + } + + sub _create { + my $class = shift; + my %hash = @_; + + my $args = check( $Tmpl, \%hash ) or return; + + bless $args, $class; + + if( lc($args->scheme) ne 'file' and not $args->host ) { + return $class->_error(loc( + "Hostname required when fetching from '%1'",$args->scheme)); + } + + for (qw[path]) { + unless( $args->$_() ) { # 5.5.x needs the () + return $class->_error(loc("No '%1' specified",$_)); + } + } + + return $args; + } +} + +=item $ff->output_file + +The name of the output file. This is the same as $ff->file, +but any query parameters are stripped off. For example: + + http://example.com/index.html?x=y + +would make the output file be C<index.html> rather than +C<index.html?x=y>. + +=back + +=cut + +sub output_file { + my $self = shift; + my $file = $self->file; + + $file =~ s/\?.*$//g; + + $file ||= $self->file_default; + + return $file; +} + +### XXX do this or just point to URI::Escape? +# =head2 $esc_uri = $ff->escaped_uri +# +# =cut +# +# ### most of this is stolen straight from URI::escape +# { ### Build a char->hex map +# my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255; +# +# sub escaped_uri { +# my $self = shift; +# my $uri = $self->uri; +# +# ### Default unsafe characters. RFC 2732 ^(uric - reserved) +# $uri =~ s/([^A-Za-z0-9\-_.!~*'()])/ +# $escapes{$1} || $self->_fail_hi($1)/ge; +# +# return $uri; +# } +# +# sub _fail_hi { +# my $self = shift; +# my $char = shift; +# +# $self->_error(loc( +# "Can't escape '%1', try using the '%2' module instead", +# sprintf("\\x{%04X}", ord($char)), 'URI::Escape' +# )); +# } +# +# sub output_file { +# +# } +# +# +# } + +=head1 METHODS + +=head2 $ff = File::Fetch->new( uri => 'http://some.where.com/dir/file.txt' ); + +Parses the uri and creates a corresponding File::Fetch::Item object, +that is ready to be C<fetch>ed and returns it. + +Returns false on failure. + +=cut + +sub new { + my $class = shift; + my %hash = @_; + + my ($uri, $file_default, $tempdir_root); + my $tmpl = { + uri => { required => 1, store => \$uri }, + file_default => { required => 0, store => \$file_default }, + tempdir_root => { required => 0, store => \$tempdir_root }, + }; + + check( $tmpl, \%hash ) or return; + + ### parse the uri to usable parts ### + my $href = $class->_parse_uri( $uri ) or return; + + $href->{file_default} = $file_default if $file_default; + $href->{tempdir_root} = File::Spec->rel2abs( $tempdir_root ) if $tempdir_root; + $href->{tempdir_root} = File::Spec->rel2abs( Cwd::cwd ) if not $href->{tempdir_root}; + + ### make it into a FFI object ### + my $ff = $class->_create( %$href ) or return; + + + ### return the object ### + return $ff; +} + +### parses an uri to a hash structure: +### +### $class->_parse_uri( 'ftp://ftp.cpan.org/pub/mirror/index.txt' ) +### +### becomes: +### +### $href = { +### scheme => 'ftp', +### host => 'ftp.cpan.org', +### path => '/pub/mirror', +### file => 'index.html' +### }; +### +### In the case of file:// urls there maybe be additional fields +### +### For systems with volume specifications such as Win32 there will be +### a volume specifier provided in the 'vol' field. +### +### 'vol' => 'volumename' +### +### For windows file shares there may be a 'share' key specified +### +### 'share' => 'sharename' +### +### Note that the rules of what a file:// url means vary by the operating system +### of the host being addressed. Thus file:///d|/foo/bar.txt means the obvious +### 'D:\foo\bar.txt' on windows, but on unix it means '/d|/foo/bar.txt' and +### not '/foo/bar.txt' +### +### Similarly if the host interpreting the url is VMS then +### file:///disk$user/my/notes/note12345.txt' means +### 'DISK$USER:[MY.NOTES]NOTE123456.TXT' but will be returned the same as +### if it is unix where it means /disk$user/my/notes/note12345.txt'. +### Except for some cases in the File::Spec methods, Perl on VMS will generally +### handle UNIX format file specifications. +### +### This means it is impossible to serve certain file:// urls on certain systems. +### +### Thus are the problems with a protocol-less specification. :-( +### + +sub _parse_uri { + my $self = shift; + my $uri = shift or return; + + my $href = { uri => $uri }; + + ### find the scheme ### + $uri =~ s|^(\w+)://||; + $href->{scheme} = $1; + + ### See rfc 1738 section 3.10 + ### http://www.faqs.org/rfcs/rfc1738.html + ### And wikipedia for more on windows file:// urls + ### http://en.wikipedia.org/wiki/File:// + if( $href->{scheme} eq 'file' ) { + + my @parts = split '/',$uri; + + ### file://hostname/... + ### file://hostname/... + ### normalize file://localhost with file:/// + $href->{host} = $parts[0] || ''; + + ### index in @parts where the path components begin; + my $index = 1; + + ### file:////hostname/sharename/blah.txt + if ( HAS_SHARE and not length $parts[0] and not length $parts[1] ) { + + $href->{host} = $parts[2] || ''; # avoid warnings + $href->{share} = $parts[3] || ''; # avoid warnings + + $index = 4 # index after the share + + ### file:///D|/blah.txt + ### file:///D:/blah.txt + } elsif (HAS_VOL) { + + ### this code comes from dmq's patch, but: + ### XXX if volume is empty, wouldn't that be an error? --kane + ### if so, our file://localhost test needs to be fixed as wel + $href->{vol} = $parts[1] || ''; + + ### correct D| style colume descriptors + $href->{vol} =~ s/\A([A-Z])\|\z/$1:/i if ON_WIN; + + $index = 2; # index after the volume + } + + ### rebuild the path from the leftover parts; + $href->{path} = join '/', '', splice( @parts, $index, $#parts ); + + } else { + ### using anything but qw() in hash slices may produce warnings + ### in older perls :-( + @{$href}{ qw(host path) } = $uri =~ m|([^/]*)(/.*)$|s; + } + + ### split the path into file + dir ### + { my @parts = File::Spec::Unix->splitpath( delete $href->{path} ); + $href->{path} = $parts[1]; + $href->{file} = $parts[2]; + } + + ### host will be empty if the target was 'localhost' and the + ### scheme was 'file' + $href->{host} = '' if ($href->{host} eq 'localhost') and + ($href->{scheme} eq 'file'); + + return $href; +} + +=head2 $where = $ff->fetch( [to => /my/output/dir/ | \$scalar] ) + +Fetches the file you requested and returns the full path to the file. + +By default it writes to C<cwd()>, but you can override that by specifying +the C<to> argument: + + ### file fetch to /tmp, full path to the file in $where + $where = $ff->fetch( to => '/tmp' ); + + ### file slurped into $scalar, full path to the file in $where + ### file is downloaded to a temp directory and cleaned up at exit time + $where = $ff->fetch( to => \$scalar ); + +Returns the full path to the downloaded file on success, and false +on failure. + +=cut + +sub fetch { + my $self = shift or return; + my %hash = @_; + + my $target; + my $tmpl = { + to => { default => cwd(), store => \$target }, + }; + + check( $tmpl, \%hash ) or return; + + my ($to, $fh); + ### you want us to slurp the contents + if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) { + $to = tempdir( 'FileFetch.XXXXXX', DIR => $self->tempdir_root, CLEANUP => 1 ); + + ### plain old fetch + } else { + $to = $target; + + ### On VMS force to VMS format so File::Spec will work. + $to = VMS::Filespec::vmspath($to) if ON_VMS; + + ### create the path if it doesn't exist yet ### + unless( -d $to ) { + eval { mkpath( $to ) }; + + return $self->_error(loc("Could not create path '%1'",$to)) if $@; + } + } + + ### set passive ftp if required ### + local $ENV{FTP_PASSIVE} = $FTP_PASSIVE; + + ### we dont use catfile on win32 because if we are using a cygwin tool + ### under cmd.exe they wont understand windows style separators. + my $out_to = ON_WIN ? $to.'/'.$self->output_file + : File::Spec->catfile( $to, $self->output_file ); + + for my $method ( @{ $METHODS->{$self->scheme} } ) { + my $sub = '_'.$method.'_fetch'; + + unless( __PACKAGE__->can($sub) ) { + $self->_error(loc("Cannot call method for '%1' -- WEIRD!", + $method)); + next; + } + + ### method is blacklisted ### + next if grep { lc $_ eq $method } @$BLACKLIST; + + ### method is known to fail ### + next if $METHOD_FAIL->{$method}; + + ### there's serious issues with IPC::Run and quoting of command + ### line arguments. using quotes in the wrong place breaks things, + ### and in the case of say, + ### C:\cygwin\bin\wget.EXE --quiet --passive-ftp --output-document + ### "index.html" "http://www.cpan.org/index.html?q=1&y=2" + ### it doesn't matter how you quote, it always fails. + local $IPC::Cmd::USE_IPC_RUN = 0; + + if( my $file = $self->$sub( + to => $out_to + )){ + + unless( -e $file && -s _ ) { + $self->_error(loc("'%1' said it fetched '%2', ". + "but it was not created",$method,$file)); + + ### mark the failure ### + $METHOD_FAIL->{$method} = 1; + + next; + + } else { + + ### slurp mode? + if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) { + + ### open the file + open my $fh, "<$file" or do { + $self->_error( + loc("Could not open '%1': %2", $file, $!)); + return; + }; + + ### slurp + $$target = do { local $/; <$fh> }; + + } + + my $abs = File::Spec->rel2abs( $file ); + return $abs; + + } + } + } + + + ### if we got here, we looped over all methods, but we weren't able + ### to fetch it. + return; +} + +######################## +### _*_fetch methods ### +######################## + +### LWP fetching ### +sub _lwp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### modules required to download with lwp ### + my $use_list = { + LWP => '0.0', + 'LWP::UserAgent' => '0.0', + 'HTTP::Request' => '0.0', + 'HTTP::Status' => '0.0', + URI => '0.0', + + }; + + unless( can_load( modules => $use_list ) ) { + $METHOD_FAIL->{'lwp'} = 1; + return; + } + + ### setup the uri object + my $uri = URI->new( File::Spec::Unix->catfile( + $self->path, $self->file + ) ); + + ### special rules apply for file:// uris ### + $uri->scheme( $self->scheme ); + $uri->host( $self->scheme eq 'file' ? '' : $self->host ); + $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file'; + + ### set up the useragent object + my $ua = LWP::UserAgent->new(); + $ua->timeout( $TIMEOUT ) if $TIMEOUT; + $ua->agent( $USER_AGENT ); + $ua->from( $FROM_EMAIL ); + $ua->env_proxy; + + my $res = $ua->mirror($uri, $to) or return; + + ### uptodate or fetched ok ### + if ( $res->code == 304 or $res->code == 200 ) { + return $to; + + } else { + return $self->_error(loc("Fetch failed! HTTP response: %1 %2 [%3]", + $res->code, HTTP::Status::status_message($res->code), + $res->status_line)); + } + +} + +### HTTP::Tiny fetching ### +sub _httptiny_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + my $use_list = { + 'HTTP::Tiny' => '0.008', + + }; + + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'httptiny'} = 1; + return; + } + + my $uri = $self->uri; + + my $http = HTTP::Tiny->new( ( $TIMEOUT ? ( timeout => $TIMEOUT ) : () ) ); + + my $rc = $http->mirror( $uri, $to ); + + unless ( $rc->{success} ) { + + return $self->_error(loc( "Fetch failed! HTTP response: %1 [%2]", + $rc->{status}, $rc->{reason} ) ); + + } + + return $to; + +} + +### HTTP::Lite fetching ### +sub _httplite_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### modules required to download with lwp ### + my $use_list = { + 'HTTP::Lite' => '2.2', + + }; + + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'httplite'} = 1; + return; + } + + my $uri = $self->uri; + my $retries = 0; + + RETRIES: while ( $retries++ < 5 ) { + + my $http = HTTP::Lite->new(); + # Naughty naughty but there isn't any accessor/setter + $http->{timeout} = $TIMEOUT if $TIMEOUT; + $http->http11_mode(1); + + my $fh = FileHandle->new; + + unless ( $fh->open($to,'>') ) { + return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + } + + $fh->autoflush(1); + + binmode $fh; + + my $rc = $http->request( $uri, sub { my ($self,$dref,$cbargs) = @_; local $\; print {$cbargs} $$dref }, $fh ); + + close $fh; + + if ( $rc == 301 || $rc == 302 ) { + my $loc; + HEADERS: for ($http->headers_array) { + /Location: (\S+)/ and $loc = $1, last HEADERS; + } + #$loc or last; # Think we should squeal here. + if ($loc =~ m!^/!) { + $uri =~ s{^(\w+?://[^/]+)/.*$}{$1}; + $uri .= $loc; + } + else { + $uri = $loc; + } + next RETRIES; + } + elsif ( $rc == 200 ) { + return $to; + } + else { + return $self->_error(loc("Fetch failed! HTTP response: %1 [%2]", + $rc, $http->status_message)); + } + + } # Loop for 5 retries. + + return $self->_error("Fetch failed! Gave up after 5 tries"); + +} + +### Simple IO::Socket::INET fetching ### +sub _iosock_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + my $use_list = { + 'IO::Socket::INET' => '0.0', + 'IO::Select' => '0.0', + }; + + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'iosock'} = 1; + return; + } + + my $sock = IO::Socket::INET->new( + PeerHost => $self->host, + ( $self->host =~ /:/ ? () : ( PeerPort => 80 ) ), + ); + + unless ( $sock ) { + return $self->_error(loc("Could not open socket to '%1', '%2'",$self->host,$!)); + } + + my $fh = FileHandle->new; + + # Check open() + + unless ( $fh->open($to,'>') ) { + return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + } + + $fh->autoflush(1); + binmode $fh; + + my $path = File::Spec::Unix->catfile( $self->path, $self->file ); + my $req = "GET $path HTTP/1.0\x0d\x0aHost: " . $self->host . "\x0d\x0a\x0d\x0a"; + $sock->send( $req ); + + my $select = IO::Select->new( $sock ); + + my $resp = ''; + my $normal = 0; + while ( $select->can_read( $TIMEOUT || 60 ) ) { + my $ret = $sock->sysread( $resp, 4096, length($resp) ); + if ( !defined $ret or $ret == 0 ) { + $select->remove( $sock ); + $normal++; + } + } + close $sock; + + unless ( $normal ) { + return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 ))); + } + + # Check the "response" + # Strip preceding blank lines apparently they are allowed (RFC 2616 4.1) + $resp =~ s/^(\x0d?\x0a)+//; + # Check it is an HTTP response + unless ( $resp =~ m!^HTTP/(\d+)\.(\d+)!i ) { + return $self->_error(loc("Did not get a HTTP response from '%1'",$self->host)); + } + + # Check for OK + my ($code) = $resp =~ m!^HTTP/\d+\.\d+\s+(\d+)!i; + unless ( $code eq '200' ) { + return $self->_error(loc("Got a '%1' from '%2' expected '200'",$code,$self->host)); + } + + { + local $\; + print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0]; + } + close $fh; + return $to; +} + +### Net::FTP fetching +sub _netftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### required modules ### + my $use_list = { 'Net::FTP' => 0 }; + + unless( can_load( modules => $use_list ) ) { + $METHOD_FAIL->{'netftp'} = 1; + return; + } + + ### make connection ### + my $ftp; + my @options = ($self->host); + push(@options, Timeout => $TIMEOUT) if $TIMEOUT; + unless( $ftp = Net::FTP->new( @options ) ) { + return $self->_error(loc("Ftp creation failed: %1",$@)); + } + + ### login ### + unless( $ftp->login( anonymous => $FROM_EMAIL ) ) { + return $self->_error(loc("Could not login to '%1'",$self->host)); + } + + ### set binary mode, just in case ### + $ftp->binary; + + ### create the remote path + ### remember remote paths are unix paths! [#11483] + my $remote = File::Spec::Unix->catfile( $self->path, $self->file ); + + ### fetch the file ### + my $target; + unless( $target = $ftp->get( $remote, $to ) ) { + return $self->_error(loc("Could not fetch '%1' from '%2'", + $remote, $self->host)); + } + + ### log out ### + $ftp->quit; + + return $target; + +} + +### /bin/wget fetch ### +sub _wget_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + my $wget; + ### see if we have a wget binary ### + unless( $wget = can_run('wget') ) { + $METHOD_FAIL->{'wget'} = 1; + return; + } + + ### no verboseness, thanks ### + my $cmd = [ $wget, '--quiet' ]; + + ### if a timeout is set, add it ### + push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; + + ### run passive if specified ### + push @$cmd, '--passive-ftp' if $FTP_PASSIVE; + + ### set the output document, add the uri ### + push @$cmd, '--output-document', $to, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; + + return $self->_error(loc( "Command failed: %1", $captured || '' )); + } + + return $to; +} + +### /bin/lftp fetch ### +sub _lftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a lftp binary ### + my $lftp; + unless( $lftp = can_run('lftp') ) { + $METHOD_FAIL->{'lftp'} = 1; + return; + } + + ### no verboseness, thanks ### + my $cmd = [ $lftp, '-f' ]; + + my $fh = File::Temp->new; + + my $str; + + ### if a timeout is set, add it ### + $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT; + + ### run passive if specified ### + $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE; + + ### set the output document, add the uri ### + ### quote the URI, because lftp supports certain shell + ### expansions, most notably & for backgrounding. + ### ' quote does nto work, must be " + $str .= q[get ']. $self->uri .q[' -o ]. $to . $/; + + if( $DEBUG ) { + my $pp_str = join ' ', split $/, $str; + print "# lftp command: $pp_str\n"; + } + + ### write straight to the file. + $fh->autoflush(1); + print $fh $str; + + ### the command needs to be 1 string to be executed + push @$cmd, $fh->filename; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; + + return $self->_error(loc( "Command failed: %1", $captured || '' )); + } + + return $to; +} + + + +### /bin/ftp fetch ### +sub _ftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a ftp binary ### + my $ftp; + unless( $ftp = can_run('ftp') ) { + $METHOD_FAIL->{'ftp'} = 1; + return; + } + + my $fh = FileHandle->new; + + local $SIG{CHLD} = 'IGNORE'; + + unless ($fh->open("$ftp -n", '|-')) { + return $self->_error(loc("%1 creation failed: %2", $ftp, $!)); + } + + my @dialog = ( + "lcd " . dirname($to), + "open " . $self->host, + "user anonymous $FROM_EMAIL", + "cd /", + "cd " . $self->path, + "binary", + "get " . $self->file . " " . $self->output_file, + "quit", + ); + + foreach (@dialog) { $fh->print($_, "\n") } + $fh->close or return; + + return $to; +} + +### lynx is stupid - it decompresses any .gz file it finds to be text +### use /bin/lynx to fetch files +sub _lynx_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a lynx binary ### + my $lynx; + unless ( $lynx = can_run('lynx') ){ + $METHOD_FAIL->{'lynx'} = 1; + return; + } + + unless( IPC::Cmd->can_capture_buffer ) { + $METHOD_FAIL->{'lynx'} = 1; + + return $self->_error(loc( + "Can not capture buffers. Can not use '%1' to fetch files", + 'lynx' )); + } + + ### check if the HTTP resource exists ### + if ($self->uri =~ /^https?:\/\//i) { + my $cmd = [ + $lynx, + '-head', + '-source', + "-auth=anonymous:$FROM_EMAIL", + ]; + + push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT; + + push @$cmd, $self->uri; + + ### shell out ### + my $head; + unless(run( command => $cmd, + buffer => \$head, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $head || '')); + } + + unless($head =~ /^HTTP\/\d+\.\d+ 200\b/) { + return $self->_error(loc("Command failed: %1", $head || '')); + } + } + + ### write to the output file ourselves, since lynx ass_u_mes to much + my $local = FileHandle->new( $to, 'w' ) + or return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + + ### dump to stdout ### + my $cmd = [ + $lynx, + '-source', + "-auth=anonymous:$FROM_EMAIL", + ]; + + push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT; + + ### DO NOT quote things for IPC::Run, it breaks stuff. + push @$cmd, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? $self->uri + # : QUOTE. $self->uri .QUOTE; + + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $captured || '')); + } + + ### print to local file ### + ### XXX on a 404 with a special error page, $captured will actually + ### hold the contents of that page, and make it *appear* like the + ### request was a success, when really it wasn't :( + ### there doesn't seem to be an option for lynx to change the exit + ### code based on a 4XX status or so. + ### the closest we can come is using --error_file and parsing that, + ### which is very unreliable ;( + $local->print( $captured ); + $local->close or return; + + return $to; +} + +### use /bin/ncftp to fetch files +sub _ncftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### we can only set passive mode in interactive sessions, so bail out + ### if $FTP_PASSIVE is set + return if $FTP_PASSIVE; + + ### see if we have a ncftp binary ### + my $ncftp; + unless( $ncftp = can_run('ncftp') ) { + $METHOD_FAIL->{'ncftp'} = 1; + return; + } + + my $cmd = [ + $ncftp, + '-V', # do not be verbose + '-p', $FROM_EMAIL, # email as password + $self->host, # hostname + dirname($to), # local dir for the file + # remote path to the file + ### DO NOT quote things for IPC::Run, it breaks stuff. + $IPC::Cmd::USE_IPC_RUN + ? File::Spec::Unix->catdir( $self->path, $self->file ) + : QUOTE. File::Spec::Unix->catdir( + $self->path, $self->file ) .QUOTE + + ]; + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $captured || '')); + } + + return $to; + +} + +### use /bin/curl to fetch files +sub _curl_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + my $curl; + unless ( $curl = can_run('curl') ) { + $METHOD_FAIL->{'curl'} = 1; + return; + } + + ### these long opts are self explanatory - I like that -jmb + my $cmd = [ $curl, '-q' ]; + + push(@$cmd, '--connect-timeout', $TIMEOUT) if $TIMEOUT; + + push(@$cmd, '--silent') unless $DEBUG; + + ### curl does the right thing with passive, regardless ### + if ($self->scheme eq 'ftp') { + push(@$cmd, '--user', "anonymous:$FROM_EMAIL"); + } + + ### curl doesn't follow 302 (temporarily moved) etc automatically + ### so we add --location to enable that. + push @$cmd, '--fail', '--location', '--output', $to, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + + return $self->_error(loc("Command failed: %1", $captured || '')); + } + + return $to; + +} + +### /usr/bin/fetch fetch! ### +sub _fetch_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a fetch binary ### + my $fetch; + unless( HAS_FETCH and $fetch = can_run('fetch') ) { + $METHOD_FAIL->{'fetch'} = 1; + return; + } + + ### no verboseness, thanks ### + my $cmd = [ $fetch, '-q' ]; + + ### if a timeout is set, add it ### + push(@$cmd, '-T', $TIMEOUT) if $TIMEOUT; + + ### run passive if specified ### + #push @$cmd, '-p' if $FTP_PASSIVE; + local $ENV{'FTP_PASSIVE_MODE'} = 1 if $FTP_PASSIVE; + + ### set the output document, add the uri ### + push @$cmd, '-o', $to, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; + + return $self->_error(loc( "Command failed: %1", $captured || '' )); + } + + return $to; +} + +### use File::Copy for fetching file:// urls ### +### +### See section 3.10 of RFC 1738 (http://www.faqs.org/rfcs/rfc1738.html) +### Also see wikipedia on file:// (http://en.wikipedia.org/wiki/File://) +### + +sub _file_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + + + ### prefix a / on unix systems with a file uri, since it would + ### look somewhat like this: + ### file:///home/kane/file + ### whereas windows file uris for 'c:\some\dir\file' might look like: + ### file:///C:/some/dir/file + ### file:///C|/some/dir/file + ### or for a network share '\\host\share\some\dir\file': + ### file:////host/share/some/dir/file + ### + ### VMS file uri's for 'DISK$USER:[MY.NOTES]NOTE123456.TXT' might look like: + ### file://vms.host.edu/disk$user/my/notes/note12345.txt + ### + + my $path = $self->path; + my $vol = $self->vol; + my $share = $self->share; + + my $remote; + if (!$share and $self->host) { + return $self->_error(loc( + "Currently %1 cannot handle hosts in %2 urls", + 'File::Fetch', 'file://' + )); + } + + if( $vol ) { + $path = File::Spec->catdir( split /\//, $path ); + $remote = File::Spec->catpath( $vol, $path, $self->file); + + } elsif( $share ) { + ### win32 specific, and a share name, so we wont bother with File::Spec + $path =~ s|/+|\\|g; + $remote = "\\\\".$self->host."\\$share\\$path"; + + } else { + ### File::Spec on VMS can not currently handle UNIX syntax. + my $file_class = ON_VMS + ? 'File::Spec::Unix' + : 'File::Spec'; + + $remote = $file_class->catfile( $path, $self->file ); + } + + ### File::Copy is littered with 'die' statements :( ### + my $rv = eval { File::Copy::copy( $remote, $to ) }; + + ### something went wrong ### + if( !$rv or $@ ) { + return $self->_error(loc("Could not copy '%1' to '%2': %3 %4", + $remote, $to, $!, $@)); + } + + return $to; +} + +### use /usr/bin/rsync to fetch files +sub _rsync_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + my $rsync; + unless ( $rsync = can_run('rsync') ) { + $METHOD_FAIL->{'rsync'} = 1; + return; + } + + my $cmd = [ $rsync ]; + + ### XXX: rsync has no I/O timeouts at all, by default + push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; + + push(@$cmd, '--quiet') unless $DEBUG; + + ### DO NOT quote things for IPC::Run, it breaks stuff. + push @$cmd, $self->uri, $to; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + + return $self->_error(loc("Command %1 failed: %2", + "@$cmd" || '', $captured || '')); + } + + return $to; + +} + +################################# +# +# Error code +# +################################# + +=pod + +=head2 $ff->error([BOOL]) + +Returns the last encountered error as string. +Pass it a true value to get the C<Carp::longmess()> output instead. + +=cut + +### error handling the way Archive::Extract does it +sub _error { + my $self = shift; + my $error = shift; + + $self->_error_msg( $error ); + $self->_error_msg_long( Carp::longmess($error) ); + + if( $WARN ) { + carp $DEBUG ? $self->_error_msg_long : $self->_error_msg; + } + + return; +} + +sub error { + my $self = shift; + return shift() ? $self->_error_msg_long : $self->_error_msg; +} + + +1; + +=pod + +=head1 HOW IT WORKS + +File::Fetch is able to fetch a variety of uris, by using several +external programs and modules. + +Below is a mapping of what utilities will be used in what order +for what schemes, if available: + + file => LWP, lftp, file + http => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock + ftp => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp + rsync => rsync + +If you'd like to disable the use of one or more of these utilities +and/or modules, see the C<$BLACKLIST> variable further down. + +If a utility or module isn't available, it will be marked in a cache +(see the C<$METHOD_FAIL> variable further down), so it will not be +tried again. The C<fetch> method will only fail when all options are +exhausted, and it was not able to retrieve the file. + +The C<fetch> utility is available on FreeBSD. NetBSD and Dragonfly BSD +may also have it from C<pkgsrc>. We only check for C<fetch> on those +three platforms. + +C<iosock> is a very limited L<IO::Socket::INET> based mechanism for +retrieving C<http> schemed urls. It doesn't follow redirects for instance. + +A special note about fetching files from an ftp uri: + +By default, all ftp connections are done in passive mode. To change +that, see the C<$FTP_PASSIVE> variable further down. + +Furthermore, ftp uris only support anonymous connections, so no +named user/password pair can be passed along. + +C</bin/ftp> is blacklisted by default; see the C<$BLACKLIST> variable +further down. + +=head1 GLOBAL VARIABLES + +The behaviour of File::Fetch can be altered by changing the following +global variables: + +=head2 $File::Fetch::FROM_EMAIL + +This is the email address that will be sent as your anonymous ftp +password. + +Default is C<File-Fetch@xxxxxxxxxxx>. + +=head2 $File::Fetch::USER_AGENT + +This is the useragent as C<LWP> will report it. + +Default is C<File::Fetch/$VERSION>. + +=head2 $File::Fetch::FTP_PASSIVE + +This variable controls whether the environment variable C<FTP_PASSIVE> +and any passive switches to commandline tools will be set to true. + +Default value is 1. + +Note: When $FTP_PASSIVE is true, C<ncftp> will not be used to fetch +files, since passive mode can only be set interactively for this binary + +=head2 $File::Fetch::TIMEOUT + +When set, controls the network timeout (counted in seconds). + +Default value is 0. + +=head2 $File::Fetch::WARN + +This variable controls whether errors encountered internally by +C<File::Fetch> should be C<carp>'d or not. + +Set to false to silence warnings. Inspect the output of the C<error()> +method manually to see what went wrong. + +Defaults to C<true>. + +=head2 $File::Fetch::DEBUG + +This enables debugging output when calling commandline utilities to +fetch files. +This also enables C<Carp::longmess> errors, instead of the regular +C<carp> errors. + +Good for tracking down why things don't work with your particular +setup. + +Default is 0. + +=head2 $File::Fetch::BLACKLIST + +This is an array ref holding blacklisted modules/utilities for fetching +files with. + +To disallow the use of, for example, C<LWP> and C<Net::FTP>, you could +set $File::Fetch::BLACKLIST to: + + $File::Fetch::BLACKLIST = [qw|lwp netftp|] + +The default blacklist is [qw|ftp|], as C</bin/ftp> is rather unreliable. + +See the note on C<MAPPING> below. + +=head2 $File::Fetch::METHOD_FAIL + +This is a hashref registering what modules/utilities were known to fail +for fetching files (mostly because they weren't installed). + +You can reset this cache by assigning an empty hashref to it, or +individually remove keys. + +See the note on C<MAPPING> below. + +=head1 MAPPING + + +Here's a quick mapping for the utilities/modules, and their names for +the $BLACKLIST, $METHOD_FAIL and other internal functions. + + LWP => lwp + HTTP::Lite => httplite + HTTP::Tiny => httptiny + Net::FTP => netftp + wget => wget + lynx => lynx + ncftp => ncftp + ftp => ftp + curl => curl + rsync => rsync + lftp => lftp + fetch => fetch + IO::Socket => iosock + +=head1 FREQUENTLY ASKED QUESTIONS + +=head2 So how do I use a proxy with File::Fetch? + +C<File::Fetch> currently only supports proxies with LWP::UserAgent. +You will need to set your environment variables accordingly. For +example, to use an ftp proxy: + + $ENV{ftp_proxy} = 'foo.com'; + +Refer to the LWP::UserAgent manpage for more details. + +=head2 I used 'lynx' to fetch a file, but its contents is all wrong! + +C<lynx> can only fetch remote files by dumping its contents to C<STDOUT>, +which we in turn capture. If that content is a 'custom' error file +(like, say, a C<404 handler>), you will get that contents instead. + +Sadly, C<lynx> doesn't support any options to return a different exit +code on non-C<200 OK> status, giving us no way to tell the difference +between a 'successful' fetch and a custom error page. + +Therefor, we recommend to only use C<lynx> as a last resort. This is +why it is at the back of our list of methods to try as well. + +=head2 Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do? + +C<File::Fetch> is relatively smart about things. When trying to write +a file to disk, it removes the C<query parameters> (see the +C<output_file> method for details) from the file name before creating +it. In most cases this suffices. + +If you have any other characters you need to escape, please install +the C<URI::Escape> module from CPAN, and pre-encode your URI before +passing it to C<File::Fetch>. You can read about the details of URIs +and URI encoding here: + + http://www.faqs.org/rfcs/rfc2396.html + +=head1 TODO + +=over 4 + +=item Implement $PREFER_BIN + +To indicate to rather use commandline tools than modules + +=back + +=head1 BUG REPORTS + +Please report bugs or other issues to E<lt>bug-file-fetch@xxxxxxxxxxx<gt>. + +=head1 AUTHOR + +This module by Jos Boumans E<lt>kane@xxxxxxxxx<gt>. + +=head1 COPYRIGHT + +This library is free software; you may redistribute and/or modify it +under the same terms as Perl itself. + + +=cut + +# Local variables: +# c-indentation-style: bsd +# c-basic-offset: 4 +# indent-tabs-mode: nil +# End: +# vim: expandtab shiftwidth=4: + + + + diff --git a/File-Fetch-0.38/pm_to_blib b/File-Fetch-0.38/pm_to_blib new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.38/t/01_File-Fetch.t b/File-Fetch-0.38/t/01_File-Fetch.t new file mode 100644 index 0000000..538c55e --- /dev/null +++ b/File-Fetch-0.38/t/01_File-Fetch.t @@ -0,0 +1,281 @@ +BEGIN { chdir 't' if -d 't' }; + +use strict; +use lib '../lib'; + +use Test::More 'no_plan'; + +use Cwd qw[cwd]; +use File::Basename qw[basename]; +use Data::Dumper; + +use_ok('File::Fetch'); + +### optionally set debugging ### +$File::Fetch::DEBUG = $File::Fetch::DEBUG = 1 if $ARGV[0]; +$IPC::Cmd::DEBUG = $IPC::Cmd::DEBUG = 1 if $ARGV[0]; + +unless( $ENV{PERL_CORE} ) { + warn qq[ + +####################### NOTE ############################## + +Some of these tests assume you are connected to the +internet. If you are not, or if certain protocols or hosts +are blocked and/or firewalled, these tests could fail due +to no fault of the module itself. + +########################################################### + +]; + + sleep 3 unless $File::Fetch::DEBUG; +} + +### show us the tools IPC::Cmd will use to run binary programs +if( $File::Fetch::DEBUG ) { + ### stupid 'used only once' warnings ;( + diag( "IPC::Run enabled: " . + $IPC::Cmd::USE_IPC_RUN || $IPC::Cmd::USE_IPC_RUN ); + diag( "IPC::Run available: " . IPC::Cmd->can_use_ipc_run ); + diag( "IPC::Run vesion: $IPC::Run::VERSION" ); + diag( "IPC::Open3 enabled: " . + $IPC::Cmd::USE_IPC_OPEN3 || $IPC::Cmd::USE_IPC_OPEN3 ); + diag( "IPC::Open3 available: " . IPC::Cmd->can_use_ipc_open3 ); + diag( "IPC::Open3 vesion: $IPC::Open3::VERSION" ); +} + +### Heuristics +my %heuristics = map { $_ => 1 } qw(http ftp rsync file); +### _parse_uri tests +### these go on all platforms +my @map = ( + { uri => 'ftp://cpan.org/pub/mirror/index.txt', + scheme => 'ftp', + host => 'cpan.org', + path => '/pub/mirror/', + file => 'index.txt' + }, + { uri => 'rsync://cpan.pair.com/CPAN/MIRRORING.FROM', + scheme => 'rsync', + host => 'cpan.pair.com', + path => '/CPAN/', + file => 'MIRRORING.FROM', + }, + { uri => 'http://localhost/tmp/index.txt', + scheme => 'http', + host => 'localhost', # host is empty only on 'file://' + path => '/tmp/', + file => 'index.txt', + }, + + ### only test host part, the rest is OS dependant + { uri => 'file://localhost/tmp/index.txt', + host => '', # host should be empty on 'file://' + }, +); + +### these only if we're not on win32/vms +push @map, ( + { uri => 'file:///usr/local/tmp/foo.txt', + scheme => 'file', + host => '', + path => '/usr/local/tmp/', + file => 'foo.txt', + }, + { uri => 'file://hostname/tmp/foo.txt', + scheme => 'file', + host => 'hostname', + path => '/tmp/', + file => 'foo.txt', + }, +) if not &File::Fetch::ON_WIN and not &File::Fetch::ON_VMS; + +### these only on win32 +push @map, ( + { uri => 'file:////hostname/share/tmp/foo.txt', + scheme => 'file', + host => 'hostname', + share => 'share', + path => '/tmp/', + file => 'foo.txt', + }, + { uri => 'file:///D:/tmp/foo.txt', + scheme => 'file', + host => '', + vol => 'D:', + path => '/tmp/', + file => 'foo.txt', + }, + { uri => 'file:///D|/tmp/foo.txt', + scheme => 'file', + host => '', + vol => 'D:', + path => '/tmp/', + file => 'foo.txt', + }, +) if &File::Fetch::ON_WIN; + + +### sanity tests +{ + no warnings; + like( $File::Fetch::USER_AGENT, qr/$File::Fetch::VERSION/, + "User agent contains version" ); + like( $File::Fetch::FROM_EMAIL, qr/@/, + q[Email contains '@'] ); +} + +### parse uri tests ### +for my $entry (@map ) { + my $uri = $entry->{'uri'}; + + my $href = File::Fetch->_parse_uri( $uri ); + ok( $href, "Able to parse uri '$uri'" ); + + for my $key ( sort keys %$entry ) { + is( $href->{$key}, $entry->{$key}, + " '$key' ok ($entry->{$key}) for $uri"); + } +} + +### File::Fetch->new tests ### +for my $entry (@map) { + my $ff = File::Fetch->new( uri => $entry->{uri} ); + + ok( $ff, "Object for uri '$entry->{uri}'" ); + isa_ok( $ff, "File::Fetch", " Object" ); + + for my $acc ( keys %$entry ) { + is( $ff->$acc(), $entry->{$acc}, + " Accessor '$acc' ok ($entry->{$acc})" ); + } +} + +### fetch() tests ### + +### file:// tests ### +{ + my $prefix = &File::Fetch::ON_UNIX ? 'file://' : 'file:///'; + my $uri = $prefix . cwd() .'/'. basename($0); + + for (qw[lwp lftp file]) { + _fetch_uri( file => $uri, $_ ); + } +} + +### Heuristics +{ + require IO::Socket::INET; + my $sock = IO::Socket::INET->new( PeerAddr => 'ftp.funet.fi', PeerPort => 21, Timeout => 20 ) + or $heuristics{ftp} = 0; +} + +### ftp:// tests ### +{ my $uri = 'ftp://ftp.funet.fi/pub/CPAN/index.html'; + for (qw[lwp netftp wget curl lftp fetch ncftp]) { + + ### STUPID STUPID warnings ### + next if $_ eq 'ncftp' and $File::Fetch::FTP_PASSIVE + and $File::Fetch::FTP_PASSIVE; + + _fetch_uri( ftp => $uri, $_ ); + } +} + +### Heuristics +{ + require IO::Socket::INET; + my $sock = IO::Socket::INET->new( PeerAddr => 'www.cpan.org', PeerPort => 80, Timeout => 20 ) + or $heuristics{http} = 0; +} + +### http:// tests ### +{ for my $uri ( 'http://www.cpan.org/index.html', + 'http://www.cpan.org/index.html?q=1', + 'http://www.cpan.org/index.html?q=1&y=2', + ) { + for (qw[lwp httptiny wget curl lftp fetch lynx httplite iosock]) { + _fetch_uri( http => $uri, $_ ); + } + } +} + +### Heuristics +{ + require IO::Socket::INET; + my $sock = IO::Socket::INET->new( PeerAddr => 'cpan.pair.com', PeerPort => 873, Timeout => 20 ) + or $heuristics{rsync} = 0; +} + +### rsync:// tests ### +{ my $uri = 'rsync://cpan.pair.com/CPAN/MIRRORING.FROM'; + + for (qw[rsync]) { + _fetch_uri( rsync => $uri, $_ ); + } +} + +sub _fetch_uri { + my $type = shift; + my $uri = shift; + my $method = shift or return; + + SKIP: { + skip "'$method' fetching tests disabled under perl core", 4 + if $ENV{PERL_CORE}; + + skip "'$type' fetching tests disabled due to heuristic failure", 4 + unless $heuristics{ $type }; + + ### stupid warnings ### + $File::Fetch::METHODS = + $File::Fetch::METHODS = { $type => [$method] }; + + ### fetch regularly + my $ff = File::Fetch->new( uri => $uri ); + + ok( $ff, "FF object for $uri (fetch with $method)" ); + + for my $to ( 'tmp', do { \my $o } ) { SKIP: { + + + my $how = ref $to ? 'slurp' : 'file'; + my $skip = ref $to ? 4 : 3; + + ok( 1, " Fetching '$uri' in $how mode" ); + + my $file = $ff->fetch( to => $to ); + + skip "You do not have '$method' installed/available", $skip + if $File::Fetch::METHOD_FAIL->{$method} && + $File::Fetch::METHOD_FAIL->{$method}; + + ### if the file wasn't fetched, it may be a network/firewall issue + skip "Fetch failed; no network connectivity for '$type'?", $skip + unless $file; + + ok( $file, " File ($file) fetched with $method ($uri)" ); + + ### check we got some contents if we were meant to slurp + if( ref $to ) { + ok( $$to, " Contents slurped" ); + } + + ok( $file && -s $file, + " File has size" ); + is( $file && basename($file), $ff->output_file, + " File has expected name" ); + + unlink $file; + }} + } +} + + + + + + + + diff --git a/File-Fetch-0.38/t/null_subclass.t b/File-Fetch-0.38/t/null_subclass.t new file mode 100644 index 0000000..630a607 --- /dev/null +++ b/File-Fetch-0.38/t/null_subclass.t @@ -0,0 +1,23 @@ +use strict; +use warnings; + +use Test::More tests => 5; + +my $parent_class = 'File::Fetch'; +my $child_class = 'File::Fetch::Subclass'; + +use_ok( $parent_class ); + +my $ff_parent = $parent_class->new( uri => 'http://example.com/index.html' ); +isa_ok( $ff_parent, $parent_class ); + +can_ok( $child_class, qw( new fetch ) ); +my $ff_child = $child_class->new( uri => 'http://example.com/index.html' ); +isa_ok( $ff_child, $child_class ); +isa_ok( $ff_child, $parent_class ); + +BEGIN { + package File::Fetch::Subclass; + use vars qw(@ISA); + unshift @ISA, qw(File::Fetch); + } diff --git a/File-Fetch-0.42/CHANGES b/File-Fetch-0.42/CHANGES new file mode 100644 index 0000000..ce25b36 --- /dev/null +++ b/File-Fetch-0.42/CHANGES @@ -0,0 +1,222 @@ +Changes for 0.42 Fri Apr 12 15:28:34 2013 +================================================= +* Skip slurp tests for git:// + +Changes for 0.40 Fri Apr 12 11:18:52 2013 +================================================= +* Added git:// url support + +Changes for 0.38 Thu Jan 10 20:52:53 2013 +================================================= +* Add support for an optional tempdir_root + parameter (Kent Fredric) + +Changes for 0.36 Thu Jun 28 13:41:31 2012 +================================================= +* Added 'file_default' option for URLs that do + not have a file component (Andrew Kirkpatrick) + +Changes for 0.34 Thu Apr 12 22:25:01 2012 +================================================= +* Added heuristics to skip tests when no + Internet access + +Changes for 0.32 Mon Jan 17 10:26:40 2011 +================================================= +* Added support for HTTP::Tiny + +Changes for 0.30 Fri Jan 7 21:00:27 2011 +================================================= +* Apply blead patches from Peter Acklam + +Changes for 0.28 Sun Nov 7 21:22:26 2010 +================================================= +* Added support for FreeBSDs 'fetch' command for + both http and ftp schemes. + +Changes for 0.26 Sat Nov 6 23:30:59 2010 +================================================= +* Added support for HTTP::Lite +* Resolved issue with '-l' switch and iosock fetch + +Changes for 0.24 Wed Jan 6 23:32:19 2010 +================================================= +* Applied a patch from brian d foy RT #53427 + that makes new() respect sub-classes. + +Changes for 0.22 Sat Nov 14 23:13:16 2009 +================================================= +* Bumped to stable version + +Changes for 0.21_02 Thu Nov 12 12:55:57 2009 +================================================= +* Additional checks for the iosock retriever + +Changes for 0.21_01 Wed Nov 11 23:38:27 2009 +================================================= +* Added a simple IO::Socket/IO::Select based http retriever, + based on code suggested by Paul 'Leonerd' Evans + +Changes for 0.20 Sat Jun 27 16:30:59 2009 +================================================= +* Promote 0.19_01 to stable + +Changes for 0.19_01 Mon Feb 9 18:04:01 2009 +================================================= +* Address: #42268: Wishlist: slurp to scalar + File::Fetch can now fetch to scalars as well + +Changes for 0.18 Wed Dec 17 14:00:40 2008 +================================================= +* Address #41412: User agent string contains uninterpolated + $VERSION. +* Use IPC::Cmd 0.42's supplied QUOTE constant, rather than + rolling our own + +Changes for 0.16 Fri Oct 10 13:54:40 2008 +================================================= +* Promote 0.15_04 to stable. + +Changes for 0.15_04 Mon Sep 22 15:08:49 2008 +================================================= +* Address: #37649: Feature request: Support lftp + File::Fetch now supports lftp, with one minor caveat: it uses + a temporary file to store the commands for lftp, as they are + multiline commands. Without this, we run into portability issues + with 'special' characters on various platforms, like ; and &. + +Changes for 0.15_03 Sun Jul 13 15:56:41 2008 +================================================= +* Add -q to curl, to inhibit the reading of .curlrc, + which may interfere with the options we pass ourselves. + This addresses #36902 + +Changes for 0.15_02 Sun May 18 13:42:30 2008 +================================================= +* Address #35018: Treat HTTP 404 Message as fail with lynx + lynx now does a -head request first to make sure the file + exists before proceeding + +Changes for 0.15_01 Sun Apr 6 13:55:36 2008 +================================================= +* Address: #32755: File-Fetch tests cannot fail if + unable to connect to internet. Tests are now skipped + if it looks as the failure is due to a lacking network + connection. +* New IPC::Cmd (0.41) fixes an IPC::Open3 bug, which we + now rely on. + +Changes for 0.14 Fri Dec 14 13:42:30 2007 +================================================= +* Promote 0.13_04 to stable. + +Changes for 0.13_04 Wed Nov 14 20:07:02 2007 +================================================= +* VMS patches for file:// uris by John M. + +Changes for 0.13_03 2007-11-04 21:32:40 +================================================= +* Restore OS specific file:// URI behaviour. The + RFC's specify that the url definition is host OS + specific, so what a url means on one machine will + mean something different on another. + VMS is now treated according to RFC 1738 + (http://www.faqs.org/rfcs/rfc1738.html). + +Changes for 0.13_02 Sun Nov 4 10:38:40 CET 2007 +================================================= +* Apply a perl 5.5.x compatibility fix. Users with + perl 5.6.0 or higher do not need to upgrade. + +Changes for 0.13_01 Sat Nov 3 18:55:10 CET 2007 +================================================= +* Apply a modified version of dmq's patch to deal + properly with file:// URIs on Win32. +* Add test cases for Win32 file:// URIs + +Changes for 0.12 Mon Oct 15 14:32:23 CEST 2007 +================================================= +* Treat VMS like UNIX when dealing with file URIs + +Changes for 0.10 Fri Jan 26 13:51:19 CET 2007 +================================================ +* Promote 0.09_02 to stable. + +Changes for 0.09_02 Sun Jan 7 18:44:09 CET 2007 +================================================ +* The quotation as done in 0.09_01 doesn't play + nicely with Win32 and IPC::Run. IPC::Run is + therefor disabled during the fetch() call. +* Remove File::Fetch::Item as a class. All objects + are now plain File::Fetch objects. This has no + impact on user-end code, except code that checks + the class of objects. +* URI encoding is not always clear or trivial. Add + a FAQ entry about it. +* Add $ff->output_file as accessor, which is the + requested file, stripped from query parameters. +* Errors are now stored per object rather than + class wide. + +Changes for 0.09_01 Wed Jan 3 17:17:31 CET 2007 +================================================ +* address: #23864: File:Fetch does not use quotation + marks while using wget: + * the handlers for lynx, wget, curl and rsync now + quote their URIs. + +Changes for 0.08 Wed Jul 5 13:56:36 CEST 2006 +================================================ +* address: #18942: unproper handling of http errors + in external handlers: + * the wget handler, on a failed attempt, now + unlinks its outputfile + * the curl handler is updated to follow '302 moved' + and such like status messages + * lynx use is further discouraged, as it doesn't + communicate http status messages back to the caller + at all. +* address #11483: File::Fetch 0.07 cannot do an FTP + fetch on Win32. FTP fetching using Net::FTP should + now work properly on win32. +* update test suite so it runs safely under PERL_CORE + +Changes for 0.07 Thu Dec 23 09:31:00 PST 2004 +================================================ + +* Add $TIMEOUT to specify the network timeout + +Changes for 0.06 Thu Dec 16 03:21:00 PST 2004 +================================================ + +* Add rsync support + +Changes for 0.05 Fri Jun 18 13:55:51 CEST 2004 +================================================= + +* Update faq +* Silence silly warnings + +Changes for 0.04 Fri Jun 11 22:40:34 CEST 2004 +================================================= + +* Add file support using File::Copy + +Changes for 0.03 Fri Jun 11 20:40:22 CEST 2004 +================================================= + +* Add I18N support +* Add better error handling + +Changes for 0.02 Sat May 22 14:40:29 CEST 2004 +================================================= + +* Add an extra 'FAQ' entry +* Include a 'use File::Fetch::Item' + + +Changes for 0.01 Tue May 4 15:48:24 CEST 2004 +================================================= + +* Initial release + diff --git a/File-Fetch-0.42/MANIFEST b/File-Fetch-0.42/MANIFEST new file mode 100644 index 0000000..702c16f --- /dev/null +++ b/File-Fetch-0.42/MANIFEST @@ -0,0 +1,9 @@ +CHANGES +lib/File/Fetch.pm +Makefile.PL +MANIFEST This list of files +README +t/01_File-Fetch.t +t/null_subclass.t +META.yml Module YAML meta-data (added by MakeMaker) +META.json Module JSON meta-data (added by MakeMaker) diff --git a/File-Fetch-0.42/META.json b/File-Fetch-0.42/META.json new file mode 100644 index 0000000..e5fe766 --- /dev/null +++ b/File-Fetch-0.42/META.json @@ -0,0 +1,54 @@ +{ + "abstract" : "Generic file fetching code", + "author" : [ + "Jos Boumans <kane[at]cpan.org>" + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.130880", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "File-Fetch", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : { + "File::Basename" : "0", + "File::Copy" : "0", + "File::Path" : "0", + "File::Spec" : "0.82", + "IPC::Cmd" : "0.42", + "Locale::Maketext::Simple" : "0", + "Module::Load::Conditional" : "0.04", + "Params::Check" : "0.07", + "Test::More" : "0" + } + } + }, + "release_status" : "stable", + "resources" : { + "repository" : { + "url" : "https://github.com/jib/file-fetch" + } + }, + "version" : "0.42" +} diff --git a/File-Fetch-0.42/META.yml b/File-Fetch-0.42/META.yml new file mode 100644 index 0000000..792437a --- /dev/null +++ b/File-Fetch-0.42/META.yml @@ -0,0 +1,32 @@ +--- +abstract: 'Generic file fetching code' +author: + - 'Jos Boumans <kane[at]cpan.org>' +build_requires: + ExtUtils::MakeMaker: 0 +configure_requires: + ExtUtils::MakeMaker: 0 +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.130880' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: File-Fetch +no_index: + directory: + - t + - inc +requires: + File::Basename: 0 + File::Copy: 0 + File::Path: 0 + File::Spec: 0.82 + IPC::Cmd: 0.42 + Locale::Maketext::Simple: 0 + Module::Load::Conditional: 0.04 + Params::Check: 0.07 + Test::More: 0 +resources: + repository: https://github.com/jib/file-fetch +version: 0.42 diff --git a/File-Fetch-0.42/MYMETA.json b/File-Fetch-0.42/MYMETA.json new file mode 100644 index 0000000..f126e43 --- /dev/null +++ b/File-Fetch-0.42/MYMETA.json @@ -0,0 +1,54 @@ +{ + "abstract" : "Generic file fetching code", + "author" : [ + "Jos Boumans <kane[at]cpan.org>" + ], + "dynamic_config" : 0, + "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.130880, CPAN::Meta::Converter version 2.120921", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "File-Fetch", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : { + "File::Basename" : "0", + "File::Copy" : "0", + "File::Path" : "0", + "File::Spec" : "0.82", + "IPC::Cmd" : "0.42", + "Locale::Maketext::Simple" : "0", + "Module::Load::Conditional" : "0.04", + "Params::Check" : "0.07", + "Test::More" : "0" + } + } + }, + "release_status" : "stable", + "resources" : { + "repository" : { + "url" : "https://github.com/jib/file-fetch" + } + }, + "version" : "0.42" +} diff --git a/File-Fetch-0.42/MYMETA.yml b/File-Fetch-0.42/MYMETA.yml new file mode 100644 index 0000000..01b4669 --- /dev/null +++ b/File-Fetch-0.42/MYMETA.yml @@ -0,0 +1,32 @@ +--- +abstract: 'Generic file fetching code' +author: + - 'Jos Boumans <kane[at]cpan.org>' +build_requires: + ExtUtils::MakeMaker: 0 +configure_requires: + ExtUtils::MakeMaker: 0 +dynamic_config: 0 +generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.130880, CPAN::Meta::Converter version 2.120921' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: File-Fetch +no_index: + directory: + - t + - inc +requires: + File::Basename: 0 + File::Copy: 0 + File::Path: 0 + File::Spec: 0.82 + IPC::Cmd: 0.42 + Locale::Maketext::Simple: 0 + Module::Load::Conditional: 0.04 + Params::Check: 0.07 + Test::More: 0 +resources: + repository: https://github.com/jib/file-fetch +version: 0.42 diff --git a/File-Fetch-0.42/Makefile b/File-Fetch-0.42/Makefile new file mode 100644 index 0000000..1dc5b16 --- /dev/null +++ b/File-Fetch-0.42/Makefile @@ -0,0 +1,898 @@ +# This Makefile is for the File::Fetch extension to perl. +# +# It was generated automatically by MakeMaker version +# 6.6302 (Revision: 66302) from the contents of +# Makefile.PL. Don't edit this file, edit Makefile.PL instead. +# +# ANY CHANGES MADE HERE WILL BE LOST! +# +# MakeMaker ARGV: (q[INSTALLDIRS=vendor]) +# + +# MakeMaker Parameters: + +# ABSTRACT => q[Generic file fetching code] +# AUTHOR => [q[Jos Boumans <kane[at]cpan.org>]] +# BUILD_REQUIRES => { } +# CONFIGURE_REQUIRES => { } +# INSTALLDIRS => q[perl] +# LICENSE => q[perl] +# META_MERGE => { resources=>{ repository=>q[https://github.com/jib/file-fetch] } } +# NAME => q[File::Fetch] +# PREREQ_PM => { File::Copy=>q[0], File::Spec=>q[0.82], Locale::Maketext::Simple=>q[0], IPC::Cmd=>q[0.42], Params::Check=>q[0.07], Test::More=>q[0], File::Path=>q[0], Module::Load::Conditional=>q[0.04], File::Basename=>q[0] } +# VERSION_FROM => q[lib/File/Fetch.pm] +# clean => { FILES=>q[t/tmp] } +# dist => { COMPRESS=>q[gzip -9f], SUFFIX=>q[gz] } + +# --- MakeMaker post_initialize section: + + +# --- MakeMaker const_config section: + +# These definitions are from config.sh (via /usr/lib64/perl5/Config.pm). +# They may have been overridden via Makefile.PL or on the command line. +AR = ar +CC = gcc +CCCDLFLAGS = -fPIC +CCDLFLAGS = -Wl,--enable-new-dtags -Wl,-rpath,/usr/lib64/perl5/CORE +DLEXT = so +DLSRC = dl_dlopen.xs +EXE_EXT = +FULL_AR = /usr/bin/ar +LD = gcc +LDDLFLAGS = -shared -O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic -Wl,-z,relro +LDFLAGS = -fstack-protector +LIBC = +LIB_EXT = .a +OBJ_EXT = .o +OSNAME = linux +OSVERS = 2.6.32-358.2.1.el6.x86_64 +RANLIB = : +SITELIBEXP = /usr/local/share/perl5 +SITEARCHEXP = /usr/local/lib64/perl5 +SO = so +VENDORARCHEXP = /usr/lib64/perl5/vendor_perl +VENDORLIBEXP = /usr/share/perl5/vendor_perl + + +# --- MakeMaker constants section: +AR_STATIC_ARGS = cr +DIRFILESEP = / +DFSEP = $(DIRFILESEP) +NAME = File::Fetch +NAME_SYM = File_Fetch +VERSION = 0.42 +VERSION_MACRO = VERSION +VERSION_SYM = 0_42 +DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" +XS_VERSION = 0.42 +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" +INST_ARCHLIB = blib/arch +INST_SCRIPT = blib/script +INST_BIN = blib/bin +INST_LIB = blib/lib +INST_MAN1DIR = blib/man1 +INST_MAN3DIR = blib/man3 +MAN1EXT = 1 +MAN3EXT = 3pm +INSTALLDIRS = vendor +DESTDIR = +PREFIX = $(VENDORPREFIX) +PERLPREFIX = /usr +SITEPREFIX = /usr/local +VENDORPREFIX = /usr +INSTALLPRIVLIB = /usr/share/perl5 +DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB) +INSTALLSITELIB = /usr/local/share/perl5 +DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB) +INSTALLVENDORLIB = /usr/share/perl5/vendor_perl +DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB) +INSTALLARCHLIB = /usr/lib64/perl5 +DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB) +INSTALLSITEARCH = /usr/local/lib64/perl5 +DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH) +INSTALLVENDORARCH = /usr/lib64/perl5/vendor_perl +DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH) +INSTALLBIN = /usr/bin +DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN) +INSTALLSITEBIN = /usr/local/bin +DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN) +INSTALLVENDORBIN = /usr/bin +DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN) +INSTALLSCRIPT = /usr/bin +DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT) +INSTALLSITESCRIPT = /usr/local/bin +DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT) +INSTALLVENDORSCRIPT = /usr/bin +DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT) +INSTALLMAN1DIR = /usr/share/man/man1 +DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR) +INSTALLSITEMAN1DIR = /usr/local/share/man/man1 +DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR) +INSTALLVENDORMAN1DIR = /usr/share/man/man1 +DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR) +INSTALLMAN3DIR = /usr/share/man/man3 +DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR) +INSTALLSITEMAN3DIR = /usr/local/share/man/man3 +DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR) +INSTALLVENDORMAN3DIR = /usr/share/man/man3 +DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR) +PERL_LIB = /usr/share/perl5 +PERL_ARCHLIB = /usr/lib64/perl5 +LIBPERL_A = libperl.a +FIRST_MAKEFILE = Makefile +MAKEFILE_OLD = Makefile.old +MAKE_APERL_FILE = Makefile.aperl +PERLMAINCC = $(CC) +PERL_INC = /usr/lib64/perl5/CORE +PERL = /usr/bin/perl +FULLPERL = /usr/bin/perl +ABSPERL = $(PERL) +PERLRUN = $(PERL) +FULLPERLRUN = $(FULLPERL) +ABSPERLRUN = $(ABSPERL) +PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +PERL_CORE = 0 +PERM_DIR = 755 +PERM_RW = 644 +PERM_RWX = 755 + +MAKEMAKER = /usr/share/perl5/ExtUtils/MakeMaker.pm +MM_VERSION = 6.6302 +MM_REVISION = 66302 + +# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +MAKE = make +FULLEXT = File/Fetch +BASEEXT = Fetch +PARENT_NAME = File +DLBASE = $(BASEEXT) +VERSION_FROM = lib/File/Fetch.pm +OBJECT = +LDFROM = $(OBJECT) +LINKTYPE = dynamic +BOOTDEP = + +# Handy lists of source code files: +XS_FILES = +C_FILES = +O_FILES = +H_FILES = +MAN1PODS = +MAN3PODS = lib/File/Fetch.pm + +# Where is the Config information that we are using/depend on +CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h + +# Where to build things +INST_LIBDIR = $(INST_LIB)/File +INST_ARCHLIBDIR = $(INST_ARCHLIB)/File + +INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) +INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) + +INST_STATIC = +INST_DYNAMIC = +INST_BOOT = + +# Extra linker info +EXPORT_LIST = +PERL_ARCHIVE = +PERL_ARCHIVE_AFTER = + + +TO_INST_PM = lib/File/Fetch.pm + +PM_TO_BLIB = lib/File/Fetch.pm \ + blib/lib/File/Fetch.pm + + +# --- MakeMaker platform_constants section: +MM_Unix_VERSION = 6.6302 +PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc + + +# --- MakeMaker tool_autosplit section: +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$$$ARGV[0], $$$$ARGV[1], 0, 1, 1)' -- + + + +# --- MakeMaker tool_xsubpp section: + + +# --- MakeMaker tools_other section: +SHELL = /bin/sh +CHMOD = chmod +CP = cp +MV = mv +NOOP = $(TRUE) +NOECHO = @ +RM_F = rm -f +RM_RF = rm -rf +TEST_F = test -f +TOUCH = touch +UMASK_NULL = umask 0 +DEV_NULL = > /dev/null 2>&1 +MKPATH = $(ABSPERLRUN) -MExtUtils::Command -e 'mkpath' -- +EQUALIZE_TIMESTAMP = $(ABSPERLRUN) -MExtUtils::Command -e 'eqtime' -- +FALSE = false +TRUE = true +ECHO = echo +ECHO_N = echo -n +UNINST = 0 +VERBINST = 0 +MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install([ from_to => {@ARGV}, verbose => '\''$(VERBINST)'\'', uninstall_shadows => '\''$(UNINST)'\'', dir_mode => '\''$(PERM_DIR)'\'' ]);' -- +DOC_INSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'perllocal_install' -- +UNINSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'uninstall' -- +WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'warn_if_old_packlist' -- +MACROSTART = +MACROEND = +USEMAKEFILE = -f +FIXIN = $(ABSPERLRUN) -MExtUtils::MY -e 'MY->fixin(shift)' -- + + +# --- MakeMaker makemakerdflt section: +makemakerdflt : all + $(NOECHO) $(NOOP) + + +# --- MakeMaker dist section: +TAR = tar +TARFLAGS = cvf +ZIP = zip +ZIPFLAGS = -r +COMPRESS = gzip -9f +SUFFIX = gz +SHAR = shar +PREOP = $(NOECHO) $(NOOP) +POSTOP = $(NOECHO) $(NOOP) +TO_UNIX = $(NOECHO) $(NOOP) +CI = ci -u +RCS_LABEL = rcs -Nv$(VERSION_SYM): -q +DIST_CP = best +DIST_DEFAULT = tardist +DISTNAME = File-Fetch +DISTVNAME = File-Fetch-0.42 + + +# --- MakeMaker macro section: + + +# --- MakeMaker depend section: + + +# --- MakeMaker cflags section: + + +# --- MakeMaker const_loadlibs section: + + +# --- MakeMaker const_cccmd section: + + +# --- MakeMaker post_constants section: + + +# --- MakeMaker pasthru section: + +PASTHRU = LIBPERL_A="$(LIBPERL_A)"\ + LINKTYPE="$(LINKTYPE)"\ + PREFIX="$(PREFIX)" + + +# --- MakeMaker special_targets section: +.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) + +.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir + + + +# --- MakeMaker c_o section: + + +# --- MakeMaker xs_c section: + + +# --- MakeMaker xs_o section: + + +# --- MakeMaker top_targets section: +all :: pure_all manifypods + $(NOECHO) $(NOOP) + + +pure_all :: config pm_to_blib subdirs linkext + $(NOECHO) $(NOOP) + +subdirs :: $(MYEXTLIB) + $(NOECHO) $(NOOP) + +config :: $(FIRST_MAKEFILE) blibdirs + $(NOECHO) $(NOOP) + +help : + perldoc ExtUtils::MakeMaker + + +# --- MakeMaker blibdirs section: +blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists + $(NOECHO) $(NOOP) + +# Backwards compat with 6.18 through 6.25 +blibdirs.ts : blibdirs + $(NOECHO) $(NOOP) + +$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_LIBDIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_LIBDIR) + $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists + +$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHLIB) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHLIB) + $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists + +$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_AUTODIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_AUTODIR) + $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists + +$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHAUTODIR) + $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists + +$(INST_BIN)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_BIN) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_BIN) + $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists + +$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_SCRIPT) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_SCRIPT) + $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists + +$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN1DIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN1DIR) + $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists + +$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN3DIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN3DIR) + $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists + + + +# --- MakeMaker linkext section: + +linkext :: $(LINKTYPE) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dlsyms section: + + +# --- MakeMaker dynamic section: + +dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dynamic_bs section: + +BOOTSTRAP = + + +# --- MakeMaker dynamic_lib section: + + +# --- MakeMaker static section: + +## $(INST_PM) has been moved to the all: target. +## It remains here for awhile to allow for old usage: "make static" +static :: $(FIRST_MAKEFILE) $(INST_STATIC) + $(NOECHO) $(NOOP) + + +# --- MakeMaker static_lib section: + + +# --- MakeMaker manifypods section: + +POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" +POD2MAN = $(POD2MAN_EXE) + + +manifypods : pure_all \ + lib/File/Fetch.pm + $(NOECHO) $(POD2MAN) --section=3 --perm_rw=$(PERM_RW) \ + lib/File/Fetch.pm $(INST_MAN3DIR)/File::Fetch.$(MAN3EXT) + + + + +# --- MakeMaker processPL section: + + +# --- MakeMaker installbin section: + + +# --- MakeMaker subdirs section: + +# none + +# --- MakeMaker clean_subdirs section: +clean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker clean section: + +# Delete temporary files but do not touch installed files. We don't delete +# the Makefile here so a later make realclean still has a makefile to use. + +clean :: clean_subdirs + - $(RM_F) \ + *$(LIB_EXT) core \ + core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \ + core.[0-9][0-9] $(BASEEXT).bso \ + pm_to_blib.ts MYMETA.json \ + core.[0-9][0-9][0-9][0-9] MYMETA.yml \ + $(BASEEXT).x $(BOOTSTRAP) \ + perl$(EXE_EXT) tmon.out \ + *$(OBJ_EXT) pm_to_blib \ + $(INST_ARCHAUTODIR)/extralibs.ld blibdirs.ts \ + core.[0-9][0-9][0-9][0-9][0-9] *perl.core \ + core.*perl.*.? $(MAKE_APERL_FILE) \ + $(BASEEXT).def perl \ + core.[0-9][0-9][0-9] mon.out \ + lib$(BASEEXT).def perlmain.c \ + perl.exe so_locations \ + $(BASEEXT).exp + - $(RM_RF) \ + t/tmp blib + - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) + + +# --- MakeMaker realclean_subdirs section: +realclean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker realclean section: +# Delete temporary files (via clean) and also delete dist files +realclean purge :: clean realclean_subdirs + - $(RM_F) \ + $(MAKEFILE_OLD) $(FIRST_MAKEFILE) + - $(RM_RF) \ + $(DISTVNAME) + + +# --- MakeMaker metafile section: +metafile : create_distdir + $(NOECHO) $(ECHO) Generating META.yml + $(NOECHO) $(ECHO) '---' > META_new.yml + $(NOECHO) $(ECHO) 'abstract: '\''Generic file fetching code'\''' >> META_new.yml + $(NOECHO) $(ECHO) 'author:' >> META_new.yml + $(NOECHO) $(ECHO) ' - '\''Jos Boumans <kane[at]cpan.org>'\''' >> META_new.yml + $(NOECHO) $(ECHO) 'build_requires:' >> META_new.yml + $(NOECHO) $(ECHO) ' ExtUtils::MakeMaker: 0' >> META_new.yml + $(NOECHO) $(ECHO) 'configure_requires:' >> META_new.yml + $(NOECHO) $(ECHO) ' ExtUtils::MakeMaker: 0' >> META_new.yml + $(NOECHO) $(ECHO) 'dynamic_config: 1' >> META_new.yml + $(NOECHO) $(ECHO) 'generated_by: '\''ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921'\''' >> META_new.yml + $(NOECHO) $(ECHO) 'license: perl' >> META_new.yml + $(NOECHO) $(ECHO) 'meta-spec:' >> META_new.yml + $(NOECHO) $(ECHO) ' url: http://module-build.sourceforge.net/META-spec-v1.4.html' >> META_new.yml + $(NOECHO) $(ECHO) ' version: 1.4' >> META_new.yml + $(NOECHO) $(ECHO) 'name: File-Fetch' >> META_new.yml + $(NOECHO) $(ECHO) 'no_index:' >> META_new.yml + $(NOECHO) $(ECHO) ' directory:' >> META_new.yml + $(NOECHO) $(ECHO) ' - t' >> META_new.yml + $(NOECHO) $(ECHO) ' - inc' >> META_new.yml + $(NOECHO) $(ECHO) 'requires:' >> META_new.yml + $(NOECHO) $(ECHO) ' File::Basename: 0' >> META_new.yml + $(NOECHO) $(ECHO) ' File::Copy: 0' >> META_new.yml + $(NOECHO) $(ECHO) ' File::Path: 0' >> META_new.yml + $(NOECHO) $(ECHO) ' File::Spec: 0.82' >> META_new.yml + $(NOECHO) $(ECHO) ' IPC::Cmd: 0.42' >> META_new.yml + $(NOECHO) $(ECHO) ' Locale::Maketext::Simple: 0' >> META_new.yml + $(NOECHO) $(ECHO) ' Module::Load::Conditional: 0.04' >> META_new.yml + $(NOECHO) $(ECHO) ' Params::Check: 0.07' >> META_new.yml + $(NOECHO) $(ECHO) ' Test::More: 0' >> META_new.yml + $(NOECHO) $(ECHO) 'resources:' >> META_new.yml + $(NOECHO) $(ECHO) ' repository: https://github.com/jib/file-fetch' >> META_new.yml + $(NOECHO) $(ECHO) 'version: 0.42' >> META_new.yml + -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml + $(NOECHO) $(ECHO) Generating META.json + $(NOECHO) $(ECHO) '{' > META_new.json + $(NOECHO) $(ECHO) ' "abstract" : "Generic file fetching code",' >> META_new.json + $(NOECHO) $(ECHO) ' "author" : [' >> META_new.json + $(NOECHO) $(ECHO) ' "Jos Boumans <kane[at]cpan.org>"' >> META_new.json + $(NOECHO) $(ECHO) ' ],' >> META_new.json + $(NOECHO) $(ECHO) ' "dynamic_config" : 1,' >> META_new.json + $(NOECHO) $(ECHO) ' "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921",' >> META_new.json + $(NOECHO) $(ECHO) ' "license" : [' >> META_new.json + $(NOECHO) $(ECHO) ' "perl_5"' >> META_new.json + $(NOECHO) $(ECHO) ' ],' >> META_new.json + $(NOECHO) $(ECHO) ' "meta-spec" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",' >> META_new.json + $(NOECHO) $(ECHO) ' "version" : "2"' >> META_new.json + $(NOECHO) $(ECHO) ' },' >> META_new.json + $(NOECHO) $(ECHO) ' "name" : "File-Fetch",' >> META_new.json + $(NOECHO) $(ECHO) ' "no_index" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "directory" : [' >> META_new.json + $(NOECHO) $(ECHO) ' "t",' >> META_new.json + $(NOECHO) $(ECHO) ' "inc"' >> META_new.json + $(NOECHO) $(ECHO) ' ]' >> META_new.json + $(NOECHO) $(ECHO) ' },' >> META_new.json + $(NOECHO) $(ECHO) ' "prereqs" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "build" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "ExtUtils::MakeMaker" : "0"' >> META_new.json + $(NOECHO) $(ECHO) ' }' >> META_new.json + $(NOECHO) $(ECHO) ' },' >> META_new.json + $(NOECHO) $(ECHO) ' "configure" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "ExtUtils::MakeMaker" : "0"' >> META_new.json + $(NOECHO) $(ECHO) ' }' >> META_new.json + $(NOECHO) $(ECHO) ' },' >> META_new.json + $(NOECHO) $(ECHO) ' "runtime" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "File::Basename" : "0",' >> META_new.json + $(NOECHO) $(ECHO) ' "File::Copy" : "0",' >> META_new.json + $(NOECHO) $(ECHO) ' "File::Path" : "0",' >> META_new.json + $(NOECHO) $(ECHO) ' "File::Spec" : "0.82",' >> META_new.json + $(NOECHO) $(ECHO) ' "IPC::Cmd" : "0.42",' >> META_new.json + $(NOECHO) $(ECHO) ' "Locale::Maketext::Simple" : "0",' >> META_new.json + $(NOECHO) $(ECHO) ' "Module::Load::Conditional" : "0.04",' >> META_new.json + $(NOECHO) $(ECHO) ' "Params::Check" : "0.07",' >> META_new.json + $(NOECHO) $(ECHO) ' "Test::More" : "0"' >> META_new.json + $(NOECHO) $(ECHO) ' }' >> META_new.json + $(NOECHO) $(ECHO) ' }' >> META_new.json + $(NOECHO) $(ECHO) ' },' >> META_new.json + $(NOECHO) $(ECHO) ' "release_status" : "stable",' >> META_new.json + $(NOECHO) $(ECHO) ' "resources" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "repository" : {' >> META_new.json + $(NOECHO) $(ECHO) ' "url" : "https://github.com/jib/file-fetch"' >> META_new.json + $(NOECHO) $(ECHO) ' }' >> META_new.json + $(NOECHO) $(ECHO) ' },' >> META_new.json + $(NOECHO) $(ECHO) ' "version" : "0.42"' >> META_new.json + $(NOECHO) $(ECHO) '}' >> META_new.json + -$(NOECHO) $(MV) META_new.json $(DISTVNAME)/META.json + + +# --- MakeMaker signature section: +signature : + cpansign -s + + +# --- MakeMaker dist_basics section: +distclean :: realclean distcheck + $(NOECHO) $(NOOP) + +distcheck : + $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck + +skipcheck : + $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck + +manifest : + $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest + +veryclean : realclean + $(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old + + + +# --- MakeMaker dist_core section: + +dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE) + $(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \ + -e ' if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';' -- + +tardist : $(DISTVNAME).tar$(SUFFIX) + $(NOECHO) $(NOOP) + +uutardist : $(DISTVNAME).tar$(SUFFIX) + uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu + +$(DISTVNAME).tar$(SUFFIX) : distdir + $(PREOP) + $(TO_UNIX) + $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(COMPRESS) $(DISTVNAME).tar + $(POSTOP) + +zipdist : $(DISTVNAME).zip + $(NOECHO) $(NOOP) + +$(DISTVNAME).zip : distdir + $(PREOP) + $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(POSTOP) + +shdist : distdir + $(PREOP) + $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar + $(RM_RF) $(DISTVNAME) + $(POSTOP) + + +# --- MakeMaker distdir section: +create_distdir : + $(RM_RF) $(DISTVNAME) + $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \ + -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" + +distdir : create_distdir distmeta + $(NOECHO) $(NOOP) + + + +# --- MakeMaker dist_test section: +disttest : distdir + cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL "INSTALLDIRS=vendor" + cd $(DISTVNAME) && $(MAKE) $(PASTHRU) + cd $(DISTVNAME) && $(MAKE) test $(PASTHRU) + + + +# --- MakeMaker dist_ci section: + +ci : + $(PERLRUN) "-MExtUtils::Manifest=maniread" \ + -e "@all = keys %{ maniread() };" \ + -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \ + -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});" + + +# --- MakeMaker distmeta section: +distmeta : create_distdir metafile + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -e q{META.yml};' \ + -e 'eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) }' \ + -e ' or print "Could not add META.yml to MANIFEST: $$$${'\''@'\''}\n"' -- + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -f q{META.json};' \ + -e 'eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) }' \ + -e ' or print "Could not add META.json to MANIFEST: $$$${'\''@'\''}\n"' -- + + + +# --- MakeMaker distsignature section: +distsignature : create_distdir + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add SIGNATURE to MANIFEST: $$$${'\''@'\''}\n"' -- + $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE + cd $(DISTVNAME) && cpansign -s + + + +# --- MakeMaker install section: + +install :: pure_install doc_install + $(NOECHO) $(NOOP) + +install_perl :: pure_perl_install doc_perl_install + $(NOECHO) $(NOOP) + +install_site :: pure_site_install doc_site_install + $(NOECHO) $(NOOP) + +install_vendor :: pure_vendor_install doc_vendor_install + $(NOECHO) $(NOOP) + +pure_install :: pure_$(INSTALLDIRS)_install + $(NOECHO) $(NOOP) + +doc_install :: doc_$(INSTALLDIRS)_install + $(NOECHO) $(NOOP) + +pure__install : pure_site_install + $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +doc__install : doc_site_install + $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +pure_perl_install :: all + $(NOECHO) $(MOD_INSTALL) \ + read $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist \ + write $(DESTINSTALLARCHLIB)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(DESTINSTALLPRIVLIB) \ + $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \ + $(INST_BIN) $(DESTINSTALLBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) + $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ + $(SITEARCHEXP)/auto/$(FULLEXT) + + +pure_site_install :: all + $(NOECHO) $(MOD_INSTALL) \ + read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \ + write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(DESTINSTALLSITELIB) \ + $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \ + $(INST_BIN) $(DESTINSTALLSITEBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) + $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ + $(PERL_ARCHLIB)/auto/$(FULLEXT) + +pure_vendor_install :: all + $(NOECHO) $(MOD_INSTALL) \ + read $(VENDORARCHEXP)/auto/$(FULLEXT)/.packlist \ + write $(DESTINSTALLVENDORARCH)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(DESTINSTALLVENDORLIB) \ + $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \ + $(INST_BIN) $(DESTINSTALLVENDORBIN) \ + $(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) + +doc_perl_install :: all + $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod + -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) + -$(NOECHO) $(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLPRIVLIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(DESTINSTALLARCHLIB)/perllocal.pod + +doc_site_install :: all + $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod + -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) + -$(NOECHO) $(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLSITELIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(DESTINSTALLARCHLIB)/perllocal.pod + +doc_vendor_install :: all + $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod + -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) + -$(NOECHO) $(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLVENDORLIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(DESTINSTALLARCHLIB)/perllocal.pod + + +uninstall :: uninstall_from_$(INSTALLDIRS)dirs + $(NOECHO) $(NOOP) + +uninstall_from_perldirs :: + $(NOECHO) $(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist + +uninstall_from_sitedirs :: + $(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist + +uninstall_from_vendordirs :: + $(NOECHO) $(UNINSTALL) $(VENDORARCHEXP)/auto/$(FULLEXT)/.packlist + + +# --- MakeMaker force section: +# Phony target to force checking subdirectories. +FORCE : + $(NOECHO) $(NOOP) + + +# --- MakeMaker perldepend section: + + +# --- MakeMaker makefile section: +# We take a very conservative approach here, but it's worth it. +# We move Makefile to Makefile.old here to avoid gnu make looping. +$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) + $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?" + $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..." + -$(NOECHO) $(RM_F) $(MAKEFILE_OLD) + -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) + - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL) + $(PERLRUN) Makefile.PL "INSTALLDIRS=vendor" + $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" + $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <==" + $(FALSE) + + + +# --- MakeMaker staticmake section: + +# --- MakeMaker makeaperl section --- +MAP_TARGET = perl +FULLPERL = /usr/bin/perl + +$(MAP_TARGET) :: static $(MAKE_APERL_FILE) + $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@ + +$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib + $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) + $(NOECHO) $(PERLRUNINST) \ + Makefile.PL DIR= \ + MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ + MAKEAPERL=1 NORECURS=1 CCCDLFLAGS= \ + INSTALLDIRS=vendor + + +# --- MakeMaker test section: + +TEST_VERBOSE=0 +TEST_TYPE=test_$(LINKTYPE) +TEST_FILE = test.pl +TEST_FILES = t/*.t +TESTDB_SW = -d + +testdb :: testdb_$(LINKTYPE) + +test :: $(TEST_TYPE) subdirs-test + +subdirs-test :: + $(NOECHO) $(NOOP) + + +test_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES) + +testdb_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE) + +test_ : test_dynamic + +test_static :: test_dynamic +testdb_static :: testdb_dynamic + + +# --- MakeMaker ppd section: +# Creates a PPD (Perl Package Description) for a binary distribution. +ppd : + $(NOECHO) $(ECHO) '<SOFTPKG NAME="$(DISTNAME)" VERSION="$(VERSION)">' > $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <ABSTRACT>Generic file fetching code</ABSTRACT>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <AUTHOR>Jos Boumans <kane[at]cpan.org></AUTHOR>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <IMPLEMENTATION>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="File::Basename" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="File::Copy" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="File::Path" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="File::Spec" VERSION="0.82" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="IPC::Cmd" VERSION="0.42" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="Locale::Maketext::Simple" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="Module::Load::Conditional" VERSION="0.04" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="Params::Check" VERSION="0.07" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <REQUIRE NAME="Test::More" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <ARCHITECTURE NAME="x86_64-linux-thread-multi-5.16" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <CODEBASE HREF="" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' </IMPLEMENTATION>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) '</SOFTPKG>' >> $(DISTNAME).ppd + + +# --- MakeMaker pm_to_blib section: + +pm_to_blib : $(FIRST_MAKEFILE) $(TO_INST_PM) + $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', q[$(PM_FILTER)], '\''$(PERM_DIR)'\'')' -- \ + lib/File/Fetch.pm blib/lib/File/Fetch.pm + $(NOECHO) $(TOUCH) pm_to_blib + + +# --- MakeMaker selfdocument section: + + +# --- MakeMaker postamble section: + + +# End. diff --git a/File-Fetch-0.42/Makefile.PL b/File-Fetch-0.42/Makefile.PL new file mode 100644 index 0000000..336d6ff --- /dev/null +++ b/File-Fetch-0.42/Makefile.PL @@ -0,0 +1,56 @@ +use ExtUtils::MakeMaker; +use strict; + +WriteMakefile1( + LICENSE => 'perl', + META_MERGE => { + resources => { + repository => 'https://github.com/jib/file-fetch', + }, + }, + #BUILD_REQUIRES => { + #}, + + NAME => 'File::Fetch', + VERSION_FROM => 'lib/File/Fetch.pm', # finds $VERSION + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz' }, + PREREQ_PM => { + 'IPC::Cmd' => 0.42, # ipc::open3 bugfix + 'Test::More' => 0, + 'File::Copy' => 0, + 'File::Spec' => 0.82, + 'File::Path' => 0, + 'File::Basename' => 0, + 'Params::Check' => 0.07, + 'Module::Load::Conditional' => 0.04, + 'Locale::Maketext::Simple' => 0, + }, + INSTALLDIRS => ( $] >= 5.009005 ? 'perl' : 'site' ), + AUTHOR => 'Jos Boumans <kane[at]cpan.org>', + ABSTRACT => 'Generic file fetching code', + clean => {FILES => 't/tmp'}, +); + +sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade. + my %params=@_; + my $eumm_version=$ExtUtils::MakeMaker::VERSION; + $eumm_version=eval $eumm_version; + die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; + die "License not specified" if not exists $params{LICENSE}; + if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { + #EUMM 6.5502 has problems with BUILD_REQUIRES + $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; + delete $params{BUILD_REQUIRES}; + } + delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; + delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; + delete $params{META_MERGE} if $eumm_version < 6.46; + delete $params{META_ADD} if $eumm_version < 6.46; + delete $params{LICENSE} if $eumm_version < 6.31; + delete $params{AUTHOR} if $] < 5.005; + delete $params{ABSTRACT_FROM} if $] < 5.005; + delete $params{BINARY_LOCATION} if $] < 5.005; + + WriteMakefile(%params); +} + diff --git a/File-Fetch-0.42/README b/File-Fetch-0.42/README new file mode 100644 index 0000000..84a6a63 --- /dev/null +++ b/File-Fetch-0.42/README @@ -0,0 +1,40 @@ +This is the README file for File::Fetch, a perl module for generic +file fetching. + +Please refer to 'perldoc File::Fetch' after installation for details. + +##################################################################### + +* Description + +File::Fetch + + File::Fetch is a generic file fetching mechanism. + + It allows you to fetch any file pointed to by a ftp, http + or file uri by a number of different means. + +##################################################################### + +* Installation + +File::Fetch follows the standard perl module install process + +perl Makefile.PL +make +make test +make install + +The module uses no C or XS parts, so no c-compiler is required. + +###################################################################### + +AUTHOR + This module by Jos Boumans <kane@xxxxxxxx>. + +COPYRIGHT + This module is copyright (c) 2002 Jos Boumans <kane@xxxxxxxx>. All + rights reserved. + + This library is free software; you may redistribute and/or modify it + under the same terms as Perl itself. diff --git a/File-Fetch-0.42/blib/arch/.exists b/File-Fetch-0.42/blib/arch/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.42/blib/arch/auto/File/Fetch/.exists b/File-Fetch-0.42/blib/arch/auto/File/Fetch/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.42/blib/bin/.exists b/File-Fetch-0.42/blib/bin/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.42/blib/lib/File/.exists b/File-Fetch-0.42/blib/lib/File/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.42/blib/lib/File/Fetch.pm b/File-Fetch-0.42/blib/lib/File/Fetch.pm new file mode 100644 index 0000000..75e42c6 --- /dev/null +++ b/File-Fetch-0.42/blib/lib/File/Fetch.pm @@ -0,0 +1,1708 @@ +package File::Fetch; + +use strict; +use FileHandle; +use File::Temp; +use File::Copy; +use File::Spec; +use File::Spec::Unix; +use File::Basename qw[dirname]; + +use Cwd qw[cwd]; +use Carp qw[carp]; +use IPC::Cmd qw[can_run run QUOTE]; +use File::Path qw[mkpath]; +use File::Temp qw[tempdir]; +use Params::Check qw[check]; +use Module::Load::Conditional qw[can_load]; +use Locale::Maketext::Simple Style => 'gettext'; + +use vars qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT + $BLACKLIST $METHOD_FAIL $VERSION $METHODS + $FTP_PASSIVE $TIMEOUT $DEBUG $WARN + ]; + +$VERSION = '0.42'; +$VERSION = eval $VERSION; # avoid warnings with development releases +$PREFER_BIN = 0; # XXX TODO implement +$FROM_EMAIL = 'File-Fetch@xxxxxxxxxxx'; +$USER_AGENT = "File::Fetch/$VERSION"; +$BLACKLIST = [qw|ftp|]; +$METHOD_FAIL = { }; +$FTP_PASSIVE = 1; +$TIMEOUT = 0; +$DEBUG = 0; +$WARN = 1; + +### methods available to fetch the file depending on the scheme +$METHODS = { + http => [ qw|lwp httptiny wget curl lftp fetch httplite lynx iosock| ], + ftp => [ qw|lwp netftp wget curl lftp fetch ncftp ftp| ], + file => [ qw|lwp lftp file| ], + rsync => [ qw|rsync| ], + git => [ qw|git| ], +}; + +### silly warnings ### +local $Params::Check::VERBOSE = 1; +local $Params::Check::VERBOSE = 1; +local $Module::Load::Conditional::VERBOSE = 0; +local $Module::Load::Conditional::VERBOSE = 0; + +### see what OS we are on, important for file:// uris ### +use constant ON_WIN => ($^O eq 'MSWin32'); +use constant ON_VMS => ($^O eq 'VMS'); +use constant ON_UNIX => (!ON_WIN); +use constant HAS_VOL => (ON_WIN); +use constant HAS_SHARE => (ON_WIN); +use constant HAS_FETCH => ( $^O =~ m!^(freebsd|netbsd|dragonfly)$! ); + +=pod + +=head1 NAME + +File::Fetch - A generic file fetching mechanism + +=head1 SYNOPSIS + + use File::Fetch; + + ### build a File::Fetch object ### + my $ff = File::Fetch->new(uri => 'http://some.where.com/dir/a.txt'); + + ### fetch the uri to cwd() ### + my $where = $ff->fetch() or die $ff->error; + + ### fetch the uri to /tmp ### + my $where = $ff->fetch( to => '/tmp' ); + + ### parsed bits from the uri ### + $ff->uri; + $ff->scheme; + $ff->host; + $ff->path; + $ff->file; + +=head1 DESCRIPTION + +File::Fetch is a generic file fetching mechanism. + +It allows you to fetch any file pointed to by a C<ftp>, C<http>, +C<file>, C<git> or C<rsync> uri by a number of different means. + +See the C<HOW IT WORKS> section further down for details. + +=head1 ACCESSORS + +A C<File::Fetch> object has the following accessors + +=over 4 + +=item $ff->uri + +The uri you passed to the constructor + +=item $ff->scheme + +The scheme from the uri (like 'file', 'http', etc) + +=item $ff->host + +The hostname in the uri. Will be empty if host was originally +'localhost' for a 'file://' url. + +=item $ff->vol + +On operating systems with the concept of a volume the second element +of a file:// is considered to the be volume specification for the file. +Thus on Win32 this routine returns the volume, on other operating +systems this returns nothing. + +On Windows this value may be empty if the uri is to a network share, in +which case the 'share' property will be defined. Additionally, volume +specifications that use '|' as ':' will be converted on read to use ':'. + +On VMS, which has a volume concept, this field will be empty because VMS +file specifications are converted to absolute UNIX format and the volume +information is transparently included. + +=item $ff->share + +On systems with the concept of a network share (currently only Windows) returns +the sharename from a file://// url. On other operating systems returns empty. + +=item $ff->path + +The path from the uri, will be at least a single '/'. + +=item $ff->file + +The name of the remote file. For the local file name, the +result of $ff->output_file will be used. + +=item $ff->file_default + +The name of the default local file, that $ff->output_file falls back to if +it would otherwise return no filename. For example when fetching a URI like +http://www.abc.net.au/ the contents retrieved may be from a remote file called +'index.html'. The default value of this attribute is literally 'file_default'. + +=cut + + +########################## +### Object & Accessors ### +########################## + +{ + ### template for autogenerated accessors ### + my $Tmpl = { + scheme => { default => 'http' }, + host => { default => 'localhost' }, + path => { default => '/' }, + file => { required => 1 }, + uri => { required => 1 }, + vol => { default => '' }, # windows for file:// uris + share => { default => '' }, # windows for file:// uris + file_default => { default => 'file_default' }, + tempdir_root => { required => 1 }, # Should be lazy-set at ->new() + _error_msg => { no_override => 1 }, + _error_msg_long => { no_override => 1 }, + }; + + for my $method ( keys %$Tmpl ) { + no strict 'refs'; + *$method = sub { + my $self = shift; + $self->{$method} = $_[0] if @_; + return $self->{$method}; + } + } + + sub _create { + my $class = shift; + my %hash = @_; + + my $args = check( $Tmpl, \%hash ) or return; + + bless $args, $class; + + if( lc($args->scheme) ne 'file' and not $args->host ) { + return $class->_error(loc( + "Hostname required when fetching from '%1'",$args->scheme)); + } + + for (qw[path]) { + unless( $args->$_() ) { # 5.5.x needs the () + return $class->_error(loc("No '%1' specified",$_)); + } + } + + return $args; + } +} + +=item $ff->output_file + +The name of the output file. This is the same as $ff->file, +but any query parameters are stripped off. For example: + + http://example.com/index.html?x=y + +would make the output file be C<index.html> rather than +C<index.html?x=y>. + +=back + +=cut + +sub output_file { + my $self = shift; + my $file = $self->file; + + $file =~ s/\?.*$//g; + + $file ||= $self->file_default; + + return $file; +} + +### XXX do this or just point to URI::Escape? +# =head2 $esc_uri = $ff->escaped_uri +# +# =cut +# +# ### most of this is stolen straight from URI::escape +# { ### Build a char->hex map +# my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255; +# +# sub escaped_uri { +# my $self = shift; +# my $uri = $self->uri; +# +# ### Default unsafe characters. RFC 2732 ^(uric - reserved) +# $uri =~ s/([^A-Za-z0-9\-_.!~*'()])/ +# $escapes{$1} || $self->_fail_hi($1)/ge; +# +# return $uri; +# } +# +# sub _fail_hi { +# my $self = shift; +# my $char = shift; +# +# $self->_error(loc( +# "Can't escape '%1', try using the '%2' module instead", +# sprintf("\\x{%04X}", ord($char)), 'URI::Escape' +# )); +# } +# +# sub output_file { +# +# } +# +# +# } + +=head1 METHODS + +=head2 $ff = File::Fetch->new( uri => 'http://some.where.com/dir/file.txt' ); + +Parses the uri and creates a corresponding File::Fetch::Item object, +that is ready to be C<fetch>ed and returns it. + +Returns false on failure. + +=cut + +sub new { + my $class = shift; + my %hash = @_; + + my ($uri, $file_default, $tempdir_root); + my $tmpl = { + uri => { required => 1, store => \$uri }, + file_default => { required => 0, store => \$file_default }, + tempdir_root => { required => 0, store => \$tempdir_root }, + }; + + check( $tmpl, \%hash ) or return; + + ### parse the uri to usable parts ### + my $href = $class->_parse_uri( $uri ) or return; + + $href->{file_default} = $file_default if $file_default; + $href->{tempdir_root} = File::Spec->rel2abs( $tempdir_root ) if $tempdir_root; + $href->{tempdir_root} = File::Spec->rel2abs( Cwd::cwd ) if not $href->{tempdir_root}; + + ### make it into a FFI object ### + my $ff = $class->_create( %$href ) or return; + + + ### return the object ### + return $ff; +} + +### parses an uri to a hash structure: +### +### $class->_parse_uri( 'ftp://ftp.cpan.org/pub/mirror/index.txt' ) +### +### becomes: +### +### $href = { +### scheme => 'ftp', +### host => 'ftp.cpan.org', +### path => '/pub/mirror', +### file => 'index.html' +### }; +### +### In the case of file:// urls there maybe be additional fields +### +### For systems with volume specifications such as Win32 there will be +### a volume specifier provided in the 'vol' field. +### +### 'vol' => 'volumename' +### +### For windows file shares there may be a 'share' key specified +### +### 'share' => 'sharename' +### +### Note that the rules of what a file:// url means vary by the operating system +### of the host being addressed. Thus file:///d|/foo/bar.txt means the obvious +### 'D:\foo\bar.txt' on windows, but on unix it means '/d|/foo/bar.txt' and +### not '/foo/bar.txt' +### +### Similarly if the host interpreting the url is VMS then +### file:///disk$user/my/notes/note12345.txt' means +### 'DISK$USER:[MY.NOTES]NOTE123456.TXT' but will be returned the same as +### if it is unix where it means /disk$user/my/notes/note12345.txt'. +### Except for some cases in the File::Spec methods, Perl on VMS will generally +### handle UNIX format file specifications. +### +### This means it is impossible to serve certain file:// urls on certain systems. +### +### Thus are the problems with a protocol-less specification. :-( +### + +sub _parse_uri { + my $self = shift; + my $uri = shift or return; + + my $href = { uri => $uri }; + + ### find the scheme ### + $uri =~ s|^(\w+)://||; + $href->{scheme} = $1; + + ### See rfc 1738 section 3.10 + ### http://www.faqs.org/rfcs/rfc1738.html + ### And wikipedia for more on windows file:// urls + ### http://en.wikipedia.org/wiki/File:// + if( $href->{scheme} eq 'file' ) { + + my @parts = split '/',$uri; + + ### file://hostname/... + ### file://hostname/... + ### normalize file://localhost with file:/// + $href->{host} = $parts[0] || ''; + + ### index in @parts where the path components begin; + my $index = 1; + + ### file:////hostname/sharename/blah.txt + if ( HAS_SHARE and not length $parts[0] and not length $parts[1] ) { + + $href->{host} = $parts[2] || ''; # avoid warnings + $href->{share} = $parts[3] || ''; # avoid warnings + + $index = 4 # index after the share + + ### file:///D|/blah.txt + ### file:///D:/blah.txt + } elsif (HAS_VOL) { + + ### this code comes from dmq's patch, but: + ### XXX if volume is empty, wouldn't that be an error? --kane + ### if so, our file://localhost test needs to be fixed as wel + $href->{vol} = $parts[1] || ''; + + ### correct D| style colume descriptors + $href->{vol} =~ s/\A([A-Z])\|\z/$1:/i if ON_WIN; + + $index = 2; # index after the volume + } + + ### rebuild the path from the leftover parts; + $href->{path} = join '/', '', splice( @parts, $index, $#parts ); + + } else { + ### using anything but qw() in hash slices may produce warnings + ### in older perls :-( + @{$href}{ qw(host path) } = $uri =~ m|([^/]*)(/.*)$|s; + } + + ### split the path into file + dir ### + { my @parts = File::Spec::Unix->splitpath( delete $href->{path} ); + $href->{path} = $parts[1]; + $href->{file} = $parts[2]; + } + + ### host will be empty if the target was 'localhost' and the + ### scheme was 'file' + $href->{host} = '' if ($href->{host} eq 'localhost') and + ($href->{scheme} eq 'file'); + + return $href; +} + +=head2 $where = $ff->fetch( [to => /my/output/dir/ | \$scalar] ) + +Fetches the file you requested and returns the full path to the file. + +By default it writes to C<cwd()>, but you can override that by specifying +the C<to> argument: + + ### file fetch to /tmp, full path to the file in $where + $where = $ff->fetch( to => '/tmp' ); + + ### file slurped into $scalar, full path to the file in $where + ### file is downloaded to a temp directory and cleaned up at exit time + $where = $ff->fetch( to => \$scalar ); + +Returns the full path to the downloaded file on success, and false +on failure. + +=cut + +sub fetch { + my $self = shift or return; + my %hash = @_; + + my $target; + my $tmpl = { + to => { default => cwd(), store => \$target }, + }; + + check( $tmpl, \%hash ) or return; + + my ($to, $fh); + ### you want us to slurp the contents + if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) { + $to = tempdir( 'FileFetch.XXXXXX', DIR => $self->tempdir_root, CLEANUP => 1 ); + + ### plain old fetch + } else { + $to = $target; + + ### On VMS force to VMS format so File::Spec will work. + $to = VMS::Filespec::vmspath($to) if ON_VMS; + + ### create the path if it doesn't exist yet ### + unless( -d $to ) { + eval { mkpath( $to ) }; + + return $self->_error(loc("Could not create path '%1'",$to)) if $@; + } + } + + ### set passive ftp if required ### + local $ENV{FTP_PASSIVE} = $FTP_PASSIVE; + + ### we dont use catfile on win32 because if we are using a cygwin tool + ### under cmd.exe they wont understand windows style separators. + my $out_to = ON_WIN ? $to.'/'.$self->output_file + : File::Spec->catfile( $to, $self->output_file ); + + for my $method ( @{ $METHODS->{$self->scheme} } ) { + my $sub = '_'.$method.'_fetch'; + + unless( __PACKAGE__->can($sub) ) { + $self->_error(loc("Cannot call method for '%1' -- WEIRD!", + $method)); + next; + } + + ### method is blacklisted ### + next if grep { lc $_ eq $method } @$BLACKLIST; + + ### method is known to fail ### + next if $METHOD_FAIL->{$method}; + + ### there's serious issues with IPC::Run and quoting of command + ### line arguments. using quotes in the wrong place breaks things, + ### and in the case of say, + ### C:\cygwin\bin\wget.EXE --quiet --passive-ftp --output-document + ### "index.html" "http://www.cpan.org/index.html?q=1&y=2" + ### it doesn't matter how you quote, it always fails. + local $IPC::Cmd::USE_IPC_RUN = 0; + + if( my $file = $self->$sub( + to => $out_to + )){ + + unless( -e $file && -s _ ) { + $self->_error(loc("'%1' said it fetched '%2', ". + "but it was not created",$method,$file)); + + ### mark the failure ### + $METHOD_FAIL->{$method} = 1; + + next; + + } else { + + ### slurp mode? + if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) { + + ### open the file + open my $fh, "<$file" or do { + $self->_error( + loc("Could not open '%1': %2", $file, $!)); + return; + }; + + ### slurp + $$target = do { local $/; <$fh> }; + + } + + my $abs = File::Spec->rel2abs( $file ); + return $abs; + + } + } + } + + + ### if we got here, we looped over all methods, but we weren't able + ### to fetch it. + return; +} + +######################## +### _*_fetch methods ### +######################## + +### LWP fetching ### +sub _lwp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### modules required to download with lwp ### + my $use_list = { + LWP => '0.0', + 'LWP::UserAgent' => '0.0', + 'HTTP::Request' => '0.0', + 'HTTP::Status' => '0.0', + URI => '0.0', + + }; + + unless( can_load( modules => $use_list ) ) { + $METHOD_FAIL->{'lwp'} = 1; + return; + } + + ### setup the uri object + my $uri = URI->new( File::Spec::Unix->catfile( + $self->path, $self->file + ) ); + + ### special rules apply for file:// uris ### + $uri->scheme( $self->scheme ); + $uri->host( $self->scheme eq 'file' ? '' : $self->host ); + $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file'; + + ### set up the useragent object + my $ua = LWP::UserAgent->new(); + $ua->timeout( $TIMEOUT ) if $TIMEOUT; + $ua->agent( $USER_AGENT ); + $ua->from( $FROM_EMAIL ); + $ua->env_proxy; + + my $res = $ua->mirror($uri, $to) or return; + + ### uptodate or fetched ok ### + if ( $res->code == 304 or $res->code == 200 ) { + return $to; + + } else { + return $self->_error(loc("Fetch failed! HTTP response: %1 %2 [%3]", + $res->code, HTTP::Status::status_message($res->code), + $res->status_line)); + } + +} + +### HTTP::Tiny fetching ### +sub _httptiny_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + my $use_list = { + 'HTTP::Tiny' => '0.008', + + }; + + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'httptiny'} = 1; + return; + } + + my $uri = $self->uri; + + my $http = HTTP::Tiny->new( ( $TIMEOUT ? ( timeout => $TIMEOUT ) : () ) ); + + my $rc = $http->mirror( $uri, $to ); + + unless ( $rc->{success} ) { + + return $self->_error(loc( "Fetch failed! HTTP response: %1 [%2]", + $rc->{status}, $rc->{reason} ) ); + + } + + return $to; + +} + +### HTTP::Lite fetching ### +sub _httplite_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### modules required to download with lwp ### + my $use_list = { + 'HTTP::Lite' => '2.2', + + }; + + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'httplite'} = 1; + return; + } + + my $uri = $self->uri; + my $retries = 0; + + RETRIES: while ( $retries++ < 5 ) { + + my $http = HTTP::Lite->new(); + # Naughty naughty but there isn't any accessor/setter + $http->{timeout} = $TIMEOUT if $TIMEOUT; + $http->http11_mode(1); + + my $fh = FileHandle->new; + + unless ( $fh->open($to,'>') ) { + return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + } + + $fh->autoflush(1); + + binmode $fh; + + my $rc = $http->request( $uri, sub { my ($self,$dref,$cbargs) = @_; local $\; print {$cbargs} $$dref }, $fh ); + + close $fh; + + if ( $rc == 301 || $rc == 302 ) { + my $loc; + HEADERS: for ($http->headers_array) { + /Location: (\S+)/ and $loc = $1, last HEADERS; + } + #$loc or last; # Think we should squeal here. + if ($loc =~ m!^/!) { + $uri =~ s{^(\w+?://[^/]+)/.*$}{$1}; + $uri .= $loc; + } + else { + $uri = $loc; + } + next RETRIES; + } + elsif ( $rc == 200 ) { + return $to; + } + else { + return $self->_error(loc("Fetch failed! HTTP response: %1 [%2]", + $rc, $http->status_message)); + } + + } # Loop for 5 retries. + + return $self->_error("Fetch failed! Gave up after 5 tries"); + +} + +### Simple IO::Socket::INET fetching ### +sub _iosock_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + my $use_list = { + 'IO::Socket::INET' => '0.0', + 'IO::Select' => '0.0', + }; + + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'iosock'} = 1; + return; + } + + my $sock = IO::Socket::INET->new( + PeerHost => $self->host, + ( $self->host =~ /:/ ? () : ( PeerPort => 80 ) ), + ); + + unless ( $sock ) { + return $self->_error(loc("Could not open socket to '%1', '%2'",$self->host,$!)); + } + + my $fh = FileHandle->new; + + # Check open() + + unless ( $fh->open($to,'>') ) { + return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + } + + $fh->autoflush(1); + binmode $fh; + + my $path = File::Spec::Unix->catfile( $self->path, $self->file ); + my $req = "GET $path HTTP/1.0\x0d\x0aHost: " . $self->host . "\x0d\x0a\x0d\x0a"; + $sock->send( $req ); + + my $select = IO::Select->new( $sock ); + + my $resp = ''; + my $normal = 0; + while ( $select->can_read( $TIMEOUT || 60 ) ) { + my $ret = $sock->sysread( $resp, 4096, length($resp) ); + if ( !defined $ret or $ret == 0 ) { + $select->remove( $sock ); + $normal++; + } + } + close $sock; + + unless ( $normal ) { + return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 ))); + } + + # Check the "response" + # Strip preceding blank lines apparently they are allowed (RFC 2616 4.1) + $resp =~ s/^(\x0d?\x0a)+//; + # Check it is an HTTP response + unless ( $resp =~ m!^HTTP/(\d+)\.(\d+)!i ) { + return $self->_error(loc("Did not get a HTTP response from '%1'",$self->host)); + } + + # Check for OK + my ($code) = $resp =~ m!^HTTP/\d+\.\d+\s+(\d+)!i; + unless ( $code eq '200' ) { + return $self->_error(loc("Got a '%1' from '%2' expected '200'",$code,$self->host)); + } + + { + local $\; + print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0]; + } + close $fh; + return $to; +} + +### Net::FTP fetching +sub _netftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### required modules ### + my $use_list = { 'Net::FTP' => 0 }; + + unless( can_load( modules => $use_list ) ) { + $METHOD_FAIL->{'netftp'} = 1; + return; + } + + ### make connection ### + my $ftp; + my @options = ($self->host); + push(@options, Timeout => $TIMEOUT) if $TIMEOUT; + unless( $ftp = Net::FTP->new( @options ) ) { + return $self->_error(loc("Ftp creation failed: %1",$@)); + } + + ### login ### + unless( $ftp->login( anonymous => $FROM_EMAIL ) ) { + return $self->_error(loc("Could not login to '%1'",$self->host)); + } + + ### set binary mode, just in case ### + $ftp->binary; + + ### create the remote path + ### remember remote paths are unix paths! [#11483] + my $remote = File::Spec::Unix->catfile( $self->path, $self->file ); + + ### fetch the file ### + my $target; + unless( $target = $ftp->get( $remote, $to ) ) { + return $self->_error(loc("Could not fetch '%1' from '%2'", + $remote, $self->host)); + } + + ### log out ### + $ftp->quit; + + return $target; + +} + +### /bin/wget fetch ### +sub _wget_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + my $wget; + ### see if we have a wget binary ### + unless( $wget = can_run('wget') ) { + $METHOD_FAIL->{'wget'} = 1; + return; + } + + ### no verboseness, thanks ### + my $cmd = [ $wget, '--quiet' ]; + + ### if a timeout is set, add it ### + push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; + + ### run passive if specified ### + push @$cmd, '--passive-ftp' if $FTP_PASSIVE; + + ### set the output document, add the uri ### + push @$cmd, '--output-document', $to, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; + + return $self->_error(loc( "Command failed: %1", $captured || '' )); + } + + return $to; +} + +### /bin/lftp fetch ### +sub _lftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a lftp binary ### + my $lftp; + unless( $lftp = can_run('lftp') ) { + $METHOD_FAIL->{'lftp'} = 1; + return; + } + + ### no verboseness, thanks ### + my $cmd = [ $lftp, '-f' ]; + + my $fh = File::Temp->new; + + my $str; + + ### if a timeout is set, add it ### + $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT; + + ### run passive if specified ### + $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE; + + ### set the output document, add the uri ### + ### quote the URI, because lftp supports certain shell + ### expansions, most notably & for backgrounding. + ### ' quote does nto work, must be " + $str .= q[get ']. $self->uri .q[' -o ]. $to . $/; + + if( $DEBUG ) { + my $pp_str = join ' ', split $/, $str; + print "# lftp command: $pp_str\n"; + } + + ### write straight to the file. + $fh->autoflush(1); + print $fh $str; + + ### the command needs to be 1 string to be executed + push @$cmd, $fh->filename; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; + + return $self->_error(loc( "Command failed: %1", $captured || '' )); + } + + return $to; +} + + + +### /bin/ftp fetch ### +sub _ftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a ftp binary ### + my $ftp; + unless( $ftp = can_run('ftp') ) { + $METHOD_FAIL->{'ftp'} = 1; + return; + } + + my $fh = FileHandle->new; + + local $SIG{CHLD} = 'IGNORE'; + + unless ($fh->open("$ftp -n", '|-')) { + return $self->_error(loc("%1 creation failed: %2", $ftp, $!)); + } + + my @dialog = ( + "lcd " . dirname($to), + "open " . $self->host, + "user anonymous $FROM_EMAIL", + "cd /", + "cd " . $self->path, + "binary", + "get " . $self->file . " " . $self->output_file, + "quit", + ); + + foreach (@dialog) { $fh->print($_, "\n") } + $fh->close or return; + + return $to; +} + +### lynx is stupid - it decompresses any .gz file it finds to be text +### use /bin/lynx to fetch files +sub _lynx_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a lynx binary ### + my $lynx; + unless ( $lynx = can_run('lynx') ){ + $METHOD_FAIL->{'lynx'} = 1; + return; + } + + unless( IPC::Cmd->can_capture_buffer ) { + $METHOD_FAIL->{'lynx'} = 1; + + return $self->_error(loc( + "Can not capture buffers. Can not use '%1' to fetch files", + 'lynx' )); + } + + ### check if the HTTP resource exists ### + if ($self->uri =~ /^https?:\/\//i) { + my $cmd = [ + $lynx, + '-head', + '-source', + "-auth=anonymous:$FROM_EMAIL", + ]; + + push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT; + + push @$cmd, $self->uri; + + ### shell out ### + my $head; + unless(run( command => $cmd, + buffer => \$head, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $head || '')); + } + + unless($head =~ /^HTTP\/\d+\.\d+ 200\b/) { + return $self->_error(loc("Command failed: %1", $head || '')); + } + } + + ### write to the output file ourselves, since lynx ass_u_mes to much + my $local = FileHandle->new( $to, 'w' ) + or return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + + ### dump to stdout ### + my $cmd = [ + $lynx, + '-source', + "-auth=anonymous:$FROM_EMAIL", + ]; + + push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT; + + ### DO NOT quote things for IPC::Run, it breaks stuff. + push @$cmd, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? $self->uri + # : QUOTE. $self->uri .QUOTE; + + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $captured || '')); + } + + ### print to local file ### + ### XXX on a 404 with a special error page, $captured will actually + ### hold the contents of that page, and make it *appear* like the + ### request was a success, when really it wasn't :( + ### there doesn't seem to be an option for lynx to change the exit + ### code based on a 4XX status or so. + ### the closest we can come is using --error_file and parsing that, + ### which is very unreliable ;( + $local->print( $captured ); + $local->close or return; + + return $to; +} + +### use /bin/ncftp to fetch files +sub _ncftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### we can only set passive mode in interactive sessions, so bail out + ### if $FTP_PASSIVE is set + return if $FTP_PASSIVE; + + ### see if we have a ncftp binary ### + my $ncftp; + unless( $ncftp = can_run('ncftp') ) { + $METHOD_FAIL->{'ncftp'} = 1; + return; + } + + my $cmd = [ + $ncftp, + '-V', # do not be verbose + '-p', $FROM_EMAIL, # email as password + $self->host, # hostname + dirname($to), # local dir for the file + # remote path to the file + ### DO NOT quote things for IPC::Run, it breaks stuff. + $IPC::Cmd::USE_IPC_RUN + ? File::Spec::Unix->catdir( $self->path, $self->file ) + : QUOTE. File::Spec::Unix->catdir( + $self->path, $self->file ) .QUOTE + + ]; + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $captured || '')); + } + + return $to; + +} + +### use /bin/curl to fetch files +sub _curl_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + my $curl; + unless ( $curl = can_run('curl') ) { + $METHOD_FAIL->{'curl'} = 1; + return; + } + + ### these long opts are self explanatory - I like that -jmb + my $cmd = [ $curl, '-q' ]; + + push(@$cmd, '--connect-timeout', $TIMEOUT) if $TIMEOUT; + + push(@$cmd, '--silent') unless $DEBUG; + + ### curl does the right thing with passive, regardless ### + if ($self->scheme eq 'ftp') { + push(@$cmd, '--user', "anonymous:$FROM_EMAIL"); + } + + ### curl doesn't follow 302 (temporarily moved) etc automatically + ### so we add --location to enable that. + push @$cmd, '--fail', '--location', '--output', $to, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + + return $self->_error(loc("Command failed: %1", $captured || '')); + } + + return $to; + +} + +### /usr/bin/fetch fetch! ### +sub _fetch_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a fetch binary ### + my $fetch; + unless( HAS_FETCH and $fetch = can_run('fetch') ) { + $METHOD_FAIL->{'fetch'} = 1; + return; + } + + ### no verboseness, thanks ### + my $cmd = [ $fetch, '-q' ]; + + ### if a timeout is set, add it ### + push(@$cmd, '-T', $TIMEOUT) if $TIMEOUT; + + ### run passive if specified ### + #push @$cmd, '-p' if $FTP_PASSIVE; + local $ENV{'FTP_PASSIVE_MODE'} = 1 if $FTP_PASSIVE; + + ### set the output document, add the uri ### + push @$cmd, '-o', $to, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; + + return $self->_error(loc( "Command failed: %1", $captured || '' )); + } + + return $to; +} + +### use File::Copy for fetching file:// urls ### +### +### See section 3.10 of RFC 1738 (http://www.faqs.org/rfcs/rfc1738.html) +### Also see wikipedia on file:// (http://en.wikipedia.org/wiki/File://) +### + +sub _file_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + + + ### prefix a / on unix systems with a file uri, since it would + ### look somewhat like this: + ### file:///home/kane/file + ### whereas windows file uris for 'c:\some\dir\file' might look like: + ### file:///C:/some/dir/file + ### file:///C|/some/dir/file + ### or for a network share '\\host\share\some\dir\file': + ### file:////host/share/some/dir/file + ### + ### VMS file uri's for 'DISK$USER:[MY.NOTES]NOTE123456.TXT' might look like: + ### file://vms.host.edu/disk$user/my/notes/note12345.txt + ### + + my $path = $self->path; + my $vol = $self->vol; + my $share = $self->share; + + my $remote; + if (!$share and $self->host) { + return $self->_error(loc( + "Currently %1 cannot handle hosts in %2 urls", + 'File::Fetch', 'file://' + )); + } + + if( $vol ) { + $path = File::Spec->catdir( split /\//, $path ); + $remote = File::Spec->catpath( $vol, $path, $self->file); + + } elsif( $share ) { + ### win32 specific, and a share name, so we wont bother with File::Spec + $path =~ s|/+|\\|g; + $remote = "\\\\".$self->host."\\$share\\$path"; + + } else { + ### File::Spec on VMS can not currently handle UNIX syntax. + my $file_class = ON_VMS + ? 'File::Spec::Unix' + : 'File::Spec'; + + $remote = $file_class->catfile( $path, $self->file ); + } + + ### File::Copy is littered with 'die' statements :( ### + my $rv = eval { File::Copy::copy( $remote, $to ) }; + + ### something went wrong ### + if( !$rv or $@ ) { + return $self->_error(loc("Could not copy '%1' to '%2': %3 %4", + $remote, $to, $!, $@)); + } + + return $to; +} + +### use /usr/bin/rsync to fetch files +sub _rsync_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + my $rsync; + unless ( $rsync = can_run('rsync') ) { + $METHOD_FAIL->{'rsync'} = 1; + return; + } + + my $cmd = [ $rsync ]; + + ### XXX: rsync has no I/O timeouts at all, by default + push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; + + push(@$cmd, '--quiet') unless $DEBUG; + + ### DO NOT quote things for IPC::Run, it breaks stuff. + push @$cmd, $self->uri, $to; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + + return $self->_error(loc("Command %1 failed: %2", + "@$cmd" || '', $captured || '')); + } + + return $to; + +} + +### use git to fetch files +sub _git_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + my $git; + unless ( $git = can_run('git') ) { + $METHOD_FAIL->{'git'} = 1; + return; + } + + my $cmd = [ $git, 'clone' ]; + + #push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; + + push(@$cmd, '--quiet') unless $DEBUG; + + ### DO NOT quote things for IPC::Run, it breaks stuff. + push @$cmd, $self->uri, $to; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + + return $self->_error(loc("Command %1 failed: %2", + "@$cmd" || '', $captured || '')); + } + + return $to; + +} + +################################# +# +# Error code +# +################################# + +=pod + +=head2 $ff->error([BOOL]) + +Returns the last encountered error as string. +Pass it a true value to get the C<Carp::longmess()> output instead. + +=cut + +### error handling the way Archive::Extract does it +sub _error { + my $self = shift; + my $error = shift; + + $self->_error_msg( $error ); + $self->_error_msg_long( Carp::longmess($error) ); + + if( $WARN ) { + carp $DEBUG ? $self->_error_msg_long : $self->_error_msg; + } + + return; +} + +sub error { + my $self = shift; + return shift() ? $self->_error_msg_long : $self->_error_msg; +} + + +1; + +=pod + +=head1 HOW IT WORKS + +File::Fetch is able to fetch a variety of uris, by using several +external programs and modules. + +Below is a mapping of what utilities will be used in what order +for what schemes, if available: + + file => LWP, lftp, file + http => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock + ftp => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp + rsync => rsync + git => git + +If you'd like to disable the use of one or more of these utilities +and/or modules, see the C<$BLACKLIST> variable further down. + +If a utility or module isn't available, it will be marked in a cache +(see the C<$METHOD_FAIL> variable further down), so it will not be +tried again. The C<fetch> method will only fail when all options are +exhausted, and it was not able to retrieve the file. + +The C<fetch> utility is available on FreeBSD. NetBSD and Dragonfly BSD +may also have it from C<pkgsrc>. We only check for C<fetch> on those +three platforms. + +C<iosock> is a very limited L<IO::Socket::INET> based mechanism for +retrieving C<http> schemed urls. It doesn't follow redirects for instance. + +C<git> only supports C<git://> style urls. + +A special note about fetching files from an ftp uri: + +By default, all ftp connections are done in passive mode. To change +that, see the C<$FTP_PASSIVE> variable further down. + +Furthermore, ftp uris only support anonymous connections, so no +named user/password pair can be passed along. + +C</bin/ftp> is blacklisted by default; see the C<$BLACKLIST> variable +further down. + +=head1 GLOBAL VARIABLES + +The behaviour of File::Fetch can be altered by changing the following +global variables: + +=head2 $File::Fetch::FROM_EMAIL + +This is the email address that will be sent as your anonymous ftp +password. + +Default is C<File-Fetch@xxxxxxxxxxx>. + +=head2 $File::Fetch::USER_AGENT + +This is the useragent as C<LWP> will report it. + +Default is C<File::Fetch/$VERSION>. + +=head2 $File::Fetch::FTP_PASSIVE + +This variable controls whether the environment variable C<FTP_PASSIVE> +and any passive switches to commandline tools will be set to true. + +Default value is 1. + +Note: When $FTP_PASSIVE is true, C<ncftp> will not be used to fetch +files, since passive mode can only be set interactively for this binary + +=head2 $File::Fetch::TIMEOUT + +When set, controls the network timeout (counted in seconds). + +Default value is 0. + +=head2 $File::Fetch::WARN + +This variable controls whether errors encountered internally by +C<File::Fetch> should be C<carp>'d or not. + +Set to false to silence warnings. Inspect the output of the C<error()> +method manually to see what went wrong. + +Defaults to C<true>. + +=head2 $File::Fetch::DEBUG + +This enables debugging output when calling commandline utilities to +fetch files. +This also enables C<Carp::longmess> errors, instead of the regular +C<carp> errors. + +Good for tracking down why things don't work with your particular +setup. + +Default is 0. + +=head2 $File::Fetch::BLACKLIST + +This is an array ref holding blacklisted modules/utilities for fetching +files with. + +To disallow the use of, for example, C<LWP> and C<Net::FTP>, you could +set $File::Fetch::BLACKLIST to: + + $File::Fetch::BLACKLIST = [qw|lwp netftp|] + +The default blacklist is [qw|ftp|], as C</bin/ftp> is rather unreliable. + +See the note on C<MAPPING> below. + +=head2 $File::Fetch::METHOD_FAIL + +This is a hashref registering what modules/utilities were known to fail +for fetching files (mostly because they weren't installed). + +You can reset this cache by assigning an empty hashref to it, or +individually remove keys. + +See the note on C<MAPPING> below. + +=head1 MAPPING + + +Here's a quick mapping for the utilities/modules, and their names for +the $BLACKLIST, $METHOD_FAIL and other internal functions. + + LWP => lwp + HTTP::Lite => httplite + HTTP::Tiny => httptiny + Net::FTP => netftp + wget => wget + lynx => lynx + ncftp => ncftp + ftp => ftp + curl => curl + rsync => rsync + lftp => lftp + fetch => fetch + IO::Socket => iosock + +=head1 FREQUENTLY ASKED QUESTIONS + +=head2 So how do I use a proxy with File::Fetch? + +C<File::Fetch> currently only supports proxies with LWP::UserAgent. +You will need to set your environment variables accordingly. For +example, to use an ftp proxy: + + $ENV{ftp_proxy} = 'foo.com'; + +Refer to the LWP::UserAgent manpage for more details. + +=head2 I used 'lynx' to fetch a file, but its contents is all wrong! + +C<lynx> can only fetch remote files by dumping its contents to C<STDOUT>, +which we in turn capture. If that content is a 'custom' error file +(like, say, a C<404 handler>), you will get that contents instead. + +Sadly, C<lynx> doesn't support any options to return a different exit +code on non-C<200 OK> status, giving us no way to tell the difference +between a 'successful' fetch and a custom error page. + +Therefor, we recommend to only use C<lynx> as a last resort. This is +why it is at the back of our list of methods to try as well. + +=head2 Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do? + +C<File::Fetch> is relatively smart about things. When trying to write +a file to disk, it removes the C<query parameters> (see the +C<output_file> method for details) from the file name before creating +it. In most cases this suffices. + +If you have any other characters you need to escape, please install +the C<URI::Escape> module from CPAN, and pre-encode your URI before +passing it to C<File::Fetch>. You can read about the details of URIs +and URI encoding here: + + http://www.faqs.org/rfcs/rfc2396.html + +=head1 TODO + +=over 4 + +=item Implement $PREFER_BIN + +To indicate to rather use commandline tools than modules + +=back + +=head1 BUG REPORTS + +Please report bugs or other issues to E<lt>bug-file-fetch@xxxxxxxxxxx<gt>. + +=head1 AUTHOR + +This module by Jos Boumans E<lt>kane@xxxxxxxxx<gt>. + +=head1 COPYRIGHT + +This library is free software; you may redistribute and/or modify it +under the same terms as Perl itself. + + +=cut + +# Local variables: +# c-indentation-style: bsd +# c-basic-offset: 4 +# indent-tabs-mode: nil +# End: +# vim: expandtab shiftwidth=4: + + + + diff --git a/File-Fetch-0.42/blib/lib/auto/File/Fetch/.exists b/File-Fetch-0.42/blib/lib/auto/File/Fetch/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.42/blib/man1/.exists b/File-Fetch-0.42/blib/man1/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.42/blib/man3/.exists b/File-Fetch-0.42/blib/man3/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.42/blib/man3/File::Fetch.3pm b/File-Fetch-0.42/blib/man3/File::Fetch.3pm new file mode 100644 index 0000000..99e311c --- /dev/null +++ b/File-Fetch-0.42/blib/man3/File::Fetch.3pm @@ -0,0 +1,459 @@ +.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.20) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "File::Fetch 3" +.TH File::Fetch 3 "2013-04-12" "perl v5.16.3" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +File::Fetch \- A generic file fetching mechanism +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.Vb 1 +\& use File::Fetch; +\& +\& ### build a File::Fetch object ### +\& my $ff = File::Fetch\->new(uri => \*(Aqhttp://some.where.com/dir/a.txt\*(Aq); +\& +\& ### fetch the uri to cwd() ### +\& my $where = $ff\->fetch() or die $ff\->error; +\& +\& ### fetch the uri to /tmp ### +\& my $where = $ff\->fetch( to => \*(Aq/tmp\*(Aq ); +\& +\& ### parsed bits from the uri ### +\& $ff\->uri; +\& $ff\->scheme; +\& $ff\->host; +\& $ff\->path; +\& $ff\->file; +.Ve +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +File::Fetch is a generic file fetching mechanism. +.PP +It allows you to fetch any file pointed to by a \f(CW\*(C`ftp\*(C'\fR, \f(CW\*(C`http\*(C'\fR, +\&\f(CW\*(C`file\*(C'\fR, \f(CW\*(C`git\*(C'\fR or \f(CW\*(C`rsync\*(C'\fR uri by a number of different means. +.PP +See the \f(CW\*(C`HOW IT WORKS\*(C'\fR section further down for details. +.SH "ACCESSORS" +.IX Header "ACCESSORS" +A \f(CW\*(C`File::Fetch\*(C'\fR object has the following accessors +.ie n .IP "$ff\->uri" 4 +.el .IP "\f(CW$ff\fR\->uri" 4 +.IX Item "$ff->uri" +The uri you passed to the constructor +.ie n .IP "$ff\->scheme" 4 +.el .IP "\f(CW$ff\fR\->scheme" 4 +.IX Item "$ff->scheme" +The scheme from the uri (like 'file', 'http', etc) +.ie n .IP "$ff\->host" 4 +.el .IP "\f(CW$ff\fR\->host" 4 +.IX Item "$ff->host" +The hostname in the uri. Will be empty if host was originally +\&'localhost' for a 'file://' url. +.ie n .IP "$ff\->vol" 4 +.el .IP "\f(CW$ff\fR\->vol" 4 +.IX Item "$ff->vol" +On operating systems with the concept of a volume the second element +of a file:// is considered to the be volume specification for the file. +Thus on Win32 this routine returns the volume, on other operating +systems this returns nothing. +.Sp +On Windows this value may be empty if the uri is to a network share, in +which case the 'share' property will be defined. Additionally, volume +specifications that use '|' as ':' will be converted on read to use ':'. +.Sp +On \s-1VMS\s0, which has a volume concept, this field will be empty because \s-1VMS\s0 +file specifications are converted to absolute \s-1UNIX\s0 format and the volume +information is transparently included. +.ie n .IP "$ff\->share" 4 +.el .IP "\f(CW$ff\fR\->share" 4 +.IX Item "$ff->share" +On systems with the concept of a network share (currently only Windows) returns +the sharename from a file://// url. On other operating systems returns empty. +.ie n .IP "$ff\->path" 4 +.el .IP "\f(CW$ff\fR\->path" 4 +.IX Item "$ff->path" +The path from the uri, will be at least a single '/'. +.ie n .IP "$ff\->file" 4 +.el .IP "\f(CW$ff\fR\->file" 4 +.IX Item "$ff->file" +The name of the remote file. For the local file name, the +result of \f(CW$ff\fR\->output_file will be used. +.ie n .IP "$ff\->file_default" 4 +.el .IP "\f(CW$ff\fR\->file_default" 4 +.IX Item "$ff->file_default" +The name of the default local file, that \f(CW$ff\fR\->output_file falls back to if +it would otherwise return no filename. For example when fetching a \s-1URI\s0 like +http://www.abc.net.au/ the contents retrieved may be from a remote file called +\&'index.html'. The default value of this attribute is literally 'file_default'. +.ie n .IP "$ff\->output_file" 4 +.el .IP "\f(CW$ff\fR\->output_file" 4 +.IX Item "$ff->output_file" +The name of the output file. This is the same as \f(CW$ff\fR\->file, +but any query parameters are stripped off. For example: +.Sp +.Vb 1 +\& http://example.com/index.html?x=y +.Ve +.Sp +would make the output file be \f(CW\*(C`index.html\*(C'\fR rather than +\&\f(CW\*(C`index.html?x=y\*(C'\fR. +.SH "METHODS" +.IX Header "METHODS" +.ie n .SS "$ff = File::Fetch\->new( uri => 'http://some.where.com/dir/file.txt' );" +.el .SS "\f(CW$ff\fP = File::Fetch\->new( uri => 'http://some.where.com/dir/file.txt' );" +.IX Subsection "$ff = File::Fetch->new( uri => 'http://some.where.com/dir/file.txt' );" +Parses the uri and creates a corresponding File::Fetch::Item object, +that is ready to be \f(CW\*(C`fetch\*(C'\fRed and returns it. +.PP +Returns false on failure. +.ie n .SS "$where = $ff\->fetch( [to => /my/output/dir/ | \e$scalar] )" +.el .SS "\f(CW$where\fP = \f(CW$ff\fP\->fetch( [to => /my/output/dir/ | \e$scalar] )" +.IX Subsection "$where = $ff->fetch( [to => /my/output/dir/ | $scalar] )" +Fetches the file you requested and returns the full path to the file. +.PP +By default it writes to \f(CW\*(C`cwd()\*(C'\fR, but you can override that by specifying +the \f(CW\*(C`to\*(C'\fR argument: +.PP +.Vb 2 +\& ### file fetch to /tmp, full path to the file in $where +\& $where = $ff\->fetch( to => \*(Aq/tmp\*(Aq ); +\& +\& ### file slurped into $scalar, full path to the file in $where +\& ### file is downloaded to a temp directory and cleaned up at exit time +\& $where = $ff\->fetch( to => \e$scalar ); +.Ve +.PP +Returns the full path to the downloaded file on success, and false +on failure. +.ie n .SS "$ff\->error([\s-1BOOL\s0])" +.el .SS "\f(CW$ff\fP\->error([\s-1BOOL\s0])" +.IX Subsection "$ff->error([BOOL])" +Returns the last encountered error as string. +Pass it a true value to get the \f(CW\*(C`Carp::longmess()\*(C'\fR output instead. +.SH "HOW IT WORKS" +.IX Header "HOW IT WORKS" +File::Fetch is able to fetch a variety of uris, by using several +external programs and modules. +.PP +Below is a mapping of what utilities will be used in what order +for what schemes, if available: +.PP +.Vb 5 +\& file => LWP, lftp, file +\& http => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock +\& ftp => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp +\& rsync => rsync +\& git => git +.Ve +.PP +If you'd like to disable the use of one or more of these utilities +and/or modules, see the \f(CW$BLACKLIST\fR variable further down. +.PP +If a utility or module isn't available, it will be marked in a cache +(see the \f(CW$METHOD_FAIL\fR variable further down), so it will not be +tried again. The \f(CW\*(C`fetch\*(C'\fR method will only fail when all options are +exhausted, and it was not able to retrieve the file. +.PP +The \f(CW\*(C`fetch\*(C'\fR utility is available on FreeBSD. NetBSD and Dragonfly \s-1BSD\s0 +may also have it from \f(CW\*(C`pkgsrc\*(C'\fR. We only check for \f(CW\*(C`fetch\*(C'\fR on those +three platforms. +.PP +\&\f(CW\*(C`iosock\*(C'\fR is a very limited IO::Socket::INET based mechanism for +retrieving \f(CW\*(C`http\*(C'\fR schemed urls. It doesn't follow redirects for instance. +.PP +\&\f(CW\*(C`git\*(C'\fR only supports \f(CW\*(C`git://\*(C'\fR style urls. +.PP +A special note about fetching files from an ftp uri: +.PP +By default, all ftp connections are done in passive mode. To change +that, see the \f(CW$FTP_PASSIVE\fR variable further down. +.PP +Furthermore, ftp uris only support anonymous connections, so no +named user/password pair can be passed along. +.PP +\&\f(CW\*(C`/bin/ftp\*(C'\fR is blacklisted by default; see the \f(CW$BLACKLIST\fR variable +further down. +.SH "GLOBAL VARIABLES" +.IX Header "GLOBAL VARIABLES" +The behaviour of File::Fetch can be altered by changing the following +global variables: +.ie n .SS "$File::Fetch::FROM_EMAIL" +.el .SS "\f(CW$File::Fetch::FROM_EMAIL\fP" +.IX Subsection "$File::Fetch::FROM_EMAIL" +This is the email address that will be sent as your anonymous ftp +password. +.PP +Default is \f(CW\*(C`File\-Fetch@xxxxxxxxxxx\*(C'\fR. +.ie n .SS "$File::Fetch::USER_AGENT" +.el .SS "\f(CW$File::Fetch::USER_AGENT\fP" +.IX Subsection "$File::Fetch::USER_AGENT" +This is the useragent as \f(CW\*(C`LWP\*(C'\fR will report it. +.PP +Default is \f(CW\*(C`File::Fetch/$VERSION\*(C'\fR. +.ie n .SS "$File::Fetch::FTP_PASSIVE" +.el .SS "\f(CW$File::Fetch::FTP_PASSIVE\fP" +.IX Subsection "$File::Fetch::FTP_PASSIVE" +This variable controls whether the environment variable \f(CW\*(C`FTP_PASSIVE\*(C'\fR +and any passive switches to commandline tools will be set to true. +.PP +Default value is 1. +.PP +Note: When \f(CW$FTP_PASSIVE\fR is true, \f(CW\*(C`ncftp\*(C'\fR will not be used to fetch +files, since passive mode can only be set interactively for this binary +.ie n .SS "$File::Fetch::TIMEOUT" +.el .SS "\f(CW$File::Fetch::TIMEOUT\fP" +.IX Subsection "$File::Fetch::TIMEOUT" +When set, controls the network timeout (counted in seconds). +.PP +Default value is 0. +.ie n .SS "$File::Fetch::WARN" +.el .SS "\f(CW$File::Fetch::WARN\fP" +.IX Subsection "$File::Fetch::WARN" +This variable controls whether errors encountered internally by +\&\f(CW\*(C`File::Fetch\*(C'\fR should be \f(CW\*(C`carp\*(C'\fR'd or not. +.PP +Set to false to silence warnings. Inspect the output of the \f(CW\*(C`error()\*(C'\fR +method manually to see what went wrong. +.PP +Defaults to \f(CW\*(C`true\*(C'\fR. +.ie n .SS "$File::Fetch::DEBUG" +.el .SS "\f(CW$File::Fetch::DEBUG\fP" +.IX Subsection "$File::Fetch::DEBUG" +This enables debugging output when calling commandline utilities to +fetch files. +This also enables \f(CW\*(C`Carp::longmess\*(C'\fR errors, instead of the regular +\&\f(CW\*(C`carp\*(C'\fR errors. +.PP +Good for tracking down why things don't work with your particular +setup. +.PP +Default is 0. +.ie n .SS "$File::Fetch::BLACKLIST" +.el .SS "\f(CW$File::Fetch::BLACKLIST\fP" +.IX Subsection "$File::Fetch::BLACKLIST" +This is an array ref holding blacklisted modules/utilities for fetching +files with. +.PP +To disallow the use of, for example, \f(CW\*(C`LWP\*(C'\fR and \f(CW\*(C`Net::FTP\*(C'\fR, you could +set \f(CW$File::Fetch::BLACKLIST\fR to: +.PP +.Vb 1 +\& $File::Fetch::BLACKLIST = [qw|lwp netftp|] +.Ve +.PP +The default blacklist is [qw|ftp|], as \f(CW\*(C`/bin/ftp\*(C'\fR is rather unreliable. +.PP +See the note on \f(CW\*(C`MAPPING\*(C'\fR below. +.ie n .SS "$File::Fetch::METHOD_FAIL" +.el .SS "\f(CW$File::Fetch::METHOD_FAIL\fP" +.IX Subsection "$File::Fetch::METHOD_FAIL" +This is a hashref registering what modules/utilities were known to fail +for fetching files (mostly because they weren't installed). +.PP +You can reset this cache by assigning an empty hashref to it, or +individually remove keys. +.PP +See the note on \f(CW\*(C`MAPPING\*(C'\fR below. +.SH "MAPPING" +.IX Header "MAPPING" +Here's a quick mapping for the utilities/modules, and their names for +the \f(CW$BLACKLIST\fR, \f(CW$METHOD_FAIL\fR and other internal functions. +.PP +.Vb 10 +\& LWP => lwp +\& HTTP::Lite => httplite +\& HTTP::Tiny => httptiny +\& Net::FTP => netftp +\& wget => wget +\& lynx => lynx +\& ncftp => ncftp +\& ftp => ftp +\& curl => curl +\& rsync => rsync +\& lftp => lftp +\& fetch => fetch +\& IO::Socket => iosock +.Ve +.SH "FREQUENTLY ASKED QUESTIONS" +.IX Header "FREQUENTLY ASKED QUESTIONS" +.SS "So how do I use a proxy with File::Fetch?" +.IX Subsection "So how do I use a proxy with File::Fetch?" +\&\f(CW\*(C`File::Fetch\*(C'\fR currently only supports proxies with LWP::UserAgent. +You will need to set your environment variables accordingly. For +example, to use an ftp proxy: +.PP +.Vb 1 +\& $ENV{ftp_proxy} = \*(Aqfoo.com\*(Aq; +.Ve +.PP +Refer to the LWP::UserAgent manpage for more details. +.SS "I used 'lynx' to fetch a file, but its contents is all wrong!" +.IX Subsection "I used 'lynx' to fetch a file, but its contents is all wrong!" +\&\f(CW\*(C`lynx\*(C'\fR can only fetch remote files by dumping its contents to \f(CW\*(C`STDOUT\*(C'\fR, +which we in turn capture. If that content is a 'custom' error file +(like, say, a \f(CW\*(C`404 handler\*(C'\fR), you will get that contents instead. +.PP +Sadly, \f(CW\*(C`lynx\*(C'\fR doesn't support any options to return a different exit +code on non\-\f(CW\*(C`200 OK\*(C'\fR status, giving us no way to tell the difference +between a 'successful' fetch and a custom error page. +.PP +Therefor, we recommend to only use \f(CW\*(C`lynx\*(C'\fR as a last resort. This is +why it is at the back of our list of methods to try as well. +.SS "Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do?" +.IX Subsection "Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do?" +\&\f(CW\*(C`File::Fetch\*(C'\fR is relatively smart about things. When trying to write +a file to disk, it removes the \f(CW\*(C`query parameters\*(C'\fR (see the +\&\f(CW\*(C`output_file\*(C'\fR method for details) from the file name before creating +it. In most cases this suffices. +.PP +If you have any other characters you need to escape, please install +the \f(CW\*(C`URI::Escape\*(C'\fR module from \s-1CPAN\s0, and pre-encode your \s-1URI\s0 before +passing it to \f(CW\*(C`File::Fetch\*(C'\fR. You can read about the details of URIs +and \s-1URI\s0 encoding here: +.PP +.Vb 1 +\& http://www.faqs.org/rfcs/rfc2396.html +.Ve +.SH "TODO" +.IX Header "TODO" +.ie n .IP "Implement $PREFER_BIN" 4 +.el .IP "Implement \f(CW$PREFER_BIN\fR" 4 +.IX Item "Implement $PREFER_BIN" +To indicate to rather use commandline tools than modules +.SH "BUG REPORTS" +.IX Header "BUG REPORTS" +Please report bugs or other issues to <bug\-file\-fetch@xxxxxxxxxxx<gt>. +.SH "AUTHOR" +.IX Header "AUTHOR" +This module by Jos Boumans <kane@xxxxxxxx>. +.SH "COPYRIGHT" +.IX Header "COPYRIGHT" +This library is free software; you may redistribute and/or modify it +under the same terms as Perl itself. diff --git a/File-Fetch-0.42/blib/script/.exists b/File-Fetch-0.42/blib/script/.exists new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.42/debugfiles.list b/File-Fetch-0.42/debugfiles.list new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.42/debuglinks.list b/File-Fetch-0.42/debuglinks.list new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.42/debugsources.list b/File-Fetch-0.42/debugsources.list new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.42/lib/File/Fetch.pm b/File-Fetch-0.42/lib/File/Fetch.pm new file mode 100644 index 0000000..75e42c6 --- /dev/null +++ b/File-Fetch-0.42/lib/File/Fetch.pm @@ -0,0 +1,1708 @@ +package File::Fetch; + +use strict; +use FileHandle; +use File::Temp; +use File::Copy; +use File::Spec; +use File::Spec::Unix; +use File::Basename qw[dirname]; + +use Cwd qw[cwd]; +use Carp qw[carp]; +use IPC::Cmd qw[can_run run QUOTE]; +use File::Path qw[mkpath]; +use File::Temp qw[tempdir]; +use Params::Check qw[check]; +use Module::Load::Conditional qw[can_load]; +use Locale::Maketext::Simple Style => 'gettext'; + +use vars qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT + $BLACKLIST $METHOD_FAIL $VERSION $METHODS + $FTP_PASSIVE $TIMEOUT $DEBUG $WARN + ]; + +$VERSION = '0.42'; +$VERSION = eval $VERSION; # avoid warnings with development releases +$PREFER_BIN = 0; # XXX TODO implement +$FROM_EMAIL = 'File-Fetch@xxxxxxxxxxx'; +$USER_AGENT = "File::Fetch/$VERSION"; +$BLACKLIST = [qw|ftp|]; +$METHOD_FAIL = { }; +$FTP_PASSIVE = 1; +$TIMEOUT = 0; +$DEBUG = 0; +$WARN = 1; + +### methods available to fetch the file depending on the scheme +$METHODS = { + http => [ qw|lwp httptiny wget curl lftp fetch httplite lynx iosock| ], + ftp => [ qw|lwp netftp wget curl lftp fetch ncftp ftp| ], + file => [ qw|lwp lftp file| ], + rsync => [ qw|rsync| ], + git => [ qw|git| ], +}; + +### silly warnings ### +local $Params::Check::VERBOSE = 1; +local $Params::Check::VERBOSE = 1; +local $Module::Load::Conditional::VERBOSE = 0; +local $Module::Load::Conditional::VERBOSE = 0; + +### see what OS we are on, important for file:// uris ### +use constant ON_WIN => ($^O eq 'MSWin32'); +use constant ON_VMS => ($^O eq 'VMS'); +use constant ON_UNIX => (!ON_WIN); +use constant HAS_VOL => (ON_WIN); +use constant HAS_SHARE => (ON_WIN); +use constant HAS_FETCH => ( $^O =~ m!^(freebsd|netbsd|dragonfly)$! ); + +=pod + +=head1 NAME + +File::Fetch - A generic file fetching mechanism + +=head1 SYNOPSIS + + use File::Fetch; + + ### build a File::Fetch object ### + my $ff = File::Fetch->new(uri => 'http://some.where.com/dir/a.txt'); + + ### fetch the uri to cwd() ### + my $where = $ff->fetch() or die $ff->error; + + ### fetch the uri to /tmp ### + my $where = $ff->fetch( to => '/tmp' ); + + ### parsed bits from the uri ### + $ff->uri; + $ff->scheme; + $ff->host; + $ff->path; + $ff->file; + +=head1 DESCRIPTION + +File::Fetch is a generic file fetching mechanism. + +It allows you to fetch any file pointed to by a C<ftp>, C<http>, +C<file>, C<git> or C<rsync> uri by a number of different means. + +See the C<HOW IT WORKS> section further down for details. + +=head1 ACCESSORS + +A C<File::Fetch> object has the following accessors + +=over 4 + +=item $ff->uri + +The uri you passed to the constructor + +=item $ff->scheme + +The scheme from the uri (like 'file', 'http', etc) + +=item $ff->host + +The hostname in the uri. Will be empty if host was originally +'localhost' for a 'file://' url. + +=item $ff->vol + +On operating systems with the concept of a volume the second element +of a file:// is considered to the be volume specification for the file. +Thus on Win32 this routine returns the volume, on other operating +systems this returns nothing. + +On Windows this value may be empty if the uri is to a network share, in +which case the 'share' property will be defined. Additionally, volume +specifications that use '|' as ':' will be converted on read to use ':'. + +On VMS, which has a volume concept, this field will be empty because VMS +file specifications are converted to absolute UNIX format and the volume +information is transparently included. + +=item $ff->share + +On systems with the concept of a network share (currently only Windows) returns +the sharename from a file://// url. On other operating systems returns empty. + +=item $ff->path + +The path from the uri, will be at least a single '/'. + +=item $ff->file + +The name of the remote file. For the local file name, the +result of $ff->output_file will be used. + +=item $ff->file_default + +The name of the default local file, that $ff->output_file falls back to if +it would otherwise return no filename. For example when fetching a URI like +http://www.abc.net.au/ the contents retrieved may be from a remote file called +'index.html'. The default value of this attribute is literally 'file_default'. + +=cut + + +########################## +### Object & Accessors ### +########################## + +{ + ### template for autogenerated accessors ### + my $Tmpl = { + scheme => { default => 'http' }, + host => { default => 'localhost' }, + path => { default => '/' }, + file => { required => 1 }, + uri => { required => 1 }, + vol => { default => '' }, # windows for file:// uris + share => { default => '' }, # windows for file:// uris + file_default => { default => 'file_default' }, + tempdir_root => { required => 1 }, # Should be lazy-set at ->new() + _error_msg => { no_override => 1 }, + _error_msg_long => { no_override => 1 }, + }; + + for my $method ( keys %$Tmpl ) { + no strict 'refs'; + *$method = sub { + my $self = shift; + $self->{$method} = $_[0] if @_; + return $self->{$method}; + } + } + + sub _create { + my $class = shift; + my %hash = @_; + + my $args = check( $Tmpl, \%hash ) or return; + + bless $args, $class; + + if( lc($args->scheme) ne 'file' and not $args->host ) { + return $class->_error(loc( + "Hostname required when fetching from '%1'",$args->scheme)); + } + + for (qw[path]) { + unless( $args->$_() ) { # 5.5.x needs the () + return $class->_error(loc("No '%1' specified",$_)); + } + } + + return $args; + } +} + +=item $ff->output_file + +The name of the output file. This is the same as $ff->file, +but any query parameters are stripped off. For example: + + http://example.com/index.html?x=y + +would make the output file be C<index.html> rather than +C<index.html?x=y>. + +=back + +=cut + +sub output_file { + my $self = shift; + my $file = $self->file; + + $file =~ s/\?.*$//g; + + $file ||= $self->file_default; + + return $file; +} + +### XXX do this or just point to URI::Escape? +# =head2 $esc_uri = $ff->escaped_uri +# +# =cut +# +# ### most of this is stolen straight from URI::escape +# { ### Build a char->hex map +# my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255; +# +# sub escaped_uri { +# my $self = shift; +# my $uri = $self->uri; +# +# ### Default unsafe characters. RFC 2732 ^(uric - reserved) +# $uri =~ s/([^A-Za-z0-9\-_.!~*'()])/ +# $escapes{$1} || $self->_fail_hi($1)/ge; +# +# return $uri; +# } +# +# sub _fail_hi { +# my $self = shift; +# my $char = shift; +# +# $self->_error(loc( +# "Can't escape '%1', try using the '%2' module instead", +# sprintf("\\x{%04X}", ord($char)), 'URI::Escape' +# )); +# } +# +# sub output_file { +# +# } +# +# +# } + +=head1 METHODS + +=head2 $ff = File::Fetch->new( uri => 'http://some.where.com/dir/file.txt' ); + +Parses the uri and creates a corresponding File::Fetch::Item object, +that is ready to be C<fetch>ed and returns it. + +Returns false on failure. + +=cut + +sub new { + my $class = shift; + my %hash = @_; + + my ($uri, $file_default, $tempdir_root); + my $tmpl = { + uri => { required => 1, store => \$uri }, + file_default => { required => 0, store => \$file_default }, + tempdir_root => { required => 0, store => \$tempdir_root }, + }; + + check( $tmpl, \%hash ) or return; + + ### parse the uri to usable parts ### + my $href = $class->_parse_uri( $uri ) or return; + + $href->{file_default} = $file_default if $file_default; + $href->{tempdir_root} = File::Spec->rel2abs( $tempdir_root ) if $tempdir_root; + $href->{tempdir_root} = File::Spec->rel2abs( Cwd::cwd ) if not $href->{tempdir_root}; + + ### make it into a FFI object ### + my $ff = $class->_create( %$href ) or return; + + + ### return the object ### + return $ff; +} + +### parses an uri to a hash structure: +### +### $class->_parse_uri( 'ftp://ftp.cpan.org/pub/mirror/index.txt' ) +### +### becomes: +### +### $href = { +### scheme => 'ftp', +### host => 'ftp.cpan.org', +### path => '/pub/mirror', +### file => 'index.html' +### }; +### +### In the case of file:// urls there maybe be additional fields +### +### For systems with volume specifications such as Win32 there will be +### a volume specifier provided in the 'vol' field. +### +### 'vol' => 'volumename' +### +### For windows file shares there may be a 'share' key specified +### +### 'share' => 'sharename' +### +### Note that the rules of what a file:// url means vary by the operating system +### of the host being addressed. Thus file:///d|/foo/bar.txt means the obvious +### 'D:\foo\bar.txt' on windows, but on unix it means '/d|/foo/bar.txt' and +### not '/foo/bar.txt' +### +### Similarly if the host interpreting the url is VMS then +### file:///disk$user/my/notes/note12345.txt' means +### 'DISK$USER:[MY.NOTES]NOTE123456.TXT' but will be returned the same as +### if it is unix where it means /disk$user/my/notes/note12345.txt'. +### Except for some cases in the File::Spec methods, Perl on VMS will generally +### handle UNIX format file specifications. +### +### This means it is impossible to serve certain file:// urls on certain systems. +### +### Thus are the problems with a protocol-less specification. :-( +### + +sub _parse_uri { + my $self = shift; + my $uri = shift or return; + + my $href = { uri => $uri }; + + ### find the scheme ### + $uri =~ s|^(\w+)://||; + $href->{scheme} = $1; + + ### See rfc 1738 section 3.10 + ### http://www.faqs.org/rfcs/rfc1738.html + ### And wikipedia for more on windows file:// urls + ### http://en.wikipedia.org/wiki/File:// + if( $href->{scheme} eq 'file' ) { + + my @parts = split '/',$uri; + + ### file://hostname/... + ### file://hostname/... + ### normalize file://localhost with file:/// + $href->{host} = $parts[0] || ''; + + ### index in @parts where the path components begin; + my $index = 1; + + ### file:////hostname/sharename/blah.txt + if ( HAS_SHARE and not length $parts[0] and not length $parts[1] ) { + + $href->{host} = $parts[2] || ''; # avoid warnings + $href->{share} = $parts[3] || ''; # avoid warnings + + $index = 4 # index after the share + + ### file:///D|/blah.txt + ### file:///D:/blah.txt + } elsif (HAS_VOL) { + + ### this code comes from dmq's patch, but: + ### XXX if volume is empty, wouldn't that be an error? --kane + ### if so, our file://localhost test needs to be fixed as wel + $href->{vol} = $parts[1] || ''; + + ### correct D| style colume descriptors + $href->{vol} =~ s/\A([A-Z])\|\z/$1:/i if ON_WIN; + + $index = 2; # index after the volume + } + + ### rebuild the path from the leftover parts; + $href->{path} = join '/', '', splice( @parts, $index, $#parts ); + + } else { + ### using anything but qw() in hash slices may produce warnings + ### in older perls :-( + @{$href}{ qw(host path) } = $uri =~ m|([^/]*)(/.*)$|s; + } + + ### split the path into file + dir ### + { my @parts = File::Spec::Unix->splitpath( delete $href->{path} ); + $href->{path} = $parts[1]; + $href->{file} = $parts[2]; + } + + ### host will be empty if the target was 'localhost' and the + ### scheme was 'file' + $href->{host} = '' if ($href->{host} eq 'localhost') and + ($href->{scheme} eq 'file'); + + return $href; +} + +=head2 $where = $ff->fetch( [to => /my/output/dir/ | \$scalar] ) + +Fetches the file you requested and returns the full path to the file. + +By default it writes to C<cwd()>, but you can override that by specifying +the C<to> argument: + + ### file fetch to /tmp, full path to the file in $where + $where = $ff->fetch( to => '/tmp' ); + + ### file slurped into $scalar, full path to the file in $where + ### file is downloaded to a temp directory and cleaned up at exit time + $where = $ff->fetch( to => \$scalar ); + +Returns the full path to the downloaded file on success, and false +on failure. + +=cut + +sub fetch { + my $self = shift or return; + my %hash = @_; + + my $target; + my $tmpl = { + to => { default => cwd(), store => \$target }, + }; + + check( $tmpl, \%hash ) or return; + + my ($to, $fh); + ### you want us to slurp the contents + if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) { + $to = tempdir( 'FileFetch.XXXXXX', DIR => $self->tempdir_root, CLEANUP => 1 ); + + ### plain old fetch + } else { + $to = $target; + + ### On VMS force to VMS format so File::Spec will work. + $to = VMS::Filespec::vmspath($to) if ON_VMS; + + ### create the path if it doesn't exist yet ### + unless( -d $to ) { + eval { mkpath( $to ) }; + + return $self->_error(loc("Could not create path '%1'",$to)) if $@; + } + } + + ### set passive ftp if required ### + local $ENV{FTP_PASSIVE} = $FTP_PASSIVE; + + ### we dont use catfile on win32 because if we are using a cygwin tool + ### under cmd.exe they wont understand windows style separators. + my $out_to = ON_WIN ? $to.'/'.$self->output_file + : File::Spec->catfile( $to, $self->output_file ); + + for my $method ( @{ $METHODS->{$self->scheme} } ) { + my $sub = '_'.$method.'_fetch'; + + unless( __PACKAGE__->can($sub) ) { + $self->_error(loc("Cannot call method for '%1' -- WEIRD!", + $method)); + next; + } + + ### method is blacklisted ### + next if grep { lc $_ eq $method } @$BLACKLIST; + + ### method is known to fail ### + next if $METHOD_FAIL->{$method}; + + ### there's serious issues with IPC::Run and quoting of command + ### line arguments. using quotes in the wrong place breaks things, + ### and in the case of say, + ### C:\cygwin\bin\wget.EXE --quiet --passive-ftp --output-document + ### "index.html" "http://www.cpan.org/index.html?q=1&y=2" + ### it doesn't matter how you quote, it always fails. + local $IPC::Cmd::USE_IPC_RUN = 0; + + if( my $file = $self->$sub( + to => $out_to + )){ + + unless( -e $file && -s _ ) { + $self->_error(loc("'%1' said it fetched '%2', ". + "but it was not created",$method,$file)); + + ### mark the failure ### + $METHOD_FAIL->{$method} = 1; + + next; + + } else { + + ### slurp mode? + if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) { + + ### open the file + open my $fh, "<$file" or do { + $self->_error( + loc("Could not open '%1': %2", $file, $!)); + return; + }; + + ### slurp + $$target = do { local $/; <$fh> }; + + } + + my $abs = File::Spec->rel2abs( $file ); + return $abs; + + } + } + } + + + ### if we got here, we looped over all methods, but we weren't able + ### to fetch it. + return; +} + +######################## +### _*_fetch methods ### +######################## + +### LWP fetching ### +sub _lwp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### modules required to download with lwp ### + my $use_list = { + LWP => '0.0', + 'LWP::UserAgent' => '0.0', + 'HTTP::Request' => '0.0', + 'HTTP::Status' => '0.0', + URI => '0.0', + + }; + + unless( can_load( modules => $use_list ) ) { + $METHOD_FAIL->{'lwp'} = 1; + return; + } + + ### setup the uri object + my $uri = URI->new( File::Spec::Unix->catfile( + $self->path, $self->file + ) ); + + ### special rules apply for file:// uris ### + $uri->scheme( $self->scheme ); + $uri->host( $self->scheme eq 'file' ? '' : $self->host ); + $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file'; + + ### set up the useragent object + my $ua = LWP::UserAgent->new(); + $ua->timeout( $TIMEOUT ) if $TIMEOUT; + $ua->agent( $USER_AGENT ); + $ua->from( $FROM_EMAIL ); + $ua->env_proxy; + + my $res = $ua->mirror($uri, $to) or return; + + ### uptodate or fetched ok ### + if ( $res->code == 304 or $res->code == 200 ) { + return $to; + + } else { + return $self->_error(loc("Fetch failed! HTTP response: %1 %2 [%3]", + $res->code, HTTP::Status::status_message($res->code), + $res->status_line)); + } + +} + +### HTTP::Tiny fetching ### +sub _httptiny_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + my $use_list = { + 'HTTP::Tiny' => '0.008', + + }; + + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'httptiny'} = 1; + return; + } + + my $uri = $self->uri; + + my $http = HTTP::Tiny->new( ( $TIMEOUT ? ( timeout => $TIMEOUT ) : () ) ); + + my $rc = $http->mirror( $uri, $to ); + + unless ( $rc->{success} ) { + + return $self->_error(loc( "Fetch failed! HTTP response: %1 [%2]", + $rc->{status}, $rc->{reason} ) ); + + } + + return $to; + +} + +### HTTP::Lite fetching ### +sub _httplite_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### modules required to download with lwp ### + my $use_list = { + 'HTTP::Lite' => '2.2', + + }; + + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'httplite'} = 1; + return; + } + + my $uri = $self->uri; + my $retries = 0; + + RETRIES: while ( $retries++ < 5 ) { + + my $http = HTTP::Lite->new(); + # Naughty naughty but there isn't any accessor/setter + $http->{timeout} = $TIMEOUT if $TIMEOUT; + $http->http11_mode(1); + + my $fh = FileHandle->new; + + unless ( $fh->open($to,'>') ) { + return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + } + + $fh->autoflush(1); + + binmode $fh; + + my $rc = $http->request( $uri, sub { my ($self,$dref,$cbargs) = @_; local $\; print {$cbargs} $$dref }, $fh ); + + close $fh; + + if ( $rc == 301 || $rc == 302 ) { + my $loc; + HEADERS: for ($http->headers_array) { + /Location: (\S+)/ and $loc = $1, last HEADERS; + } + #$loc or last; # Think we should squeal here. + if ($loc =~ m!^/!) { + $uri =~ s{^(\w+?://[^/]+)/.*$}{$1}; + $uri .= $loc; + } + else { + $uri = $loc; + } + next RETRIES; + } + elsif ( $rc == 200 ) { + return $to; + } + else { + return $self->_error(loc("Fetch failed! HTTP response: %1 [%2]", + $rc, $http->status_message)); + } + + } # Loop for 5 retries. + + return $self->_error("Fetch failed! Gave up after 5 tries"); + +} + +### Simple IO::Socket::INET fetching ### +sub _iosock_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + my $use_list = { + 'IO::Socket::INET' => '0.0', + 'IO::Select' => '0.0', + }; + + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'iosock'} = 1; + return; + } + + my $sock = IO::Socket::INET->new( + PeerHost => $self->host, + ( $self->host =~ /:/ ? () : ( PeerPort => 80 ) ), + ); + + unless ( $sock ) { + return $self->_error(loc("Could not open socket to '%1', '%2'",$self->host,$!)); + } + + my $fh = FileHandle->new; + + # Check open() + + unless ( $fh->open($to,'>') ) { + return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + } + + $fh->autoflush(1); + binmode $fh; + + my $path = File::Spec::Unix->catfile( $self->path, $self->file ); + my $req = "GET $path HTTP/1.0\x0d\x0aHost: " . $self->host . "\x0d\x0a\x0d\x0a"; + $sock->send( $req ); + + my $select = IO::Select->new( $sock ); + + my $resp = ''; + my $normal = 0; + while ( $select->can_read( $TIMEOUT || 60 ) ) { + my $ret = $sock->sysread( $resp, 4096, length($resp) ); + if ( !defined $ret or $ret == 0 ) { + $select->remove( $sock ); + $normal++; + } + } + close $sock; + + unless ( $normal ) { + return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 ))); + } + + # Check the "response" + # Strip preceding blank lines apparently they are allowed (RFC 2616 4.1) + $resp =~ s/^(\x0d?\x0a)+//; + # Check it is an HTTP response + unless ( $resp =~ m!^HTTP/(\d+)\.(\d+)!i ) { + return $self->_error(loc("Did not get a HTTP response from '%1'",$self->host)); + } + + # Check for OK + my ($code) = $resp =~ m!^HTTP/\d+\.\d+\s+(\d+)!i; + unless ( $code eq '200' ) { + return $self->_error(loc("Got a '%1' from '%2' expected '200'",$code,$self->host)); + } + + { + local $\; + print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0]; + } + close $fh; + return $to; +} + +### Net::FTP fetching +sub _netftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### required modules ### + my $use_list = { 'Net::FTP' => 0 }; + + unless( can_load( modules => $use_list ) ) { + $METHOD_FAIL->{'netftp'} = 1; + return; + } + + ### make connection ### + my $ftp; + my @options = ($self->host); + push(@options, Timeout => $TIMEOUT) if $TIMEOUT; + unless( $ftp = Net::FTP->new( @options ) ) { + return $self->_error(loc("Ftp creation failed: %1",$@)); + } + + ### login ### + unless( $ftp->login( anonymous => $FROM_EMAIL ) ) { + return $self->_error(loc("Could not login to '%1'",$self->host)); + } + + ### set binary mode, just in case ### + $ftp->binary; + + ### create the remote path + ### remember remote paths are unix paths! [#11483] + my $remote = File::Spec::Unix->catfile( $self->path, $self->file ); + + ### fetch the file ### + my $target; + unless( $target = $ftp->get( $remote, $to ) ) { + return $self->_error(loc("Could not fetch '%1' from '%2'", + $remote, $self->host)); + } + + ### log out ### + $ftp->quit; + + return $target; + +} + +### /bin/wget fetch ### +sub _wget_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + my $wget; + ### see if we have a wget binary ### + unless( $wget = can_run('wget') ) { + $METHOD_FAIL->{'wget'} = 1; + return; + } + + ### no verboseness, thanks ### + my $cmd = [ $wget, '--quiet' ]; + + ### if a timeout is set, add it ### + push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; + + ### run passive if specified ### + push @$cmd, '--passive-ftp' if $FTP_PASSIVE; + + ### set the output document, add the uri ### + push @$cmd, '--output-document', $to, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; + + return $self->_error(loc( "Command failed: %1", $captured || '' )); + } + + return $to; +} + +### /bin/lftp fetch ### +sub _lftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a lftp binary ### + my $lftp; + unless( $lftp = can_run('lftp') ) { + $METHOD_FAIL->{'lftp'} = 1; + return; + } + + ### no verboseness, thanks ### + my $cmd = [ $lftp, '-f' ]; + + my $fh = File::Temp->new; + + my $str; + + ### if a timeout is set, add it ### + $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT; + + ### run passive if specified ### + $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE; + + ### set the output document, add the uri ### + ### quote the URI, because lftp supports certain shell + ### expansions, most notably & for backgrounding. + ### ' quote does nto work, must be " + $str .= q[get ']. $self->uri .q[' -o ]. $to . $/; + + if( $DEBUG ) { + my $pp_str = join ' ', split $/, $str; + print "# lftp command: $pp_str\n"; + } + + ### write straight to the file. + $fh->autoflush(1); + print $fh $str; + + ### the command needs to be 1 string to be executed + push @$cmd, $fh->filename; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; + + return $self->_error(loc( "Command failed: %1", $captured || '' )); + } + + return $to; +} + + + +### /bin/ftp fetch ### +sub _ftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a ftp binary ### + my $ftp; + unless( $ftp = can_run('ftp') ) { + $METHOD_FAIL->{'ftp'} = 1; + return; + } + + my $fh = FileHandle->new; + + local $SIG{CHLD} = 'IGNORE'; + + unless ($fh->open("$ftp -n", '|-')) { + return $self->_error(loc("%1 creation failed: %2", $ftp, $!)); + } + + my @dialog = ( + "lcd " . dirname($to), + "open " . $self->host, + "user anonymous $FROM_EMAIL", + "cd /", + "cd " . $self->path, + "binary", + "get " . $self->file . " " . $self->output_file, + "quit", + ); + + foreach (@dialog) { $fh->print($_, "\n") } + $fh->close or return; + + return $to; +} + +### lynx is stupid - it decompresses any .gz file it finds to be text +### use /bin/lynx to fetch files +sub _lynx_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a lynx binary ### + my $lynx; + unless ( $lynx = can_run('lynx') ){ + $METHOD_FAIL->{'lynx'} = 1; + return; + } + + unless( IPC::Cmd->can_capture_buffer ) { + $METHOD_FAIL->{'lynx'} = 1; + + return $self->_error(loc( + "Can not capture buffers. Can not use '%1' to fetch files", + 'lynx' )); + } + + ### check if the HTTP resource exists ### + if ($self->uri =~ /^https?:\/\//i) { + my $cmd = [ + $lynx, + '-head', + '-source', + "-auth=anonymous:$FROM_EMAIL", + ]; + + push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT; + + push @$cmd, $self->uri; + + ### shell out ### + my $head; + unless(run( command => $cmd, + buffer => \$head, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $head || '')); + } + + unless($head =~ /^HTTP\/\d+\.\d+ 200\b/) { + return $self->_error(loc("Command failed: %1", $head || '')); + } + } + + ### write to the output file ourselves, since lynx ass_u_mes to much + my $local = FileHandle->new( $to, 'w' ) + or return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + + ### dump to stdout ### + my $cmd = [ + $lynx, + '-source', + "-auth=anonymous:$FROM_EMAIL", + ]; + + push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT; + + ### DO NOT quote things for IPC::Run, it breaks stuff. + push @$cmd, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? $self->uri + # : QUOTE. $self->uri .QUOTE; + + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $captured || '')); + } + + ### print to local file ### + ### XXX on a 404 with a special error page, $captured will actually + ### hold the contents of that page, and make it *appear* like the + ### request was a success, when really it wasn't :( + ### there doesn't seem to be an option for lynx to change the exit + ### code based on a 4XX status or so. + ### the closest we can come is using --error_file and parsing that, + ### which is very unreliable ;( + $local->print( $captured ); + $local->close or return; + + return $to; +} + +### use /bin/ncftp to fetch files +sub _ncftp_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### we can only set passive mode in interactive sessions, so bail out + ### if $FTP_PASSIVE is set + return if $FTP_PASSIVE; + + ### see if we have a ncftp binary ### + my $ncftp; + unless( $ncftp = can_run('ncftp') ) { + $METHOD_FAIL->{'ncftp'} = 1; + return; + } + + my $cmd = [ + $ncftp, + '-V', # do not be verbose + '-p', $FROM_EMAIL, # email as password + $self->host, # hostname + dirname($to), # local dir for the file + # remote path to the file + ### DO NOT quote things for IPC::Run, it breaks stuff. + $IPC::Cmd::USE_IPC_RUN + ? File::Spec::Unix->catdir( $self->path, $self->file ) + : QUOTE. File::Spec::Unix->catdir( + $self->path, $self->file ) .QUOTE + + ]; + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $captured || '')); + } + + return $to; + +} + +### use /bin/curl to fetch files +sub _curl_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + my $curl; + unless ( $curl = can_run('curl') ) { + $METHOD_FAIL->{'curl'} = 1; + return; + } + + ### these long opts are self explanatory - I like that -jmb + my $cmd = [ $curl, '-q' ]; + + push(@$cmd, '--connect-timeout', $TIMEOUT) if $TIMEOUT; + + push(@$cmd, '--silent') unless $DEBUG; + + ### curl does the right thing with passive, regardless ### + if ($self->scheme eq 'ftp') { + push(@$cmd, '--user', "anonymous:$FROM_EMAIL"); + } + + ### curl doesn't follow 302 (temporarily moved) etc automatically + ### so we add --location to enable that. + push @$cmd, '--fail', '--location', '--output', $to, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + + return $self->_error(loc("Command failed: %1", $captured || '')); + } + + return $to; + +} + +### /usr/bin/fetch fetch! ### +sub _fetch_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + ### see if we have a fetch binary ### + my $fetch; + unless( HAS_FETCH and $fetch = can_run('fetch') ) { + $METHOD_FAIL->{'fetch'} = 1; + return; + } + + ### no verboseness, thanks ### + my $cmd = [ $fetch, '-q' ]; + + ### if a timeout is set, add it ### + push(@$cmd, '-T', $TIMEOUT) if $TIMEOUT; + + ### run passive if specified ### + #push @$cmd, '-p' if $FTP_PASSIVE; + local $ENV{'FTP_PASSIVE_MODE'} = 1 if $FTP_PASSIVE; + + ### set the output document, add the uri ### + push @$cmd, '-o', $to, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; + + return $self->_error(loc( "Command failed: %1", $captured || '' )); + } + + return $to; +} + +### use File::Copy for fetching file:// urls ### +### +### See section 3.10 of RFC 1738 (http://www.faqs.org/rfcs/rfc1738.html) +### Also see wikipedia on file:// (http://en.wikipedia.org/wiki/File://) +### + +sub _file_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + + + + ### prefix a / on unix systems with a file uri, since it would + ### look somewhat like this: + ### file:///home/kane/file + ### whereas windows file uris for 'c:\some\dir\file' might look like: + ### file:///C:/some/dir/file + ### file:///C|/some/dir/file + ### or for a network share '\\host\share\some\dir\file': + ### file:////host/share/some/dir/file + ### + ### VMS file uri's for 'DISK$USER:[MY.NOTES]NOTE123456.TXT' might look like: + ### file://vms.host.edu/disk$user/my/notes/note12345.txt + ### + + my $path = $self->path; + my $vol = $self->vol; + my $share = $self->share; + + my $remote; + if (!$share and $self->host) { + return $self->_error(loc( + "Currently %1 cannot handle hosts in %2 urls", + 'File::Fetch', 'file://' + )); + } + + if( $vol ) { + $path = File::Spec->catdir( split /\//, $path ); + $remote = File::Spec->catpath( $vol, $path, $self->file); + + } elsif( $share ) { + ### win32 specific, and a share name, so we wont bother with File::Spec + $path =~ s|/+|\\|g; + $remote = "\\\\".$self->host."\\$share\\$path"; + + } else { + ### File::Spec on VMS can not currently handle UNIX syntax. + my $file_class = ON_VMS + ? 'File::Spec::Unix' + : 'File::Spec'; + + $remote = $file_class->catfile( $path, $self->file ); + } + + ### File::Copy is littered with 'die' statements :( ### + my $rv = eval { File::Copy::copy( $remote, $to ) }; + + ### something went wrong ### + if( !$rv or $@ ) { + return $self->_error(loc("Could not copy '%1' to '%2': %3 %4", + $remote, $to, $!, $@)); + } + + return $to; +} + +### use /usr/bin/rsync to fetch files +sub _rsync_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + my $rsync; + unless ( $rsync = can_run('rsync') ) { + $METHOD_FAIL->{'rsync'} = 1; + return; + } + + my $cmd = [ $rsync ]; + + ### XXX: rsync has no I/O timeouts at all, by default + push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; + + push(@$cmd, '--quiet') unless $DEBUG; + + ### DO NOT quote things for IPC::Run, it breaks stuff. + push @$cmd, $self->uri, $to; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + + return $self->_error(loc("Command %1 failed: %2", + "@$cmd" || '', $captured || '')); + } + + return $to; + +} + +### use git to fetch files +sub _git_fetch { + my $self = shift; + my %hash = @_; + + my ($to); + my $tmpl = { + to => { required => 1, store => \$to } + }; + check( $tmpl, \%hash ) or return; + my $git; + unless ( $git = can_run('git') ) { + $METHOD_FAIL->{'git'} = 1; + return; + } + + my $cmd = [ $git, 'clone' ]; + + #push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; + + push(@$cmd, '--quiet') unless $DEBUG; + + ### DO NOT quote things for IPC::Run, it breaks stuff. + push @$cmd, $self->uri, $to; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + + return $self->_error(loc("Command %1 failed: %2", + "@$cmd" || '', $captured || '')); + } + + return $to; + +} + +################################# +# +# Error code +# +################################# + +=pod + +=head2 $ff->error([BOOL]) + +Returns the last encountered error as string. +Pass it a true value to get the C<Carp::longmess()> output instead. + +=cut + +### error handling the way Archive::Extract does it +sub _error { + my $self = shift; + my $error = shift; + + $self->_error_msg( $error ); + $self->_error_msg_long( Carp::longmess($error) ); + + if( $WARN ) { + carp $DEBUG ? $self->_error_msg_long : $self->_error_msg; + } + + return; +} + +sub error { + my $self = shift; + return shift() ? $self->_error_msg_long : $self->_error_msg; +} + + +1; + +=pod + +=head1 HOW IT WORKS + +File::Fetch is able to fetch a variety of uris, by using several +external programs and modules. + +Below is a mapping of what utilities will be used in what order +for what schemes, if available: + + file => LWP, lftp, file + http => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock + ftp => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp + rsync => rsync + git => git + +If you'd like to disable the use of one or more of these utilities +and/or modules, see the C<$BLACKLIST> variable further down. + +If a utility or module isn't available, it will be marked in a cache +(see the C<$METHOD_FAIL> variable further down), so it will not be +tried again. The C<fetch> method will only fail when all options are +exhausted, and it was not able to retrieve the file. + +The C<fetch> utility is available on FreeBSD. NetBSD and Dragonfly BSD +may also have it from C<pkgsrc>. We only check for C<fetch> on those +three platforms. + +C<iosock> is a very limited L<IO::Socket::INET> based mechanism for +retrieving C<http> schemed urls. It doesn't follow redirects for instance. + +C<git> only supports C<git://> style urls. + +A special note about fetching files from an ftp uri: + +By default, all ftp connections are done in passive mode. To change +that, see the C<$FTP_PASSIVE> variable further down. + +Furthermore, ftp uris only support anonymous connections, so no +named user/password pair can be passed along. + +C</bin/ftp> is blacklisted by default; see the C<$BLACKLIST> variable +further down. + +=head1 GLOBAL VARIABLES + +The behaviour of File::Fetch can be altered by changing the following +global variables: + +=head2 $File::Fetch::FROM_EMAIL + +This is the email address that will be sent as your anonymous ftp +password. + +Default is C<File-Fetch@xxxxxxxxxxx>. + +=head2 $File::Fetch::USER_AGENT + +This is the useragent as C<LWP> will report it. + +Default is C<File::Fetch/$VERSION>. + +=head2 $File::Fetch::FTP_PASSIVE + +This variable controls whether the environment variable C<FTP_PASSIVE> +and any passive switches to commandline tools will be set to true. + +Default value is 1. + +Note: When $FTP_PASSIVE is true, C<ncftp> will not be used to fetch +files, since passive mode can only be set interactively for this binary + +=head2 $File::Fetch::TIMEOUT + +When set, controls the network timeout (counted in seconds). + +Default value is 0. + +=head2 $File::Fetch::WARN + +This variable controls whether errors encountered internally by +C<File::Fetch> should be C<carp>'d or not. + +Set to false to silence warnings. Inspect the output of the C<error()> +method manually to see what went wrong. + +Defaults to C<true>. + +=head2 $File::Fetch::DEBUG + +This enables debugging output when calling commandline utilities to +fetch files. +This also enables C<Carp::longmess> errors, instead of the regular +C<carp> errors. + +Good for tracking down why things don't work with your particular +setup. + +Default is 0. + +=head2 $File::Fetch::BLACKLIST + +This is an array ref holding blacklisted modules/utilities for fetching +files with. + +To disallow the use of, for example, C<LWP> and C<Net::FTP>, you could +set $File::Fetch::BLACKLIST to: + + $File::Fetch::BLACKLIST = [qw|lwp netftp|] + +The default blacklist is [qw|ftp|], as C</bin/ftp> is rather unreliable. + +See the note on C<MAPPING> below. + +=head2 $File::Fetch::METHOD_FAIL + +This is a hashref registering what modules/utilities were known to fail +for fetching files (mostly because they weren't installed). + +You can reset this cache by assigning an empty hashref to it, or +individually remove keys. + +See the note on C<MAPPING> below. + +=head1 MAPPING + + +Here's a quick mapping for the utilities/modules, and their names for +the $BLACKLIST, $METHOD_FAIL and other internal functions. + + LWP => lwp + HTTP::Lite => httplite + HTTP::Tiny => httptiny + Net::FTP => netftp + wget => wget + lynx => lynx + ncftp => ncftp + ftp => ftp + curl => curl + rsync => rsync + lftp => lftp + fetch => fetch + IO::Socket => iosock + +=head1 FREQUENTLY ASKED QUESTIONS + +=head2 So how do I use a proxy with File::Fetch? + +C<File::Fetch> currently only supports proxies with LWP::UserAgent. +You will need to set your environment variables accordingly. For +example, to use an ftp proxy: + + $ENV{ftp_proxy} = 'foo.com'; + +Refer to the LWP::UserAgent manpage for more details. + +=head2 I used 'lynx' to fetch a file, but its contents is all wrong! + +C<lynx> can only fetch remote files by dumping its contents to C<STDOUT>, +which we in turn capture. If that content is a 'custom' error file +(like, say, a C<404 handler>), you will get that contents instead. + +Sadly, C<lynx> doesn't support any options to return a different exit +code on non-C<200 OK> status, giving us no way to tell the difference +between a 'successful' fetch and a custom error page. + +Therefor, we recommend to only use C<lynx> as a last resort. This is +why it is at the back of our list of methods to try as well. + +=head2 Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do? + +C<File::Fetch> is relatively smart about things. When trying to write +a file to disk, it removes the C<query parameters> (see the +C<output_file> method for details) from the file name before creating +it. In most cases this suffices. + +If you have any other characters you need to escape, please install +the C<URI::Escape> module from CPAN, and pre-encode your URI before +passing it to C<File::Fetch>. You can read about the details of URIs +and URI encoding here: + + http://www.faqs.org/rfcs/rfc2396.html + +=head1 TODO + +=over 4 + +=item Implement $PREFER_BIN + +To indicate to rather use commandline tools than modules + +=back + +=head1 BUG REPORTS + +Please report bugs or other issues to E<lt>bug-file-fetch@xxxxxxxxxxx<gt>. + +=head1 AUTHOR + +This module by Jos Boumans E<lt>kane@xxxxxxxxx<gt>. + +=head1 COPYRIGHT + +This library is free software; you may redistribute and/or modify it +under the same terms as Perl itself. + + +=cut + +# Local variables: +# c-indentation-style: bsd +# c-basic-offset: 4 +# indent-tabs-mode: nil +# End: +# vim: expandtab shiftwidth=4: + + + + diff --git a/File-Fetch-0.42/pm_to_blib b/File-Fetch-0.42/pm_to_blib new file mode 100644 index 0000000..e69de29 diff --git a/File-Fetch-0.42/t/01_File-Fetch.t b/File-Fetch-0.42/t/01_File-Fetch.t new file mode 100644 index 0000000..e4fdccf --- /dev/null +++ b/File-Fetch-0.42/t/01_File-Fetch.t @@ -0,0 +1,303 @@ +BEGIN { chdir 't' if -d 't' }; + +use strict; +use lib '../lib'; + +use Test::More 'no_plan'; + +use Cwd qw[cwd]; +use File::Basename qw[basename]; +use File::Path qw[rmtree]; +use Data::Dumper; + +use_ok('File::Fetch'); + +### optionally set debugging ### +$File::Fetch::DEBUG = $File::Fetch::DEBUG = 1 if $ARGV[0]; +$IPC::Cmd::DEBUG = $IPC::Cmd::DEBUG = 1 if $ARGV[0]; + +unless( $ENV{PERL_CORE} ) { + warn qq[ + +####################### NOTE ############################## + +Some of these tests assume you are connected to the +internet. If you are not, or if certain protocols or hosts +are blocked and/or firewalled, these tests could fail due +to no fault of the module itself. + +########################################################### + +]; + + sleep 3 unless $File::Fetch::DEBUG; +} + +### show us the tools IPC::Cmd will use to run binary programs +if( $File::Fetch::DEBUG ) { + ### stupid 'used only once' warnings ;( + diag( "IPC::Run enabled: " . + $IPC::Cmd::USE_IPC_RUN || $IPC::Cmd::USE_IPC_RUN ); + diag( "IPC::Run available: " . IPC::Cmd->can_use_ipc_run ); + diag( "IPC::Run vesion: $IPC::Run::VERSION" ); + diag( "IPC::Open3 enabled: " . + $IPC::Cmd::USE_IPC_OPEN3 || $IPC::Cmd::USE_IPC_OPEN3 ); + diag( "IPC::Open3 available: " . IPC::Cmd->can_use_ipc_open3 ); + diag( "IPC::Open3 vesion: $IPC::Open3::VERSION" ); +} + +### Heuristics +my %heuristics = map { $_ => 1 } qw(http ftp rsync file git); +### _parse_uri tests +### these go on all platforms +my @map = ( + { uri => 'ftp://cpan.org/pub/mirror/index.txt', + scheme => 'ftp', + host => 'cpan.org', + path => '/pub/mirror/', + file => 'index.txt' + }, + { uri => 'rsync://cpan.pair.com/CPAN/MIRRORING.FROM', + scheme => 'rsync', + host => 'cpan.pair.com', + path => '/CPAN/', + file => 'MIRRORING.FROM', + }, + { uri => 'git://github.com/jib/file-fetch.git', + scheme => 'git', + host => 'github.com', + path => '/jib/', + file => 'file-fetch.git', + }, + { uri => 'http://localhost/tmp/index.txt', + scheme => 'http', + host => 'localhost', # host is empty only on 'file://' + path => '/tmp/', + file => 'index.txt', + }, + + ### only test host part, the rest is OS dependant + { uri => 'file://localhost/tmp/index.txt', + host => '', # host should be empty on 'file://' + }, +); + +### these only if we're not on win32/vms +push @map, ( + { uri => 'file:///usr/local/tmp/foo.txt', + scheme => 'file', + host => '', + path => '/usr/local/tmp/', + file => 'foo.txt', + }, + { uri => 'file://hostname/tmp/foo.txt', + scheme => 'file', + host => 'hostname', + path => '/tmp/', + file => 'foo.txt', + }, +) if not &File::Fetch::ON_WIN and not &File::Fetch::ON_VMS; + +### these only on win32 +push @map, ( + { uri => 'file:////hostname/share/tmp/foo.txt', + scheme => 'file', + host => 'hostname', + share => 'share', + path => '/tmp/', + file => 'foo.txt', + }, + { uri => 'file:///D:/tmp/foo.txt', + scheme => 'file', + host => '', + vol => 'D:', + path => '/tmp/', + file => 'foo.txt', + }, + { uri => 'file:///D|/tmp/foo.txt', + scheme => 'file', + host => '', + vol => 'D:', + path => '/tmp/', + file => 'foo.txt', + }, +) if &File::Fetch::ON_WIN; + + +### sanity tests +{ + no warnings; + like( $File::Fetch::USER_AGENT, qr/$File::Fetch::VERSION/, + "User agent contains version" ); + like( $File::Fetch::FROM_EMAIL, qr/@/, + q[Email contains '@'] ); +} + +### parse uri tests ### +for my $entry (@map ) { + my $uri = $entry->{'uri'}; + + my $href = File::Fetch->_parse_uri( $uri ); + ok( $href, "Able to parse uri '$uri'" ); + + for my $key ( sort keys %$entry ) { + is( $href->{$key}, $entry->{$key}, + " '$key' ok ($entry->{$key}) for $uri"); + } +} + +### File::Fetch->new tests ### +for my $entry (@map) { + my $ff = File::Fetch->new( uri => $entry->{uri} ); + + ok( $ff, "Object for uri '$entry->{uri}'" ); + isa_ok( $ff, "File::Fetch", " Object" ); + + for my $acc ( keys %$entry ) { + is( $ff->$acc(), $entry->{$acc}, + " Accessor '$acc' ok ($entry->{$acc})" ); + } +} + +### fetch() tests ### + +### file:// tests ### +{ + my $prefix = &File::Fetch::ON_UNIX ? 'file://' : 'file:///'; + my $uri = $prefix . cwd() .'/'. basename($0); + + for (qw[lwp lftp file]) { + _fetch_uri( file => $uri, $_ ); + } +} + +### Heuristics +{ + require IO::Socket::INET; + my $sock = IO::Socket::INET->new( PeerAddr => 'ftp.funet.fi', PeerPort => 21, Timeout => 20 ) + or $heuristics{ftp} = 0; +} + +### ftp:// tests ### +{ my $uri = 'ftp://ftp.funet.fi/pub/CPAN/index.html'; + for (qw[lwp netftp wget curl lftp fetch ncftp]) { + + ### STUPID STUPID warnings ### + next if $_ eq 'ncftp' and $File::Fetch::FTP_PASSIVE + and $File::Fetch::FTP_PASSIVE; + + _fetch_uri( ftp => $uri, $_ ); + } +} + +### Heuristics +{ + require IO::Socket::INET; + my $sock = IO::Socket::INET->new( PeerAddr => 'www.cpan.org', PeerPort => 80, Timeout => 20 ) + or $heuristics{http} = 0; +} + +### http:// tests ### +{ for my $uri ( 'http://www.cpan.org/index.html', + 'http://www.cpan.org/index.html?q=1', + 'http://www.cpan.org/index.html?q=1&y=2', + ) { + for (qw[lwp httptiny wget curl lftp fetch lynx httplite iosock]) { + _fetch_uri( http => $uri, $_ ); + } + } +} + +### Heuristics +{ + require IO::Socket::INET; + my $sock = IO::Socket::INET->new( PeerAddr => 'cpan.pair.com', PeerPort => 873, Timeout => 20 ) + or $heuristics{rsync} = 0; +} + +### rsync:// tests ### +{ my $uri = 'rsync://cpan.pair.com/CPAN/MIRRORING.FROM'; + + for (qw[rsync]) { + _fetch_uri( rsync => $uri, $_ ); + } +} + +### Heuristics +{ + require IO::Socket::INET; + my $sock = IO::Socket::INET->new( PeerAddr => 'github.com', PeerPort => 9418, Timeout => 20 ) + or $heuristics{git} = 0; +} + +### git:// tests ### +{ my $uri = 'git://github.com/jib/file-fetch.git'; + + for (qw[git]) { + _fetch_uri( git => $uri, $_ ); + } +} + +sub _fetch_uri { + my $type = shift; + my $uri = shift; + my $method = shift or return; + + SKIP: { + skip "'$method' fetching tests disabled under perl core", 4 + if $ENV{PERL_CORE}; + + skip "'$type' fetching tests disabled due to heuristic failure", 4 + unless $heuristics{ $type }; + + ### stupid warnings ### + $File::Fetch::METHODS = + $File::Fetch::METHODS = { $type => [$method] }; + + ### fetch regularly + my $ff = File::Fetch->new( uri => $uri ); + + ok( $ff, "FF object for $uri (fetch with $method)" ); + + for my $to ( 'tmp', do { \my $o } ) { SKIP: { + + + my $how = ref $to && $type ne 'git' ? 'slurp' : 'file'; + my $skip = ref $to ? 4 : 3; + + ok( 1, " Fetching '$uri' in $how mode" ); + + my $file = $ff->fetch( to => $to ); + + skip "You do not have '$method' installed/available", $skip + if $File::Fetch::METHOD_FAIL->{$method} && + $File::Fetch::METHOD_FAIL->{$method}; + + ### if the file wasn't fetched, it may be a network/firewall issue + skip "Fetch failed; no network connectivity for '$type'?", $skip + unless $file; + + ok( $file, " File ($file) fetched with $method ($uri)" ); + + ### check we got some contents if we were meant to slurp + if( ref $to && $type ne 'git' ) { + ok( $$to, " Contents slurped" ); + } + + ok( $file && -s $file, + " File has size" ); + is( $file && basename($file), $ff->output_file, + " File has expected name" ); + + rmtree $file; + }} + } +} + + + + + + + + diff --git a/File-Fetch-0.42/t/null_subclass.t b/File-Fetch-0.42/t/null_subclass.t new file mode 100644 index 0000000..630a607 --- /dev/null +++ b/File-Fetch-0.42/t/null_subclass.t @@ -0,0 +1,23 @@ +use strict; +use warnings; + +use Test::More tests => 5; + +my $parent_class = 'File::Fetch'; +my $child_class = 'File::Fetch::Subclass'; + +use_ok( $parent_class ); + +my $ff_parent = $parent_class->new( uri => 'http://example.com/index.html' ); +isa_ok( $ff_parent, $parent_class ); + +can_ok( $child_class, qw( new fetch ) ); +my $ff_child = $child_class->new( uri => 'http://example.com/index.html' ); +isa_ok( $ff_child, $child_class ); +isa_ok( $ff_child, $parent_class ); + +BEGIN { + package File::Fetch::Subclass; + use vars qw(@ISA); + unshift @ISA, qw(File::Fetch); + } diff --git a/noarch/perl-File-Fetch-0.38-1.fc20.noarch.rpm b/noarch/perl-File-Fetch-0.38-1.fc20.noarch.rpm new file mode 100644 index 0000000..f7c5d3c Binary files /dev/null and b/noarch/perl-File-Fetch-0.38-1.fc20.noarch.rpm differ diff --git a/noarch/perl-File-Fetch-0.42-1.fc20.noarch.rpm b/noarch/perl-File-Fetch-0.42-1.fc20.noarch.rpm new file mode 100644 index 0000000..87bbcce Binary files /dev/null and b/noarch/perl-File-Fetch-0.42-1.fc20.noarch.rpm differ diff --git a/perl-File-Fetch-0.38-1.fc20.src.rpm b/perl-File-Fetch-0.38-1.fc20.src.rpm new file mode 100644 index 0000000..f6013dc Binary files /dev/null and b/perl-File-Fetch-0.38-1.fc20.src.rpm differ diff --git a/perl-File-Fetch-0.42-1.fc20.src.rpm b/perl-File-Fetch-0.42-1.fc20.src.rpm new file mode 100644 index 0000000..6252e5c Binary files /dev/null and b/perl-File-Fetch-0.42-1.fc20.src.rpm differ -- Fedora Extras Perl SIG http://www.fedoraproject.org/wiki/Extras/SIGs/Perl perl-devel mailing list perl-devel@xxxxxxxxxxxxxxxxxxxxxxx https://admin.fedoraproject.org/mailman/listinfo/perl-devel