view release on metacpan or  search on metacpan

cpan2rpm  view on Meta::CPAN

    return if defined $info{"no-upgrade-chk"};
    return if !$VERSION;
    print "Upgrade check\n";

    eval {
        alarm(5);
        $SIG{ALRM} = sub {
            die "Network too slow, check elapsed...\n";
            };
        local $_ = http_get("$LATEST_MOD/CPAN::RPM");
        $info{latestversionavailable} = $1 if /"version"\s*:\s*"?([\d\.\_\-]+)"?/;
        };
    alarm(0);
    if ($info{latestversionavailable} and $info{latestversionavailable} gt $VERSION) {
        local $\ = $/;
        print "";
        print "* A newer version of this program is now available. To upgrade";
        print "* enter the following command: $0 --upgrade\n";
        }
    return $info{latestversionavailable};
    }

sub upgrade {
    $info{install}++;
    die "Current version unclear!\n" unless $VERSION;
    my $ver = chkupgrade();
    die "Upgrade version unclear!\n" unless $ver;
    print "Current ver: $VERSION\n";
    print "Latest ver: $ver\n";
    if ($VERSION ge $ver) {
        print "Already up to date.\n";
        exit;
    }
    print "Upgrading...\n";
    my $tarball = get_cpan_api({ dist => "CPAN::RPM" });
    if (!$tarball or !-s $tarball) {
        local $\ = $/;
        print "\nERROR: Unable to retrieve tarball, please visit our web\n";
        print "site at: https://github.com/ekkis/cpan2rpm\n";
        print "to download the latest version.\n";
        exit(-1);
        }
    my @ret = qx|$RPM -ta $tarball 2>&1|;
    die "upgrade(): $!" if $?;
    /Wrote:\s+(.*)$/ && ($info{rpm} = $1) && last for reverse @ret;
    inst_rpm(\%info);
    exit;
    }

sub changelog {
    my @dow = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
    my @mon = ("Jan", "Feb", "Mar", "Apr", "May", "Jun"
        , "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
        );

    return sprintf("%s %s %d %d %s"
          , $dow[(localtime)[6]]
        , $mon[(localtime)[4]]
        , (localtime)[3]
        , 1900 + (localtime)[5]
        , sprintf("%s\@%s", (getpwuid($<))[0], hostname())
        );
    }

sub trim {
    map { $_ ||= ""; s/^\s+//; s/\s+$//; } @_;
    unless (defined wantarray()) {
        $_ ||= ""; s/^\s+//; s/\s+$//;
        }
    $_[0] if @_ == 1;
    }

# dirty way to untaint stuff to make suExec happy

sub untaint {
    my $k = shift;
    my %x; $x{$k} = 1;
    return (keys %x)[0];
    }

sub debug {
    my $msg = shift;
    my $level = shift || 1;
    $info{debug} ||= 0;
    print "> $msg\n" if $level <= $info{debug};
    }

sub syntax {
    my $args = shift;
    my $warn = shift;

    print "Error:   $warn\n\n" if $warn;

    local $_ = <<EOF;
    This script automates the creation of RPMs from CPAN modules.
    For further information please see the man page.
EOF
    s/^\s+//mg; print;
    print "\nSyntax: cpan2rpm [options] <module>\n\n";
    print "Where <module> is either the name of a Perl module (e.g.\n";
    print "Proc::Daemon) or of a tarball (e.g. Proc-Daemon-0.02.tar.gz),\n";
    print "and [options] is any of the following:\n\n";
    for (sort keys %$args) {
        my ($arg) = split /[:=|]/;
        $arg = "-$arg" if length($arg) > 1;
        $arg = "-$arg" if $arg;
        printf("  %-15s %s\n", $arg, $args->{$_});
        }
    print "\n";
    exit(1);
    }

1;    # yipiness

__END__

=head1 NAME

cpan2rpm - A Perl module packager

=head1 SYNOPSIS