#!/usr/bin/perl

#
#   CPAN module RPM maker
#

use vars qw($VERSION);
BEGIN {
  $VERSION = (split / /, q$Revision: 1.77 $ )[1];
}

# --- prologue ----------------------------------------------------------------

use strict;
use Getopt::Long;
use Sys::Hostname;
use Config;

# --- main() ------------------------------------------------------------------

init();            # initialise stuff
get_meta();        # get metadata from tarball
mk_spec();         # create a custom spec file
mk_rpm();          # build the RPM
inst_rpm();        # install it if requested

# --- support functionality ---------------------------------------------------

my ($TMPDIR, $TMPBUILD, %RPMDIR, $CWD, %MAC, %info);

sub init {
    $|++;    # good for system()

    $TMPDIR  = "/tmp/cpan2rpm";
    $CWD     = qx/pwd/; chomp($CWD);
    mkdir $TMPDIR, 01777;
    -d $TMPDIR or die "$TMPDIR: $!";

    my $arch = $1 if $Config{config_args} =~ /-march=(\S+)/;
    $arch ||= "unknown";

    # package info defaults
    %info =
        (    url              => "http://www.cpan.org"
        ,    packager         => "Arix International <cpan2rpm\@arix.com>"
        ,    group            => "Applications/CPAN"
        ,    license          => "Artistic"
        ,    release          => 1
        ,    buildarch        => $arch
        ,    buildroot        => "%{_tmppath}/%{name}-%{version}-%(id -u -n)"
        ,    description      => "None."
        );

    # syntax descriptions
    my %desc =
        (    "pkgname=s"        => "RPM package name"
        ,    "version=s"        => "override the CPAN version number"
        ,    "summary=s"        => "package summary"
        ,    "author=s"         => "author information"
        ,    "url=s"            => "home URL"
        ,    "packager=s"       => "packager identification"
        ,    "group=s"          => "RPM group"
        ,    "license=s"        => "licensing information"
        ,    "release=i"        => "RPM relase number"
        ,    "distribution=s"   => "Linux distribution"
        ,    "buildarch=s"      => "package architecture"
        ,    "buildroot=s"      => "root directory to use for build"
        ,    "requires=s"       => "packages required for installation"
        ,    "provides=s"       => "modules provided by the package"
        ,    "no-requires=s"    => "suppresses generation of a set of reqs"
        ,    "find-provides=s"  => "instructs us to use a given filter"
        ,    "find-requires=s"  => "(see man page for further details)"
        ,    "spec-only"        => "only displays spec file to stdout"
        ,    "make-maker=s"     => "arguments for makefile creation"
        ,    "make=s"           => "arguments passed to make"
        ,    "make-install=s"   => "arguments for make install"
        ,    "no-clean"			=> "suppress --clean"
        ,    "patch|p=s@"       => "specifies (multiple) patches to apply"
        ,    "install|i"        => "install package when done"
        ,    "description=s"    => "package description"
        ,    "nopkgprfx"        => "suppresses package name prefix"
        ,    "force"            => "forces all operations"
        ,    "debug:i"          => "produce debugging output"
        ,    "help|h"           => "this help screen"
        );

    # get user options
    my %opts = ();
    my $ret = GetOptions(\%opts, keys %desc);
    print "\n-- cpan2rpm - Ver: $::VERSION --\n\n" if !$opts{"spec-only"};

    syntax(\%desc) if defined $opts{help} || !$ret;

    # override defaults with user options
    %info = (%info, %opts);

    # get module name
    $info{module} = shift @ARGV
        || syntax(\%desc, "No module or file specified!");

    if ($<) { # Non superuser
        # Make sure .rpmmacros is there
        my $user_macros = "$ENV{HOME}/.rpmmacros";
        if (!-e $user_macros) {
            system( qq{
              mkdir ~/redhat ;
              cd ~/redhat ;
              mkdir BUILD RPMS SOURCES SPECS SRPMS ;
              echo %_topdir ~/redhat >> $user_macros ;
            });
            }
        if ($info{install}) {
            print "\n-- NON ROOT install requires sudo rpm privileges --\n";
            if (system("sudo rpm -v")) {
                print "You can configure sudo with the following command:\n\n";
                print "  echo ".getlogin()." ALL=/bin/rpm >> /etc/sudoers\n\n";
                die "sudo failed: CANNOT USE --install OPTION!  Stopped";
                }
            else {
                print "\n-- NON ROOT sudo precheck successful.\n";
                }
            }

        }
    $RPMDIR{SOURCES} = getrpm_macdef("_sourcedir");
    $RPMDIR{RPMS} = getrpm_macdef("_rpmdir");
    $RPMDIR{SRPMS} = getrpm_macdef("_srcrpmdir");
    $RPMDIR{SPECS} = getrpm_macdef("_specdir");
    $RPMDIR{ARCH} = getrpm_macdef("_arch");

    searchcpan();

    if (isurl($info{module})) {
        #
        #    a url was passed
        #

        get_url($RPMDIR{SOURCES}, $info{module});
        }

    elsif (istarball($info{module}, 1)) {
        #
        #    argument passed is a local file name
        #

        my ($d, $f) = $info{module} =~ m|(.*?)/?([^/]*)$|;

        system("cp -u $info{module} $RPMDIR{SOURCES}") == 0
            || die "Unable to copy tarball: $!"
            unless finode($info{module}) eq finode("$RPMDIR{SOURCES}/$f")
            ;

        $info{module} =~ s|.*/||;     # remove path
        $info{tarball} = $info{module};
        $info{module} =~ s/-(\d+\.?\d*)\.(tar\.g?z|tgz)$//;
        $info{module} =~ s/-/::/g;
        }

    else {
        #
        #    assume argument passed is a Perl module name
        #

        get_mod();
        }
    }

END {
    chdir $CWD;
    qx/rm -rf $TMPBUILD/ if $TMPBUILD && !$info{debug};
    print "-- Done --\n" if !$info{"spec-only"};
    }

