view release on metacpan or  search on metacpan

lib/App/Fetchware/Util.pm  view on Meta::CPAN

sub download_dirlist {
    my %opts;
    my $url;
    # One arg means its a $url.
    if (@_ == 1) {
       $url = shift;
    # More than one means it's a PATH, and if it's not a path...
    } elsif (@_ == 2) {
        %opts = @_;
        # Or your param wasn't PATH
        if (not exists $opts{PATH} and not defined $opts{PATH}) {
            # Use goto for cool old-school C-style error handling to avoid copy
            # and pasting or insane nested ifs.
            goto PATHERROR;
        }
    # ...then it's an error.
    } else {
        PATHERROR: die <<EOD;
App-Fetchware-Util: You can only specify either PATH or URL never both. Only
specify one or the other when you call download_dirlist().
EOD
    }

    # Ensure the user has specified a mirror, because otherwise download_file()
    # will try to just download a path, and that's not going to work.
    die <<EOD if not config('mirror') and exists $opts{PATH};
App-Fetchware-Util: You only called download_dirlist() with just a PATH
parameter, but also failed to specify any mirrors in your configuration. Without
any defined mirrors download_dirlist() cannot determine from what host to
download your file. Please specify a mirror and try again.
EOD

    # Set up our list of urls that we'll try to download the specified PATH or
    # URL from.
    my @urls = config('mirror') if defined config('mirror');
    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) {
            # Use URI to replace the current path with the one the caller
            # specified in the $url parameter.
            my ($scheme, $auth, undef, undef, undef) = uri_split($mirror_url);
            $mirror_url = uri_join($scheme, $auth, $opts{PATH}, undef, undef);
        }
    } 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);
            ###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.
            }
        }
    }

    my $dirlist;

    for my $mirror_url (@urls) {
        eval {
            msg "Attempting to download [$mirror_url].";
            # Try the mirror_url directly without trying any mirrors.
            $dirlist = no_mirror_download_dirlist($mirror_url);
        };
        if ($@) {
            msg "Directory download attempt failed! Error was[";
            print $@;
            msg "].";
        }

        # Skip the rest of the @urls after we successfully download the $url.
        if (defined $dirlist) {
            msg "Successfully downloaded the directory listing.";
            last;
        }
    }

    die <<EOD if not defined $dirlist;
App-Fetchware-Util: Failed to download the specifed URL [$url] or path
[$opts{PATH}] using the included hostname in the url you specifed or any
mirrors. The mirrors are [@{[config('mirror')]}]. And the urls
that fetchware tried to download were [@urls].
EOD

    return $dirlist;
}



sub no_mirror_download_dirlist {
    my $url = shift;

    my $dirlist;
    if ($url =~ m!^ftp://.*$!) {
        $dirlist = ftp_download_dirlist($url);
    } elsif ($url =~ m!^http://.*$!) {
        $dirlist = http_download_dirlist($url);
    } elsif ($url =~ m!^file://.*$!) {
      $dirlist = file_download_dirlist($url);
    } else {
        die <<EOD;
App-Fetchware: run-time syntax error: the url parameter your provided in
your call to download_dirlist() [$url] does not have a supported URL scheme (the
http:// or ftp:// part). The only supported download types, schemes, are FTP and

lib/App/Fetchware/Util.pm  view on Meta::CPAN

            # and pasting or insane nested ifs.
            goto PATHERROR;
        }
    # ...then it's an error.
    } else {
        PATHERROR: die <<EOD;
App-Fetchware-Util: You can only specify either PATH or URL never both. Only
specify one or the other when you call download_file().
EOD
    }
    # Ensure the user has specified a mirror, because otherwise download_file()
    # will try to just download a path, and that's not going to work.
    if (not config('mirror') and exists $opts{PATH}
        and
    # True if lookup_url is a file and if lookup_url is undef.
    defined config('lookup_url') ?
    config('lookup_url') =~ m!^file://! ? 1 : 0
    : 1
    ) {
        die <<EOD ;
App-Fetchware-Util: You only called download_file() with just a PATH parameter,
but also failed to specify any mirrors in your configuration. Without any
defined mirrors download_file() cannot determine from what host to download your
file. Please specify a mirror and try again.
EOD
    }

    # Set up our list of urls that we'll try to download the specified PATH or
    # URL from.
    my @urls = config('mirror') if defined config('mirror');
    # If we're called with a PATH option and the lookup_url is for a local file,
    # then we should just convert from a PATH into a $url.
    if (exists $opts{PATH}
        and
        # Is lookup_url not a file://, true for undef and any other scheme.
        defined config('lookup_url') ?
        config('lookup_url') =~ m!^file://! ? 1 : 0
        : 0
    ) {
        $url = "file://$opts{PATH}";
        delete $opts{PATH};
    # Otherwise, we should add lookup_url's hostname to the list of mirrors, but
    # be sure to push it onto @urls so that it is used last.
    #
    # But only if lookup_url is defined.
    } elsif (defined config('lookup_url')) {
        my ($scheme, $auth, undef, undef, undef) =
            uri_split(config('lookup_url'));
        push @urls, uri_join($scheme, $auth, undef, undef, undef);
    }

    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].";
            # Try the mirror_url directly without trying any mirrors.
            $filename = no_mirror_download_file($mirror_url);
        };
        if ($@) {
            msg "File download attempt failed! Error was[";
            print $@;
            msg "].";
        }

        # Skip the rest of the @urls after we successfully download the $url.
        if (defined $filename) {
            msg "Successfully downloaded the file [$mirror_url].";
            last;
        }
    }

    die <<EOD if not defined $filename;
App-Fetchware-Util: Failed to download the specifed URL [$url] or path
[$opts{PATH}] using the included hostname in the url you specifed or any
mirrors. The mirrors are [@{[config('mirror')]}]. And the urls
that fetchware tried to download were [@{[@urls]}].
EOD

    return $filename;
}



sub no_mirror_download_file {
    my $url = shift;

    my $filename;
    if ($url =~ m!^ftp://!) {
        $filename = download_ftp_url($url);
    } elsif ($url =~ m!^http://!) {
        $filename = download_http_url($url);
    } elsif ($url =~ m!^file://!) {
        $filename = download_file_url($url);   
    } else {
        die <<EOD;
App-Fetchware: run-time syntax error: the url parameter your provided in
your call to download_file() [$url] does not have a supported URL scheme (the
http:// or ftp:// part). The only supported download types, schemes, are FTP and
HTTP. See perldoc App::Fetchware.
EOD
    }

    return $filename;
}