view release on metacpan or  search on metacpan

lib/Youri/Package/RPM/Updater.pm  view on Meta::CPAN

    # Mandriva policy implies to recompress sources, so if the one that was
    # just looked for was missing, check with other formats
    if (!$file and $url =~ /\.tar\.bz2$/) {
        foreach my $extension (@{$self->{_alternate_extensions}}) {
            my $alternate_url = $url;
            $alternate_url =~ s/\.tar\.bz2$/.$extension/;
            $file = $self->_fetch_potential_tarball($agent, $alternate_url);
            if ($file) {
                $file = _bzme($file);
                last;
            }
        }
    }

    return $file;
}

sub _fetch_potential_tarball {
    my ($self, $agent, $url) = @_;

    my $filename = basename($url);
    my $dest = "$self->{_sourcedir}/$filename";

    # don't attempt to download file if already present
    return $dest if -f $dest;

    print "attempting to download $url\n" if $self->{_verbose};
    my $response = $agent->mirror($url, $dest);
    if ($response->is_success()) {
        print "response: OK\n" if $self->{_verbose} > 1;
        my ($extension) = $filename =~ /\.(\w+)$/;
        if ($self->{_archive_content_types}->{$extension}) {
            # check content type for archives
            my $type = $response->header('Content-Type');
            print "checking content-type $type: " if $self->{_verbose} > 1;
            if (
                none { $type eq $_ }
                @{$self->{_archive_content_types}->{$extension}},
                @{$self->{_archive_content_types}->{_all}}
            ) {
                # wrong type
                print "NOK\n" if $self->{_verbose} > 1;
                unlink $dest;
                return;
            } else {
                print "OK\n" if $self->{_verbose} > 1;
            }
        }
        return $dest;
    } else {
        print "response: NOK\n" if $self->{_verbose} > 1;
        return;
    }
}


sub _get_packager {
    my ($self) = @_;
    my $packager = $wrapper_class->expand_macro('%packager');
    if ($packager eq '%packager') {
        my $login = (getpwuid($<))[0];
        $packager = $ENV{EMAIL} ? "$login <$ENV{EMAIL}>" : $login;
    }
    return $packager;
}


sub _find_source_package {
    my ($self, $dir, $name) = @_;

    my $file;
    opendir(my $DIR, $dir) or croak "Unable to open $dir: $!";
    while (my $entry = readdir($DIR)) {
        if ($entry =~ /^\Q$name\E-[^-]+-[^-]+\.src.rpm$/) {
            $file = "$dir/$entry";
            last;
        }
    }
    closedir($DIR);
    return $file;
}

sub _get_sources {
    my ($self, $spec, $version) = @_;

    my $header = $spec->srcheader();
    my $name   = $header->tag('name');

    my @sources;

    # special cases: ignore sources defined in the spec file
    if ($name =~ /^perl-(\S+)/) {
        # source URL in the spec file can not be trusted, as it 
        # change for each release, so try to use CPAN metabase DB
        my $cpan_name = $1;
        $cpan_name =~ s/-/::/g;

        # ignore spec file URL, as it changes between releases
        my ($cpan_url, $cpan_version) = _get_cpan_package_info(
            $cpan_name
        );

        if ($cpan_url && $cpan_version && $cpan_version eq $version) {
            # use the result if available
            my $source = ($spec->sources_url())[0];
            @sources = ( { url => $cpan_url, bzme => $source =~ /\.tar\.bz2$/ } );
        }
    }

    return @sources if @sources;

    # default case: extract all sources defined with an URL in the spec file
    @sources =
        map { _fix_source($_, $version) }
        map { { url => $_, bzme => 0 } }
        grep { /(?:ftp|svns?|https?):\/\/\S+/ }
        $spec->sources_url();

    return @sources if @sources;

    # fallback case: try a single source, with URL deduced from package URL