#
#    get metadata from tarball's MakeMaker file
#

sub get_meta {
    my $f = shift || "$RPMDIR{SOURCES}/$info{tarball}";

    my @ls;
    ($info{tardir}, @ls) = tarls($f);
    $info{tardir} = "%{pkgname}-%{version}"
        if $info{tardir} eq "$info{module}-$info{version}";
    $info{create} = "-c" if $info{tardir} =~ s/\+$//;

    #    create file-list for spec's %doc section

    @ls = map(m|[^/]*/(.*)|, @ls);    # strip leading dir
    my $re = "(readme|changes|todo|license|install|\.txt|\.html)";
    $info{doc} = join(" ", grep(/$re/i, @ls));
    $info{doc} = "%doc $info{doc}" if $info{doc};

    #    extract tarball

    print "Tarball extraction: [$f]\n" if !$info{"spec-only"};
    chdir($TMPBUILD = untar($f));

    #    execute modified Makefile.PL

    print "Metadata retrieval\n" if !$info{"spec-only"};

    my %meta;
    # grap parameters to WriteMakefile()
    sub MyWriteMakefile {
        %meta = @_;
        };

    local $_ = qq/package make; no strict; local (*STDOUT, *STDERR) = (); /;
    $_ .= qq/$ARGV[0] = $info{"make-maker"}; / if $info{"make-maker"};
    $_ .= readfile("Makefile.PL");
    s/(qw\(.*)WriteMakefile(.*\))/$1$2/g;
    s/(ExtUtils::MakeMaker::)?WriteMakefile/::MyWriteMakefile/g;
    s/(\W)exit(\W)/${1}die$2/g;
    eval() || warn $!;
    $info{author} ||= $meta{AUTHOR};

    #    figure out package name

    $info{pkgname} ||= $meta{NAME} || $info{module};
    $info{pkgname} =~ s/::/-/g;
    die "No package name available.  Stopped"
        unless $info{pkgname};

    #    get module description info

    my $from = $meta{ABSTRACT_FROM} || $meta{VERSION_FROM};
    ($from = "$info{pkname}.pm") =~ s/.*:// unless $from;
    $from = readfile($from);

    if (!$meta{ABSTRACT} && $from) {
        local $_ = $from;
        ($meta{ABSTRACT}) = /=head\d\s+NAME.*?-\s*(.*?)$/ism;
        ($meta{DESCRIPTION}) = /=head\d\s+SYNOPSIS\s+(.*?)=head/ism;
        $meta{DESCRIPTION} =~ s/E<lt>/</ig;
        $meta{DESCRIPTION} =~ s/E<gt>/>/ig;
        }

    if (!$info{author} && $from) {
        local $_ = $from;
        ($info{author}) = /=head\d\s+AUTHOR\s+(.*)/i;
        $info{author} =~ s/E<lt>/</ig;
        $info{author} =~ s/E<gt>/>/ig;
        }

    if (!$info{author} &&
        isurl($info{source}) &&
        $info{source} =~ m%author.*/([A-Z\-]+)/[^/]+$%) {
        # Extract generic author from url
        $info{author} = (lc $1).'@cpan.org';
        }

    die "No author information found and none supplied.  Stopped"
        unless $info{author};

    #    extract version from tarball name

    unless ($info{version}) {
        $info{tarball} =~ /-(\d+.*)\.(tar\.g?z|tgz)$/;
        $info{version} = $1
            || die "Could not ascertain version and none passed!";
        }

    #    assemble other info

    $info{spec} = "$RPMDIR{SPECS}/$info{pkgname}.spec";
    $info{summary} = "$info{pkgname} - " . ($meta{ABSTRACT} || "Perl module");
    $info{description} = $meta{DESCRIPTION} if $meta{DESCRIPTION};
    $info{source} ||= $info{tarball};
    $info{source} =~ s/$info{pkgname}/%{pkgname}/;
    $info{source} =~ s/$info{version}/%{version}/;
    $info{distribution} = getrpm_macdef("distribution") || distro();
    $info{changelog} = changelog();

    $info{requires} &&= "Requires: $info{requires}";
    $info{provides} &&= "Provides: $info{provides}";

    $info{"find-provides"}
        &&= qq/%define __find_provides $info{"find-provides"}/;
    $info{"find-requires"}
        &&= qq/%define __find_requires $info{"find-requires"}/;
    if ($info{"no-requires"}) {
        my $noreqs = "";
        $noreqs .= qq/-e '$_' / for split /\s*,\s*/, $info{"no-requires"};
        $info{"no-requires"}{"define"}
            = "%define custom_find_req %{_tmppath}/%{NVR}-find-requires";
        $info{"find-requires"} = "%define __find_requires %{custom_find_req}";
        local $_ = qq[cat <<EOF > %{custom_find_req}
            #!/bin/sh
            /usr/lib/rpm/find-requires |grep -v $noreqs
            EOF
            chmod 755 %{custom_find_req}
            ];
        s/^\s+//mg;
        $info{"no-requires"}{"install"} = $_;
        $info{"no-requires"}{"clean"} = "rm -f %{custom_find_req}";
        }

    # generate patch info
    for my $i (0 .. $#{$info{patch}}) {
        $info{"patch-files"} .= "Patch$i: $info{patch}->[$i]\n";
        $info{"patch-apply"} .= "%patch$i -p1\n";
        # put patches in RPM dir if needed
        system("cp -u $info{patch}->[$i] $RPMDIR{SOURCES}") == 0
            || die "Unable to copy patch: $!"
        }

    # return to user's directory

    chdir $CWD;
    }

#
#    generate s spec file
#

sub mk_spec {
    print "-- Generating spec file --\n" if !$info{"spec-only"};

    my $pkgname = $info{pkgname};
    $pkgname = "perl-" . $pkgname unless $info{nopkgprfx};
    $info{description} =~ s/\s+$//;

    local $_ = <<ZZ;
        #
        #    cpan2rpm - This spec file was automatically generated.
        #    For further information please refer to: http://perl.arix.com/
        #

        %define pkgname    $info{pkgname}
        %define filelist %{pkgname}-%{version}-filelist
        %define NVR %{pkgname}-%{version}-%{release}
        $info{"no-requires"}{"define"}

        Summary:       $info{summary}
        Name:          $pkgname
        Version:       $info{version}
        Release:       $info{release}
        Group:         $info{group}
        Distribution:  $info{distribution}
        Vendor:        $info{author}
        Packager:      $info{packager}
        License:       $info{license}
        Url:           $info{url}
        BuildRoot:     $info{buildroot}
        BuildArch:     $info{buildarch}
        Source:        $info{source}

        $info{"patch-files"}
        $info{requires}
        $info{provides}

        %description
        $info{description}

        #
        # This package was automatically generated with the cpan2rpm
        # utility.  To get this software or for more information
        # please visit: http://perl.arix.com/
        #
        $info{"find-provides"}
        $info{"find-requires"}

        %prep
        %setup -q -n $info{tardir} $info{create}
        $info{"patch-apply"}

        %build
        CFLAGS="\$RPM_OPT_FLAGS"
        %{__perl} Makefile.PL $info{"make-maker"}
        %{__make} $info{"make"}
        %{__make} test

        %install
        [ "\$RPM_BUILD_ROOT" != "/" ] && rm -rf \$RPM_BUILD_ROOT
        $info{"no-requires"}{"install"}

        eval `perl '-V:installarchlib'`
        mkdir -p \$RPM_BUILD_ROOT/\$installarchlib
		%{makeinstall} PREFIX=\$RPM_BUILD_ROOT%{_prefix} $info{"make-install"}

        [ -x /usr/lib/rpm/brp-compress ] && /usr/lib/rpm/brp-compress

        find \$RPM_BUILD_ROOT -name "perllocal.pod" \\
            -o -name ".packlist"                    \\
            -o -name "*.bs"                         \\
            |xargs -i rm -f {}

		find \$RPM_BUILD_ROOT%{_prefix} -type d -depth -exec rmdir {} \\;

        %clean
        [ "\$RPM_BUILD_ROOT" != "/" ] && rm -rf \$RPM_BUILD_ROOT
        $info{"no-requires"}{"clean"}

        %files
        %defattr(-,root,root)
        $info{doc}
        %{_prefix}

        %changelog
        * $info{changelog}
        - Initial build.
ZZ
    s/^\s+//gm;    # clean up

    print(), exit if $info{"spec-only"};
    writefile($info{spec});
    }

#
#    build the package
#

sub mk_rpm {
    my $pkgname = $info{pkgname};
    $pkgname = "perl-" . $pkgname unless $info{nopkgprfx};
    $info{rpm} = sprintf("%s/%s-%s-%s.%s.rpm"
        , "$RPMDIR{RPMS}/$info{buildarch}"
        , $pkgname
        , $info{version}
        , $info{release}
        , $info{buildarch}
        );

    return if -r $info{rpm} && !$info{force};

    print "-- Generating package --\n";

    my $ret = 0;

    system("rpmbuild -bp $info{spec}");
    warn("RPM test unpacking failed!") if $ret = $? >> 8;

    if ($ret == 0) {
		my $clean = $info{"no-clean"} ? "" : "--clean";
        system("rpmbuild -ba $clean $info{spec}");
        warn("RPM build failed!") if $ret = $? >> 8;
        }

    return $ret;
    }

#
#    if requested, will also install the resulting RPM
#

sub inst_rpm {
    return unless $info{install};

    print "-- Installing package --\n";
    my $install_command = "";
    $install_command = "sudo " if $<;
    $install_command .= "rpm -Uvh $info{rpm}";
    system($install_command);
    return $? >> 8;
    }

# --- module retrieval functions ----------------------------------------------

#
#    Walks search.cpan.org for the latest uploaded distribution.
#    Uses LWP instead of CPAN to determine the tarball.
#

sub searchcpan {
    # Abort unless it smells like a CPAN module
    return unless $info{module} =~ /^[\w:\-]+$/;
    print "-- Searching CPAN for module $info{module} --\n" if !$info{"spec-only"};
    # XXX - This algorithm may change as the
    # search.cpan.org web site output changes.
    $@ = ""; eval "use HTTP::Request::Common; use LWP::UserAgent;";
    if ($@) {
        # Could not load libwww-perl
        print "-- WARNING: libwww-perl module not found!\n";
        print "-- Install libwww-perl to avoid this warning.\n";
        print "-- One of the following options may help:\n";
        print "--   1) Try http://www.rpmfind.net/linux/rpm2html/search.php?query=perl-libwww-perl\n";
        print "--   2) Specify the full URL of the tarball manually.\n";
        print "--   3) Download tarball and specify file on commandline.\n";
        print "--   4) Configure CPAN:  perl -MCPAN -eshell\n";
        print "--   5) cpan2rpm --install libwww-perl\n";
        }
    else {
        my $dist = $info{module};
        $dist =~ s/::/-/g;
        my $dist_url = "http://search.cpan.org/dist/$dist/";
        my $ua = new LWP::UserAgent;
        my $response = $ua->request(GET($dist_url));
        my $page = $response->content;
        if ($page && $page =~
            m%\<a[^<>]*       # Begin Anchor tag
            href\s*=\s*       # href parameter
            (['"]?)           # Maybe quote
            ([^<>\s"']*)      # Extract link as $2
            \1                # Maybe quote
            [^<>]*\>          # End Anchor tag
            \s*Download       # of the "Download" link
            %ix               # case insensitive HTML
            ) {
            $info{module} = URI->new_abs($2, $response->base)->as_string;
            print "-- Found URL $info{module} --\n" if !$info{"spec-only"};
            }
        }
    }

#
#    grabs the module from CPAN and places in the SOURCES directory
#    ACHTUNG: at present, only the latest version of the module
#    can be retrieved.  For building earlier versions, retrieve the
#    tarball manually.
#

sub get_mod {
    print "-- Retrieving module from CPAN --\n";
    require  CPAN;
    import   CPAN 0.59;

    my $m = CPAN::Shell->expand("Module", $info{module})
        || die "Module not found on CPAN!";

    my $a = CPAN::Shell->expand("Author", $m->{RO}->{CPAN_USERID});
    $info{author} ||= "$a->{RO}->{FULLNAME} <$a->{RO}->{EMAIL}>";

    my $f = $m->{RO}->{CPAN_FILE};
    $info{source} = sprintf("%s/authors/id/%s"
        , "http://www.cpan.org"
        , $f
        );

    my $tarball = $f; $tarball =~ s|.*/||;
    $info{tarball} = $tarball;

    # bail if tarball already there (unless we're being --force'd)
    return if -r "$RPMDIR{SOURCES}/$tarball"
        && ! defined $info{force}
        ;

    get($f);

    my $ff = sprintf("%s/authors/id/%s"
        , $CPAN::Config->{'keep_source_where'}
        , $f
        );

    system("cp $ff $RPMDIR{SOURCES}") if -r $ff;
    }

# --- RPM macro functions -----------------------------------------------------

sub getrpm_init {
    return if %MAC;

    my @f = (
          "/usr/lib/rpm/macros"        # orginal definitions
        , "/etc/rpm/macros"            # site-wide overrides
        , "$ENV{HOME}/.rpmmacros"      # user-specific overrides
        );

    for (@f) {
        %MAC = (%MAC, getrpm_macros()) if -r;
        }
    }

#
#    get an RPM macro definition
#

sub getrpm_macdef($) {
    my $key = shift;

    getrpm_init();
    1 while $MAC{$key} =~ s/%{([^}]+)}/$MAC{$1}/;
    return $MAC{$key};
    }

#
#    retrieves macro definitions from a file
#

sub getrpm_macros {
    local $_ = shift || $_;
    open(F, $_) || die $!;
    my %ret = ();
    for (<F>) {
        next unless s/^%//;
        split;
        $ret{$_[0]} = $_[1];
        }
    close(F);
    return %ret;
    }

# --- tar handling functions --------------------------------------------------

#
#    determines whether given filename represents a tarball
#    optionally dies it file doesn't exist or is not readable
#

sub istarball {
    my ($fn, $fschk) = @_;
    my $is = $fn =~ /\.(tar\.g?z|tgz)$/i;
    return $is unless $fschk && $is;
    -r $fn || die "tarball: $!";
    }

#
#    returns the root dir in a tarball (without trailing /)
#    followed by a listing of all files in the directory
#

sub tarls {
    my $f = shift || $_;

    my ($d, @f);
    for (qx/tar -tzvf $f/) {
        split; local $_ = $_[5];
        $_[0] =~ /^d/ && ($d ||= $_) || (push @f, $_);
        }

    for (@f) {                       # look in file listing
        last if $d;                  # never mind if dir found
        $d = $_ if s|/.*||;          # strip dir from filename
        }

    if (!$d) {                       # if still no subdir found
        local $_ = $f;               # assume tardir
        s|.*/||;                     # without path
        s/\.(tar\.g?z|tgz)$//i;      # or extension
        $d = "$_+";                  # and indicate we made it up
        }

    $d =~ s|^\.+/||;                 # root = ./MyDir/
    $d =~ s|/.*||;                   # make sure subdir found is top level
    wantarray() ? ($d, @f) : $d;     # context aware
    }

#
#    extracts a file from a tarball
#

sub tarx($$) {
    my ($tar, $f) = @_;
    local $_ if defined wantarray();
    $_ = qx/tar -xzOf $tar $f/;
    }

#
#    extracts a tarball
#

sub untar($) {
    my ($tar, $dst) = @_;
    $dst ||= $TMPDIR;
    qx/tar -xz --directory $dst -f $tar/;
    return "$TMPDIR/" . tarls($tar);
    }

# --- file handling functions -------------------------------------------------

#
#    returns the contents of a given file or undef if the
#    file does not exist
#

sub readfile($) {
    my $f = shift;
    return undef unless -r $f;

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

#
#    writes a file, from a string
#

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

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

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

sub finode {
    my $f = shift || $_;
    my @i = stat $f;
    return $i[0] . $i[1];
    }

#    simple test to determine if it's a URL

sub isurl {
    local $_ = shift || $_;
    scalar m#(ht|f)tp://#;
    }

#    Syntax: get_url <directory> [url]

sub get_url($@) {
    my $d = shift;
    my $url = shift || $_;
    $d =~ s|/$||;    # no trailing /s

    $info{source} = $url;
    $url =~ s|.*/||;
    $info{tarball} = $url;

    return if -r "$d/$info{tarball}" && !$info{force};

    print "-- Retrieving URL --\n";
    $@ = ""; eval "use HTTP::Request::Common; use LWP::UserAgent;";
    if (!$@) {
        writefile("$d/$info{tarball}",LWP::UserAgent->new->request(GET($info{source}))->content);
        return;
        }
    $@ = ""; eval "use HTTP::Lite;";
    if (!$@) {
        my $http = new HTTP::Lite;
        $http->request($info{source}) || die "get_url(): $!.  Stopped";
        writefile("$d/$info{tarball}", $http->body());
        return;
        }

    # Could not load libwww-perl
    print "-- WARNING: libwww-perl module not found!\n";
    print "-- Install libwww-perl to avoid this warning: cpan2rpm --install libwww-perl\n";
    print "-- Trying wget...\n";
    if (-e "/usr/bin/wget" && !system("wget --directory-prefix=$d $info{source}")) {
        print "-- Success!\n";
        return;
        }
    print "-- Trying lynx...\n";
    if (-e "/usr/bin/lynx" && !system("lynx -source $info{source} > $info{tarball} && mv $info{tarball} $d/$info{tarball}")) {
        print "-- Success!\n";
        return;
        }
    print "-- Trying links...\n";
    if (-e "/usr/bin/links" && !system("links -source $info{source} > $info{tarball} && mv $info{tarball} $d/$info{tarball}")) {
        print "-- Success!\n";
        return;
        }
    print "-- Trying ncftpget...\n";
    if (-e "/usr/bin/ncftpget") {
        if ($info{source} =~ m%^ftp://%i) {
            if (!system("ncftpget $info{source} && mv $info{tarball} $d/$info{tarball}")) {
                print "-- Success!\n";
                return;
                }
            }
        else {
            print "-- Use the ftp:// url instead of $info{source}\n";
            }
        }
    die "-- External program download failed.  Manual download required.  Stopped";
    }

# --- miscellany --------------------------------------------------------------

#
#    syntax: <scalar> = elem [nth] [regexp] [string = $_]
#

sub elem {
    my $n = shift || 0;
    my $re = shift || '\s+';
    local $_ = shift || $_;
    return (split /$re/)[$n];
    }

#
#    attempts to return the name of the distribution.
#    FIXME: currently only works on RedHat (as far as I know)
#

sub distro {
    for (`cat /etc/issue`) {
        chomp;
        next unless $_;
        return $_;
        }
    }

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 syntax {
    my $args = shift;
    my $warn = shift;

    print "Error:\t$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, $a, $s) = split /[:=|]/;
        $a = $arg, $arg = "" if !$a && length($arg) == 1;
        $a = "-$a" if $a;
        $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

cpan2rpm [options] <module>

This script generates an RPM package from a Perl module.  It uses the standard RPM file structure and creates a spec file, a source RPM, and a binary, leaving these in their respective directories.

The script can operate on local files, urls and CPAN module names.  Install this package if you want to create RPMs out of Perl modules.

=head1 DESCRIPTION

The syntax for cpan2rpm requires a single module name, which can take one of three different forms: 1) a CPAN module name (e.g. XML::Simple), 2) a URL (both http:// and ftp:// style locators will work), and 3) a local filename reference to a tarball (e.g. /tmp/XML-Simple-1.05.tar.gz).  The module name may be preceded by a number of optional arguments which modify the behaviour of the script.

By default, the search.cpan.org website is "walked" to
determine the latest tarball for the specified module.
If an exact match is not found, the CPAN module is used
to determine and download the module.

If you have not configured CPAN (CPAN.pm or CPAN/MyConfig.pm)
you can configure it with the following:

perl -MCPAN -eshell

If the <module> passed is either a CPAN module name or a URL the script automatically does a download (when CPAN module names are specified, the latest distribution is used), putting it in the SOURCES directory.  If <module> is given as a local filename, the tarball gets copied to the SOURCES directory.  NOTE: at present the script will not handle .bz2 tarballs.

The spec file generated will generally assume header values as configured in the RPM macro files which are evaluated in the following order: F</usr/lib/rpm/macros>, F</etc/rpm/macros> and F<~/.rpmmacros>.  Most of these headers can, however, be overridden through options.  Whenever a header is neither configured in the RPM macro files nor is passed at the command line, the script will seek to calculate a proper value and supplies a default as stated for each option below.  It is thus typicall sufficient to provide only the <module> name.

The C<options> available are as follows:

=over 2

=item I<--pkgname=C<string-value>>

The RPM package name.  This is the C<Name> header in the RPM's spec file.  Please note that the string C<perl-> will be prepended to any value passed here.  If no value is supplied, the script will use the NAME field found in the module's Makefile.PL

=item I<--version=C<float-value>>

The script determines the version number of the module by parsing the tarball name.

=item I<--release=C<integer-value>>

The package release number. Defaults to 1.

=item I<--summary=C<string-value>>

A one-line description of the package.  If left unspecified the script will use the module name, appending an abstract whenever available.

=item I<--description=C<string-value>>

This text describes the package/module.  This value is picked up from the POD's Synopsis section in the module.  Defaults to "None.".

=item I<--url=C<string-value>>

The home url for the package.  Defaults to F<http://www.cpan.org>.

=item I<--group=C<string-value>>

This is the RPM group.  For further information on available groups please see your RPM documentation.  Defaults to C<Applications/CPAN>.

=item I<--author=C<string-value>>

This is the name and address of the person who authored the module.  Typically it should be in the format: I<Name <e-mail-addressE<gt>>.  If left unspecified, the script will attempt to extract it from the tarball's MakeMaker file, failing to build the package otherwise.  There is no default for this option.

=item I<--packager=C<string-value>>

This is you (if you're packaging someone else's module).  The string should be in the same format as for --author and defaults to: C<Arix International <cpan2rpm@arix.comE<gt>> unless the RPM macro files provide a value.

=item I<--license=C<string-value>>

The license header specified in the spec file.  This field is also sometimes referred to as I<Copyright>, but I<License> is a more suitable name and has become more common.  Defaults to C<Artistic>, Perl's own license.

=item I<--distribution=C<string-value>>

The script will use the %{distribution} tag defined in the RPM macros file.  If this tag is not set, the script will attempt to determine the distribution name by looking at the F</etc/issue> file.  If this file does not exist, the distribution will be left blank.

=item I<--buildarch=C<string-value>>

Allows specification of an architecture for building the RPM.
Currently defaults to whatever matches $Config{config_args}
=~ /-march=(\S+)/ from "use Config;".

=item I<--buildroot=C<string-value>>

Allows specifying a directory to use as a BuildRoot.  Don't mess with this is you don't know what it is.  Defaults to: C<%{_tmppath}/%{name}-%{version}>.

=item I<--provides=C<string-value>>

Indicates that a package should be provided by the module being built.  RPM will generate an appropriate list of provided dependencies and any passed here will be I<in addition> to those calculated.

=item I<--requires=C<string-value>>

Indicates packages that should be required for installation.  This option works precisely as --requires above.

=item I<--no-requires=C<string-value>>

Suppresses generation of a given required dependency.  Sometimes authors create dependencies on modules the packager can't find, sometimes RPM generates spurious dependencies.  This option allows the packager to arbitrarily supress a given requirement.  The value may be a comma-separated list.

=item I<--spec-only>

This option instructs the script to not build the RPM package but instead to only display the generated spec file on stdout.

=item I<--make-maker=C<string-value>>

This option allows passing a string to the MakeMaker process (i.e. perl Makefile.PL <your-arguments-here>)

=item I<--maker=C<string-value>>

Arguments supplied here get passed directly to the make process.

=item I<--make-install=C<string-value>>

Allows user to supply arguments to the make install process.

=item I<--no-clean>

By default, the system passes I<--clean> to I<rpmbuild>, thus removing the unpacked sources from the BUILD directory.  This option suppresses that functionality.

=item I<--patch=C<string-value>>

This option allows specifying patch files to be inserted into the spec file and applied when building the source.  Please note the option may be used multiple time to specify multiple patches.

=item I<--nopkgprfx>

Suppresses prefixing the package name with the string C<perl->.

=item I<--force>

By default the script will do as little work as possible i.e. if it has alreaddy previously retrieved a module from CPAN, it will not retrieve it again.  If it has already generated a spec file it will not generate it again.  This option allows the packager to force all actions, starting from scratch.

=item I<--debug[=n]>

This option produces debugging output.  An optional integer increases the level of verbosity for this output.  If no integer is given, 1 is assumed.

=item I<--help, -h>

Displays a terse syntax message.

=back

=head1 NOTES

This script requires that RPM be installed.  Both B<rpm> and B<rpm-build>
must be installed on the local machine.  Please see the RPM documentation (man rpm) for further information.

Additionally, the B<Perl> module will be needed :) and the CPAN module
(which is bundled with the Perl distribution) will need to be configured.
For further information please refer to the CPAN manpage.

=head1 TODO

For now, the list below is what's awaits my attention, but I'm happy to work on any feature requests you may have :)

1. should really have an /etc file + ~/.cpan2rpm

=head1 BUGS

Same goes for bugs.

=head1 AUTHOR

Erick Calder <ecalder@cpan.org>

=head1 ACKNOWLEDGEMENTS

The script was inspired by B<cpanflute> which is distributed with the rpm-build package from RedHat.  Many thanks to Robert Brown <bbb@cpan.org> for all his cool tricks, advice and patient support.

=head1 AVAILABILITY

The latest version may always be found at:

F<http://perl.arix.com/>

=head1 LICENCE AND COPYRIGHT

This utility is free and distributed under GPL, the Gnu Public License.

=head1 CHANGES

$Log: cpan2rpm,v $
Revision 1.77  2002/11/14 02:54:57  ekkis
minor fix for new find (needed \\; for -exec)

Revision 1.76  2002/11/14 02:26:22  ekkis
thanks to Axel Thimm (Axel.Thimm@physik.fu-berlin.de) for the following suggestions:
- added --no-clean
- generalised calls to make, perl and other external programs with %{__make} macros, etc.
- replaced find call to require fewer external program dependencies

Revision 1.75  2002/11/08 20:24:06  bbb
Should "make test" too.
Maybe there should be an option to skip the "make test"?

Revision 1.74  2002/11/08 19:48:45  bbb
If libwww-perl is not installed,
show helpful warning,
then try some external programs:
wget, lynx, links, ncftpget
in that order.
And fix compile error from last commit.  :-)

Revision 1.73  2002/11/08 18:12:45  bbb
sudo success notification also.

Revision 1.72  2002/11/08 17:52:45  bbb
Explain how to configure sudo if needed.

Revision 1.71  2002/11/07 23:21:25  ekkis
wiped TODO since Rob knocked it out

Revision 1.70  2002/11/07 02:58:13  bbb
Better sudo error.

Revision 1.69  2002/11/07 02:40:31  bbb
Add sudo precheck.

Revision 1.68  2002/11/07 02:14:51  bbb
Use ~/redhat structure for non-root users.

Revision 1.67  2002/11/07 01:59:13  bbb
Removed --searchcpan flag.  (Forced on.)

Revision 1.66  2002/11/07 01:02:06  bbb
sudo to install if non-root

Revision 1.65  2002/11/07 00:34:54  bbb
Removed no-localcopy functionality to avoid making local copies of output files.

Revision 1.64  2002/11/07 00:24:58  bbb
More general instead of hard coding "i386" for buildarch.

Revision 1.63  2002/11/06 23:58:43  bbb
Works on RedHat 8.0 now too.

Revision 1.62  2002/11/06 18:39:41  bbb
Allow --install to upgrade from an old CPAN module.

Revision 1.61  2002/11/06 18:32:07  bbb
bad debug typo

Revision 1.60  2002/11/06 17:55:33  bbb
Documental changes.

Revision 1.59  2002/11/06 17:46:21  bbb
Now cpan2rpm rpm itself may be created purely
from the tarball to avoid CHICKEN-AND-EGG dilemma.
Usage:

  rpm -ta cpan2rpm-*.tar.gz


Added a --searchcpan option to walk search.cpan.org
for the latest tarball of the passed module.  Does
not require the CPAN module for this functionality.

Revision 1.58  2002/11/06 00:57:50  bbb
Use generic cpan author from url if no other author could be extracted.

Revision 1.57  2002/11/06 00:08:29  bbb
Allow --nopkgprfx to be compatible with --install option.

Revision 1.56  2002/11/05 23:52:13  bbb
Avoid broken ( " " ) VERSION.
Fix mkdir logic.
Work for multiple users on the same machine.
Fix --spec-only to really only output the spec contents.

Revision 1.55  2002/11/05 20:55:11  bbb
Oop, handle tabs correctly.

Revision 1.54  2002/11/05 20:32:53  bbb
Try LWP in case HTTP::Lite is not installed.
anal whitespace (nasty tabs)

Revision 1.53  2002/09/19 03:53:05  ekkis
patched to fix problem with tarballs that contain a leading ./ instead of just a directory name.  thx to Jim Radford <radford@robotics.caltech.edu> for pointing this out.

Revision 1.52  2002/09/19 03:37:21  ekkis
- added no-localcopy functionality to make local copies of output files
- made %setup section more generic
- patched use of HTTP::Lite
- rearranged POD to have Author on a single line and added acknowledgements and license info

Revision 1.51  2002/09/13 21:48:34  bbb
Only use one line of the AUTHOR perldoc section to avoid breaking rpm spec syntax.

Revision 1.50  2002/06/28 01:22:41  ekkis
- our thanks to Jim Radford <radford@robotics.caltech.edu> for all the suggestions and patches resulting in this batch of changes
- added --patch, --make and --make-install for greater flexibility
- fixed regexp generating %doc list.  code now picks up documentation in subdirectories
- modified use of HTTP::Lite to make optional.  cpan2rpm now works without it (minus capability to fetch urls)
- README file now shows how to boot-strap HTTP::Lite

Revision 1.49  2002/06/03 14:17:11  bbb
Add username to buildroot to avoid multi-user machine conflicts.

Revision 1.48  2002/06/01 01:07:38  ekkis
minor POD change

Revision 1.47  2002/06/01 01:04:24  ekkis
- now uses the POD's Synopsis section for the RPM Description tag.  This is the way it should be since POD Descriptions typically contain large amounts of text.
- Rewrote Synopsis and Description sections of the POD

Revision 1.46  2002/05/31 23:59:33  ekkis
- changed shebang line to make MakeMaker happy (thx Hook BOT)

Revision 1.45  2002/05/31 23:35:40  ekkis
- redesigned the %files section (at the suggestion of Eric Kolve [ekolve@corp.classmates.com]) to fix problems with modules that contain XS e.g. DBI
- added a smart %doc section which picks up documentation from the tarball (with help from Hook-BOT (Bob Brown <bbb@cpan.org>) for file regexp)
- now uses %{_prefix} to list files which is better than /usr since it allows redefinition e.g. _prefix=/usr/local (Hook-BOT)
- trimmed descriptions and reformatted ad banner
- improved %clean section with code that wipes the extracted source tree structure after building (which can bloat disk badly when doing a lot of rpms) - thx Hook-BOT!
- fixed --spec-only (thx Eric Kolve)

Revision 1.44  2002/05/29 16:32:10  bbb
~/.rpmmacros

Revision 1.43  2002/05/28 23:32:29  ekkis
changed e-mail addresses

Revision 1.42  2002/05/28 23:13:28  bbb
Same as second round "1.3" but in the right place now.

Revision 1.5  2002/05/23 02:55:37  ekkis
adding "use strict" forces Makefile.PL to be eval()uated that way so had to add "no strict" to eval string.  Also added warning in case eval fails.

Revision 1.4  2002/05/23 02:43:43  ekkis
added use strict

Revision 1.3  2002/05/23 02:14:04  ekkis
oops, small patch

Revision 1.2  2002/05/23 02:13:07  ekkis
added --nopkgprfx in case we want to build RPMs without a prepended "perl-" (as in the case of cpan2rpm<g>)

Revision 1.1  2002/05/22 23:47:59  ekkis
Moved from dist to .

Revision 1.40  2002/05/22 23:03:35  ekkis
since we're no longer including the package version number in the spec filename when building multiple versions of the same package we're force to --force.  this makes no sense to the script will now _always_ build the spec file

Revision 1.39  2002/05/19 01:04:44  ekkis
still haveing problem with DBI - couldn't figure out how to eval() Makefile.PL so assuming pkgname from module (or passed)

Revision 1.38  2002/05/18 22:55:00  ekkis
- patched to allow calls like "use ExtUtils::MakeMaker qw(WriteMakefile)"... note this currently only works with () and will fail with qw//.  Due to DBI calls.
- also changed MyExit() to die() instead since we really do need for the script to exit but without exiting us!
- patched to allow for calls like  ExtUtils::MakeMaker::WriteMakefile() as found in DBD::mysql

Revision 1.37  2002/05/07 04:21:49  ekkis
added --make-maker parameter

Revision 1.36  2002/04/23 00:29:24  ekkis
- implemented protection of my variables from Makefile.PL being eval()d by surrounding that code with a package.  Considered the Safe module but decided against another dependency.

Revision 1.35  2002/04/22 23:19:13  ekkis
--provides and --requires weren't working

Revision 1.34  2002/04/18 08:32:53  ekkis
- put back code to generate name/e-mail addr of packager (uses hostname())
- added END {} code to make sure we clean up.  $SIG{__DIE__} works only for die() calls
- now picks up AUTHOR from tarball POD when possible
- modified version parsing code to allow versions with alpha
- redesigned tarls().  now context sensitive, much better way to determine embedded directory
- writefile() now checks for existence

Revision 1.33  2002/04/17 08:52:43  ekkis
- some bug fixes
- {force} implementation for get_url()

Revision 1.32  2002/04/17 08:40:50  ekkis
- added --no-requires, --find-provides, --find-requires and --install options
- now can receive a URL to download from
- reimplemented MyExit for eval()ing Makefile.PL
- enhancements to writefile()

Revision 1.31  2002/04/16 04:06:53  ekkis
ripped out all dependency (provides,requires) generation code as the newer rpm-buid generates this correctly

Revision 1.30  2002/04/12 17:22:35  ekkis
- filelist is now abstracted
- cool new method for extracting CVS version without breaking emacs
- new regexp for splitting path/filename from given $info{module}

Revision 1.29  2002/04/09 23:00:16  ekkis
took out %define version and release as it causes recursive behaviour

Revision 1.28  2002/04/09 22:20:41  ekkis
- better relative path handling
- now prepends url to Source: field when available via CPAN
- BuildRoot more automated now

Revision 1.27  2002/04/09 08:25:00  ekkis
- now requires version 0.59 or greater of CPAN as previous versions are problema tic
- implemented use of RPM macros to figure outdirectory structures.  script now p arses the various macro definition files and does recursive expansions to figure out correct values... see docs.
- added support for a full-path tarball specification.  this allows the user to call cpan2rpm with any tarball anywhere.  The tarball will be copied to SOURCES.
- defined %version, %release
- added Rob Brown's perlver %defines
- BuildRoot now defaults to the standard %{_tmpdir}
- removed version number from spec filename
- now scans only usr/lib in tmpdir for modules (should give better Provides headers since we don't pick up .pm files in other directories like examples/)
- added code to figure out real module dependencies (PREREQ_PM is unreliable)
- now attempts to read VERSION_FROM if neither ABSTRACT nor ABSTRACT_FROM is provided.  failing that it will take the module name (minus any parent info, plus appropriate extension e.g. Ping.pm from Net::Ping), and if that file exists will scan it for POD

Revision 1.26  2002/04/08 22:30:35  ekkis
now requires CPAN version 0.59 as previous versions seem broken
added to TODO list

Revision 1.25  2002/04/07 09:18:19  ekkis
hijacked exit() for the Makefile.PL eval since certain modules exit on us (not very exciting) e.g. POE

Revision 1.24  2002/04/07 02:31:00  ekkis
fixed generation of dependencies on Perl core modules (not allowed)

Revision 1.23  2002/04/07 01:15:33  ekkis
removed dashed lines from CHANGES section... don't konw thy CVS does use this in keyword expansion!

Revision 1.22  2002/04/07 01:12:24  ekkis
added old Log info

Revision 1.21  2002/04/07 01:09:01  ekkis
tarball maker now calls system() instead of qx// so user can see prompts
added CHANGES section

revision 1.20
date: 2002/04/07 00:06:20;  author: ekkis;  state: Exp;  lines: +4 -1
added back author info retrieval from CPAN when possible

revision 1.19
date: 2002/04/06 23:45:25;  author: ekkis;  state: Exp;  lines: +4 -2
added availability section to pod

revision 1.18
date: 2002/04/06 23:43:00;  author: ekkis;  state: Exp;  lines: +6 -8
changed default for license to "Artistic" as most modules are released under Perl's own license.

revision 1.17
date: 2002/04/06 23:13:31;  author: ekkis;  state: Exp;  lines: +2 -2
removed spaces before =head1 NAME - he cares!!

revision 1.16
date: 2002/04/06 23:03:28;  author: ekkis;  state: Exp;  lines: +2 -2
a fix for a fix

revision 1.15
date: 2002/04/06 22:51:36;  author: ekkis;  state: Exp;  lines: +2 -2
fixed docs

revision 1.14
date: 2002/04/06 22:47:40;  author: ekkis;  state: Exp;  lines: +33 -19
added --debug
added -n in calls to silence questions from Makefile.PL (may not always work)
now makes sure /tmp/cpan2rpm exists, creates as needed

revision 1.13
date: 2002/04/06 02:34:15;  author: ekkis;  state: Exp;  lines: +18 -1
status info

revision 1.12
date: 2002/04/06 01:57:31;  author: ekkis;  state: Exp;  lines: +8 -5
enhancement for f2mod() to generate RPM dependencies

revision 1.11
date: 2002/04/06 01:51:22;  author: ekkis;  state: Exp;  lines: +71 -68
various fixes
incorporated provides() into get_meta()
correctly generates Provides header

revision 1.10
date: 2002/04/06 00:01:15;  author: ekkis;  state: Exp;  lines: +55 -22
added f2mod()
enhancements to untar()
now generates Provides headers

revision 1.9
date: 2002/04/05 22:37:05;  author: ekkis;  state: Exp;  lines: +167 -102
major code reorg
now uses ExtUtils::Installed for platform independent module listings
added --provides and --spec-only

revision 1.8
date: 2002/04/05 05:29:57;  author: ekkis;  state: Exp;  lines: +2 -2
fixed regexp for tardir

revision 1.7
date: 2002/04/05 02:07:25;  author: ekkis;  state: Exp;  lines: +33 -20
now eval()s Makefile.PL instead of parsing it
also looks up DESCRIPTION from module file for spec file

revision 1.6
date: 2002/04/04 03:55:27;  author: ekkis;  state: Exp;  lines: +2 -2
fixed embedded >s in C<> tags

revision 1.5
date: 2002/04/04 03:47:34;  author: ekkis;  state: Exp;  lines: +15 -5
added author support

revision 1.4
date: 2002/04/04 02:20:32;  author: ekkis;  state: Exp;  lines: +105 -83
general cleanup
now excepts core Perl modules from RPM dependencies
now supports ABSTRACT_FROM
improved PREREQ_PM handling (with Provides: clause)

revision 1.3
date: 2002/04/03 12:33:14;  author: ekkis;  state: Exp;  lines: +38 -18
various bug fixes

revision 1.2
date: 2002/04/03 11:08:32;  author: ekkis;  state: Exp;  lines: +144 -142
now retrieves metadata from tarball

revision 1.1
date: 2002/04/03 10:57:00;  author: ekkis;  state: Exp;
branches:  1.1.1;
Initial revision

revision 1.1.1.1
date: 2002/04/03 10:57:00;  author: ekkis;  state: Exp;  lines: +0 -0
Initial import

=cut
