view release on metacpan or  search on metacpan

cpan2rpm  view on Meta::CPAN

sub readfile {
    my $f = shift || $_;
    local $_ if defined wantarray();

    return $_ = "" unless -r $f;

    local $/ = undef;
    open(F, $f) || die "$! [$f].  Stopped ";
    $_ = <F>;
    close(F);
    $_;
    }

#
#    writes a file, from a string
#

sub writefile($@) {
    my $fn = shift;
    local $_ = shift || $_;
    my $op = shift || ">";

    open (FILE, "$op $fn") || die "writefile('$fn'): $!. Stopped";
    binmode(FILE);
    print FILE;
    close FILE || die "writefile('$fn'): $!. Stopped";
    $fn;
    }

sub cp {
    my ($f, $d, $ff) = @_;
    $f =~ s/~/$ENV{HOME}/;
    return 1 unless -r $f;
    ($ff = $f) =~ s|.*/||;
    return 1 if finode($f) eq finode("$d/$ff");
    system("cp", "-u", $f, $d) == 0;
    }

#    0: dev, 1: inode, the combination guarantees
#    a unique file in a filesystem

sub finode {
    local $_ = shift || $_;
    my @i; "$i[0]$i[1]" if @i = stat;
    }

#    simple test to determine if it's a URL

sub isurl {
    local $_ = shift || $_;
    scalar m#^(https?|ftp)://#;
    }

#    Syntax: content = http_get [url]

sub http_get {
    my $url = shift || $_;

    $HTTPWARN = 1 if $info{dist} =~ /libwww-perl/;

    if ($@ = "", eval "use HTTP::Request::Common; use LWP::UserAgent;", !$@) {
        my $ua = LWP::UserAgent->new();
        $ua->env_proxy();
        return $ua->request(GET($url))->content || "";
        }
    elsif ($HTTPWARN == 0) {
        print "\nWARNING: libwww-perl module not found.  To install, one ";
        print "of the following options may help:\n\n";

        local $\ = $/;
        $url = "http://www.rpmfind.net/linux/rpm2html/search.php";
        $url .= "?query=perl-libwww-perl";
        print "  1) Try $url";
        $url = "$CPAN_BASE/modules/by-module/LWP/";
        $url .= "libwww-perl-5.68.tar.gz";
        print "  2) Specify the full URL of the tarball manually.";
        print "     cpan2rpm -i $url";
        print "  3) Download tarball and specify file on commandline.";
        print "  4) Configure CPAN: perl -MCPAN -eshell";
        print "  5) cpan2rpm -i libwww-perl\n";
        print "Trying HTTP::Lite...";
        }

    if ($@ = "", eval "use HTTP::Lite;", !$@) {
        my $http = HTTP::Lite->new();
        $http->request($url) || die "http_get(): $!.  Stopped";
        return $http->body() || "";
        }
    elsif ($HTTPWARN == 0) {
        print "\nWARNING: this alternative module could not be found ";
        print "either!  Please install the libwww-perl package ";
        print "as indicated above.\n\n";
        print "Trying external programs...\n";
        }

    $HTTPWARN = 1;

    my ($host, $doc) = $url =~ m|tp://(.*?)(/.*)|;
    my @prg = (
        "/usr/bin/lynx -source $url",
        "/usr/bin/links -source $url",
        "/usr/bin/wget -O - $url",
        "/usr/bin/ncftpget $url && cat " . ($url =~ m|.*/(.*)|),
        "echo -e \"user anonymous x\@x.com\nget $doc\" |/usr/bin/ftp -u $host",
        );

    for (@prg) {
        my ($p) = /^(\S+)/;
        next unless -e $p;
        my $ret = qx/$_/;
        print("Retrieving with [", $p =~ m|([^/]+)$|, "]\n"), return $ret
            if $? == 0;
        }

    my $msg = "External program support failed.  Manual download required";
    die "> $msg.\nStopped";
    }

#    Syntax: tarball = write_url <directory> [url]

sub write_url {