App-Fetchware
view release on metacpan or search on metacpan
bin/fetchware view on Meta::CPAN
return $installed_fetchware_package_path;
} else {
# I only need the basename.
my $download_path_basename = file($P_download_path)->basename();
my $upgrade_name_basename =
file( $P_fetchware_package_path)->basename();
# Strip trailing garbage to normalize their names, so that they can be
# compared to each other.
###BUGALERT### This comparision is quite fragile. Figure out a better way to
#do this!!!
$upgrade_name_basename =~ s/\.fpkg$//;
$download_path_basename
=~ s/(\.(?:zip|tgz|tbz|txz|fpkg)|(?:\.tar\.(gz|bz2|xz|Z)?))$//;
msg <<EOM;
The latest version [$download_path_basename] is the same as the currently
installed version [$upgrade_name_basename]. So no upgrade is needed.
EOM
# Clean up temp dir.
lib/App/Fetchware.pm view on Meta::CPAN
gpg digital signatures found. Using gpg verification.
EOM
$options{verify_method} = 'gpg';
# Search for a KEYS file to use to import the author's keys.
if (grep {$_->[0] eq 'KEYS'} @$filename_listing) {
msg <<EOM;
KEYS file found using lookup_url. Adding gpg_keys_url to your Fetchwarefile.
EOM
# Add 'KEYS' or '/KEYS' to $lookup_url's path.
my ($scheme, $auth, $path, $query, $fragment) =
uri_split($lookup_url);
$path = catfile($path, 'KEYS');
$lookup_url = uri_join($scheme, $auth, $path, $query, $fragment);
$options{gpg_keys_url} = $lookup_url;
$verify_configed_flag++;
} else {
msg <<EOM;
KEYS file *not* found!
EOM
# Since autoconfiguration of KEYS failed, try asking the user if
# they would like to import the author's key themselves into their
# own keyring and have fetchware use that.
lib/App/Fetchware.pm view on Meta::CPAN
my $download_path_basename = file($download_path)->basename();
my $upgrade_name_basename =
file( $fetchware_package_path)->basename();
vmsg <<EOM;
Shortened the new download url [$download_path_basename] and the installed
package's [$upgrade_name_basename] into just their basenames.
EOM
# Strip trailing garbage to normalize their names, so that they can be
# compared to each other.
###BUGALERT### This comparision is quite fragile. Figure out a better way to
#do this!!!
$upgrade_name_basename =~ s/\.fpkg$//;
$download_path_basename
=~ s/(\.(?:zip|tgz|tbz|txz|fpkg)|(?:\.tar\.(gz|bz2|xz|Z)?))$//;
vmsg <<EOM;
Striped the new download url [$download_path_basename] and the installed
package's [$upgrade_name_basename] of their file extensions.
EOM
# Check if $upgrade_name_basename and $download_path_basename are eq, and if
lib/App/Fetchware.pm view on Meta::CPAN
# the downloaded file is the last part of the $path, but that is not the case
# with the path php uses for file downloads, because it ends in mirror, which is
# *not* the name of the file; therefore, I must hook download() to fix this
# problem.
hook download => sub {
my ($temp_dir, $download_path) = @_;
my $http = HTTP::Tiny->new();
my $response;
for my $mirror (config('mirror')) {
my ($scheme, $auth, $path, $query, $fragment) = uri_split($mirror);
my $url = uri_join($scheme, $auth, $download_path, undef, undef);
msg <<EOM;
Downloading path [$download_path] using mirror [$mirror].
EOM
$response = $http->get($url);
# Only download it once.
last if $response->{success};
}
lib/App/Fetchware/Util.pm view on Meta::CPAN
# Add $url to @urls since it too has a hostname. And use unshift
# to put it in the first position instead of last if you were to use
# push.
unshift @urls, $url;
# I must parse out the path portion of the specified URL, because this
# path portion will be appended to the mirrors you have specified.
my $url_path = ( uri_split($url) )[2];
for my $mirror_url (@urls) {
# If the $mirror_url has no path...
my ($scheme, $auth, $path, $query, $frag) =
uri_split($mirror_url);
###BUGALERT### Should check below also check for $query and $frag,
#and if the mirror has specified those to include those too???
if ($path eq '') {
#...then append $url's path.
###BUGALERT## As shown before I was using URI's much nicer
#interface, but it was deleting the path instead of replacing
#the path! I tried reproducing this with a small test file, but
#it worked just fine in the small test file. So, it must be some
#really weird bug to fail here, but work in a smaller test file.
#I don't know try replacing all of the URI::Split calls with the
#equivelent URI->path() calls, and you'll get the weird bug.
#$mirror_url->path($url_path);
$mirror_url =
uri_join($scheme, $auth, $url_path, $query, $frag);
# But if the $mirror_url does have a path...
} else {
#...Then keep the mirrors path intact.
#
# Because if you specify a path when you define that mirror
# chances are you did it, because that mirror stores it in a
# different directory. For example Apache is /apache on some
# mirrors, but apache.hostname on other mirrors.
}
}
lib/App/Fetchware/Util.pm view on Meta::CPAN
if (exists $opts{PATH}
and defined $opts{PATH}
and $opts{PATH}) {
# The PATH option means that $url is not a full blown URL, but just a
# path without a hostname or scheme portion.
# Therefore, we append $url, because the PATH option means it's actually
# just a path, so we append it to each @url.
for my $mirror_url (@urls) {
# If the $mirror_url has no path...
my ($scheme, $auth, $path, $query, $frag) =
uri_split($mirror_url);
# Skip messing with the path if $path eq $opts{PATH}, which means the
# current $mirror_url is $url, so we shouldn't add its own path to
# itself--we should skip it instead.
next if $path eq $opts{PATH};
if ($path eq '') {
#...then append $url's path.
###BUGALERT## As shown before I was using URI's much nicer
#interface, but it was deleting the path instead of replacing
#the path! I tried reproducing this with a small test file, but
#it worked just fine in the small test file. So, it must be some
#really weird bug to fail here, but work in a smaller test file.
#I don't know try replacing all of the URI::Split calls with the
#equivelent URI->path() calls, and you'll get the weird bug.
#$mirror_url->path($opts{PATH});
###Add an unless ($opts{PATH} eq '')
$mirror_url =
uri_join($scheme, $auth, $opts{PATH}, $query, $frag);
# But if the $mirror_url does have a path...
} else {
#...Then keep the mirrors path intact.
#
# Because if you specify a path when you define that mirror
# chances are you did it, because that mirror stores it in a
# different directory. For example Apache is /apache on some
# mirrors, but apache.hostname on other mirrors.
#
#Except add $path's basename, because otherwise we'll ask
#for a dirlisting or try to download a directory as a file.
unless ($path =~ m!/$!) {
$mirror_url =
uri_join($scheme, $auth, $path . '/'
. file($opts{PATH})->basename(), $query, $frag);
# Skip adding a '/' if ones already there at the end.
} else {
$mirror_url =
uri_join($scheme, $auth, $path
. file($opts{PATH})->basename(), $query, $frag);
}
}
}
} elsif (defined $url
and $url) {
# Add $url to @urls since it too has a hostname. And use unshift
# to put it in the first position instead of last if you were to use
# push.
unshift @urls, $url;
# I must parse out the path portion of the specified URL, because this
# path portion will be appended to the mirrors you have specified.
my $url_path = ( uri_split($url) )[2];
for my $mirror_url (@urls) {
# If the $mirror_url has no path...
my ($scheme, $auth, $path, $query, $frag) =
uri_split($mirror_url);
# Skip messing with the path if $path eq $url_path, which means the
# current $mirror_url is $url, so we shouldn't add its own path to
# itself--we should skip it instead.
next if $path eq $url_path;
if ($path eq '') {
#...then append $url's path.
###BUGALERT## As shown before I was using URI's much nicer
#interface, but it was deleting the path instead of replacing
#the path! I tried reproducing this with a small test file, but
#it worked just fine in the small test file. So, it must be some
#really weird bug to fail here, but work in a smaller test file.
#I don't know try replacing all of the URI::Split calls with the
#equivelent URI->path() calls, and you'll get the weird bug.
#$mirror_url->path($url_path);
###Add an unless ($url_path eq '')
$mirror_url =
uri_join($scheme, $auth, $url_path, $query, $frag);
# But if the $mirror_url does have a path...
} else {
#...Then keep the mirrors path intact.
#
# Because if you specify a path when you define that mirror
# chances are you did it, because that mirror stores it in a
# different directory. For example Apache is /apache on some
# mirrors, but apache.hostname on other mirrors.
#
#Except add $path's basename, because otherwise we'll ask
#for a dirlisting or try to download a directory as a file.
unless ($path =~ m!/$!) {
$mirror_url =
uri_join($scheme, $auth, $path . '/'
. file($url_path)->basename(), $query, $frag);
# Skip adding a '/' if ones already there at the end.
} else {
$mirror_url =
uri_join($scheme, $auth, $path
. file($url_path)->basename(), $query, $frag);
}
}
}
}
my $filename;
for my $mirror_url (@urls) {
eval {
msg "Attempting to download [$mirror_url].";
t/App-Fetchware-Util.t view on Meta::CPAN
# Use Test::Deep to see if $got_output's data structure matches the right regexs.
cmp_deeply($got_filelisting, eval(expected_filename_listing()),
'check download_dirlist() multi-mirror proper output');
# Test download_dirlist(PATH => $path) support.
__clear_CONFIG();
###BUGALERT### Apache does not have a ftp main, author's mirror, so I cannot
#actually test this over ftp any more.
##CANTTEST## # Set up the mirror so that it has no path.
##CANTTEST## my ($scheme, $auth, $path, $query, $frag) =
##CANTTEST## uri_split($ENV{FETCHWARE_FTP_LOOKUP_URL});
##CANTTEST## config(mirror => uri_join($scheme, $auth, undef, undef, undef));
##CANTTEST##
##CANTTEST## # Then test download_dirlist() with what would normally be the mirror's
##CANTTEST## # path.
##CANTTEST## ok($got_output = download_dirlist(PATH => $path),
##CANTTEST## 'checked download_dirlists(PATH) ftp success.');
##CANTTEST## is_deeply($got_output, $expected_output,
##CANTTEST## 'check download_dirlist(PATH) ftp proper output');
t/App-Fetchware-Util.t view on Meta::CPAN
ok(ref $got_filelisting eq 'ARRAY',
'checked download_dirlist() multi-mirror parsed output.');
# Use Test::Deep to see if $got_output's data structure matches the right regexs.
cmp_deeply($got_filelisting, eval(expected_filename_listing()),
'check download_dirlist() multi-mirror proper output');
# Test download_dirlist(PATH => $path) support.
__clear_CONFIG();
# Set up the mirror so that it has no path.
my ($scheme, $auth, $path, $query, $frag) =
uri_split($ENV{FETCHWARE_HTTP_LOOKUP_URL});
config(mirror => uri_join($scheme, $auth, undef, undef, undef));
# Then test download_dirlist() with what would normally be the mirror's
# path.
ok($got_output = download_dirlist(PATH => $path),
'checked download_dirlists(PATH) http success.');
# Parse $got_output, creating $got_filelisting to be able to check its
# structure below using Test::Deep for corectness.
t/App-Fetchware-Util.t view on Meta::CPAN
##HOWTOTEST## How do I test the switching to binary mode error? Can it even
#fail?
##HOWTOTEST## eval_ok(sub {download_ftp_url('whatftpserverdoesntsupportanonymous&ispublic?');,
##HOWTOTEST## <<EOS, 'checked download_ftp_url() empty content failure');
##HOWTOTEST##App-Fetchware: run-time error. fetchware failed to log in to the ftp server at
##HOWTOTEST##domain [$site]. The ftp error was [@{[$ftp->message]}]. See man App::Fetchware.
##HOWTOTEST##EOS
my ($scheme, $auth, $path, $query, $frag) =
uri_split($ENV{FETCHWARE_FTP_DOWNLOAD_URL});
eval_ok( sub {download_ftp_url("$scheme://$auth/doesnt/exist/anywhere")},
qr!App-Fetchware: run-time error. fetchware failed to cwd\(\) to \[/doesnt/exist/a!,
'check download_ftp_url() failed to chdir');
eval_ok(sub {download_ftp_url("$scheme://$auth/$path/filedoesntexist")},
qr!App-Fetchware: run-time error. fetchware failed to cwd\(\) to \[!,
'checked download_ftp_url() cant Net::FTP->get() file');
##BUGALERT### Must add test for download_ftp_url() returning the $filename.
};
subtest 'test download_http_url()' => sub {
skip_all_unless_release_testing();
###BUGALERT### the 2 lins below are copied & pasted 3 times subify them!
my ($scheme, $auth, $path, $query, $frag) = uri_split($ENV{FETCHWARE_FTP_DOWNLOAD_URL});
my ($volume, $directories, $filename) = splitpath($path);
is(download_http_url($ENV{FETCHWARE_HTTP_DOWNLOAD_URL}),
$filename, 'checked download_http_url() success.');
ok(-e $filename, 'checked download_ftp_url success');
ok(unlink $filename, 'checked deleting downloaded file');
eval_ok(sub {download_http_url('http://fake.url')},
qr/599 Internal Exception/, 'checked download_http_url bad hostname');
##HOWTOTEST## I don't think the unless length $response->{content} is easily
t/App-Fetchware-Util.t view on Meta::CPAN
# Test multiple mirrors.
ok($filename = download_file($url),
'check download_file() ftp multi-mirror success');
ok(-e $filename, 'checked download_file() ftp multi-mirror filename success');
ok(unlink $filename, 'checked deleting downloaded file');
# Test download_dirlist(PATH => $path) support.
__clear_CONFIG();
# Set up the mirror so that it has no path.
my ($scheme, $auth, $path, $query, $frag) =
uri_split($ENV{FETCHWARE_HTTP_LOOKUP_URL});
config(mirror => uri_join($scheme, $auth, undef, undef, undef));
# Strip $path's ending / if present.
$path =~ s!/$!!;
# Then test download_dirlist() with what would normally be the mirror's
# path.
ok($filename = download_file(PATH => "$path/KEYS"),
'checked download_dirlists(PATH) ftp success.');
ok(-e $filename, 'checked download_file(PATH) ftp success');
t/App-Fetchware-Util.t view on Meta::CPAN
##CANTTEST##
##CANTTEST## # Test multiple mirrors.
##CANTTEST## ok($filename = download_file($url),
##CANTTEST## 'check download_file() ftp multi-mirror success');
##CANTTEST## ok(-e $filename, 'checked download_file() http multi-mirror filename success');
##CANTTEST## ok(unlink $filename, 'checked deleting downloaded file');
# Test download_file(PATH => $path) support.
__clear_CONFIG();
# Set up the mirror so that it has no path.
($scheme, $auth, $path, $query, $frag) =
uri_split($ENV{FETCHWARE_HTTP_LOOKUP_URL});
config(mirror => uri_join($scheme, $auth, undef, undef, undef));
# Strip $path's ending / if present.
$path =~ s!/$!!;
# Then test download_dirlist() with what would normally be the mirror's
# path.
ok($filename = download_file(PATH => "$path/KEYS"),
'checked download_file(PATH) http success.');
ok(-e $filename, 'checked download_file(PATH) http success');
t/App-Fetchware-download.t view on Meta::CPAN
eval_ok(sub {download(cwd(), $url)},
qr/App-Fetchware: download\(\) has been passed a full URL \*not\* only a path./,
'checked download() url exception');
# manually set $CONFIG{TempDir} to cwd().
my $cwd = cwd();
config_replace('temp_dir', "$cwd");
# Determine $filename for is() test below.
my ($scheme, $auth, $path, $query, $frag) = uri_split($url);
# Be sure to define a mirror, because with just a path download() can't
# work properly.
config(mirror => uri_join($scheme, $auth, undef, undef, undef));
my ($volume, $directories, $filename) = splitpath($path);
note("FILENAME[$filename]");
note("LASTURL[$url] CWD[$cwd]");
# Remeber download() wants a $path not a $url.
is(download($cwd, $path), catfile($cwd, $filename),
'checked download() success.');
t/App-Fetchware-download.t view on Meta::CPAN
# manually set $CONFIG{TempDir} to cwd().
my $cwd = cwd();
config_replace('temp_dir', "$cwd");
my $test_dist_path = make_test_dist(file_name => 'test-dist',
ver_num => '1.00', destination_directory => 't');
my $test_dist_md5 = md5sum_file($test_dist_path);
my $url = "file://$test_dist_path";
# Determine $filename for is() test below.
my ($scheme, $auth, $path, $query, $frag) = uri_split($url);
my ($volume, $directories, $filename) = splitpath($path);
###BUGALERT## Remove cwd(), and replace with temp dir, so tests can be run
#in parallel to speed up development.
# I must create a lookup_url to tell download_file() that it's downloading a
# local file.
config(lookup_url => $url);
config(mirror => uri_join($scheme, $auth, undef, undef, undef));
is(download($cwd, $path), catfile($cwd, $filename),
'checked download() local file success.');
t/bin-fetchware-Fetchwarefile.t view on Meta::CPAN
# the downloaded file is the last part of the $path, but that is not the case
# with the path php uses for file downloads, because it ends in mirror, which is
# *not* the name of the file; therefore, I must hook download() to fix this
# problem.
hook download => sub {
my ($temp_dir, $download_path) = @_;
my $http = HTTP::Tiny->new();
my $response;
for my $mirror (config('mirror')) {
my ($scheme, $auth, $path, $query, $fragment) = uri_split($mirror);
my $url = uri_join($scheme, $auth, $download_path, undef, undef);
msg <<EOM;
Downloading path [$download_path] using mirror [$mirror].
EOM
$response = $http->get($url);
# Only download it once.
last if $response->{success};
}
( run in 2.515 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )