#!/usr/bin/perl -w
#
# Make an rpm out of a tarball.
#
# 30-Jun-2002
#   Started making this actually work, although I'm sure there are
#   three hundred scripts to do this on Freshmeat.
# 20/06/2003
#   Allow --group
#   Clean up test area
#   use %configure and %makeinstall macros
# 08/11/2003
#   Use --eval instead of -E for rpm macro expansion
# 18/02/2006
#   Merge in rebuildspec code
#
# * Detects some configure scripts
# * Tries to guess if %setup needs any parameters
# * Tries to populate %doc
# * Tries to locate GPL, Apache, or Artistic License
#
# Fixmes:
# - check for existing specfile and use it for defaults
# - use Archive::Tar to unpack
#   - Archive::Zip
#   - Compress::Zlib
#   - bzip handling also
use strict;
use File::Basename;
use File::Copy;
use File::Path;
use Getopt::Long;
use POSIX;
use RPM::Specfile;
use RPM2;

my $group = "";
my $groupwith = "";
my $rpm = "/bin/rpm";
my $specdir = `$rpm --eval \%_specdir`;
my $sourcedir = `$rpm --eval \%_sourcedir`;
my $configure = `$rpm --eval \%configure`;
my $dist = "";
my $release = 1;

my @patches;
my @obsoletes;
my @ignorespec;

chomp( $specdir );
chomp( $sourcedir );

my ( $forcename, $forcever );

GetOptions( 'group=s' => \$group, 'groupwith=s' => \$groupwith,
            'group-with=s' => \$groupwith, # because I can never remember
            'patch=s' => \@patches,
            'ignorespec=s' => \@ignorespec,
            'obsoletes=s' => \@obsoletes,
            'distribution=s' => \$dist,
            'name=s' => \$forcename, 'version=s' => \$forcever ) or die;

# figure out what our distro is, approximately.
if ( !$dist ) {
    if ( -f "/etc/redhat-release" ) {
        my $p = `rpm -qf /etc/redhat-release`;
        if ( `grep Enterprise /etc/redhat-release 2>/dev/null` ) {
            $dist = "rhel";
        } elsif ( `grep Fedora /etc/redhat-release 2>/dev/null` ) {
            $dist = "fc";
        } else {
            $dist = "rh";
        }
        $dist .= `rpm -q --queryformat "\%{VERSION}" $p`;
    } else {
        $dist = "nodist";
    }
}

$release .= ".$dist";

my $rpmspec = new RPM::Specfile;

my $specfile = <<"EOT";
Summary:
Name:
Version:
Release: $release
License:
Group:
Source:
#Patch:
#Requires:
BuildRoot: /var/tmp/%{name}-buildroot

%description

%prep
%setup
#%patch

%build
%configure
make

%install
%makeinstall

%clean
/bin/rm -rf \$RPM_BUILD_ROOT

%files
%defattr(-,root,root)
# %doc
# %config
EOT

makespec( $ARGV[0], \@patches );

sub makespec {
    my ( $file, $patches ) = @_;
    my @spec;
    $file or die "Usage: $0 filename\n";
    -f $file or die "$file not found\n";

    if ( @{$patches} ) {
      for my $patch ( @{$patches} ) {
        if ( ! -f $patch ) {
           die "patch $patch not found\n";
        }
      }
    }

    my ( $name, $version, $archive, $origfile, $summary, $havespec, $copyright );
    $copyright = "Unknown";

    $origfile = $file;
    $file = basename $file;

    # Kinda bogus, because tarfiles can have all sorts of stupid
    # naming conventions, but we'll start with this because it's
    # common enough.
    ( $name, $version, $archive ) =
      $file =~ m{^(.*?)-(\d+\..*)\.(tar\.(gz|Z|bz2)|tgz|zip)$}i;

    # try without a version
    if ( !defined( $name )) {
        ( $name, $archive ) =
          $file =~ m{^(.*?)\.(tar\.(gz|Z|bz2)|tgz|zip)$}i;
        $version = "1.0.0";
    }

    $name = $forcename if $forcename;
    $version = $forcever if $forcever;

    die "Can't parse a name out of $file\n" unless $name;

    # Version can't contain -
    # (are other chars allowed?)
    $version =~ s/\-/_/g;

    # might try something clever with this some other time
    $summary = $name;

    print "Building a spec file for $name version $version\n";

    # let's see if there's already a version of this package installed
    # - we can use it to set some defaults. In theory we should be
    # able to reconstruct most of the specfile.
    my $db = RPM2->open_rpm_db();
    my $already = 0;
    if ( my $pkgs = $db->find_by_name_iter( $name )) {
        $already = $pkgs->next; # ignore all except the first
    }

    my $spec;
    if ( $already ) {
        print "  You've already got a version of $name installed\n";
        #$summary = `$rpm -q --queryformat \%{SUMMARY} $name 2>/dev/null`;
        $summary = $already->tag( 'SUMMARY' );

        $spec = rebuildspec( $name );
    } else {
        print "  No previous installations found\n";
    }

    if ( $groupwith ) {
        $group = `$rpm -q $groupwith --queryformat \%{GROUP} 2>/dev/null`;
        chomp( $group );
        if ( $group =~ /package $groupwith is not installed/ ) {
            die "error: $group\n";
        } else {
            print "  Using group $group (same as $groupwith)\n";
        }
    }

    # Groups can be obtained from /usr/share/doc/rpm-$version/GROUPS,
    # and the user prompted to select one or specify one on the
    # command line.
    my $rpmver = `$rpm -q --qf %{VERSION} rpm`;
    if ( open( GROUPS, "/usr/share/doc/rpm-$rpmver/GROUPS" )) {
        my @groups = <GROUPS>;
        close( GROUPS );
        if ( !grep /^$group$/, @groups ) {
            if ( $already ) {
                $group = `$rpm -q $name --queryformat "%{GROUP}"`;
                print "    extracted group $group from existing install\n";
            } elsif ( $group ) {
                print STDERR "Unknown group '$group'\n";
                print STDERR "Choose one from:\n\t" . join( "\t", @groups ) .
                  "\n";
                exit(1);
            } else {
                print STDERR "No group specified!\n";
                print STDERR "Choose one from:\n\t" . join( "\t", @groups ) .
                  "\n";
                exit(1);
            }
        }
    } else {
        warn "Can't find/open GROUPS file: $!";
    }

    # Patches can be specified on the command line.

    if ( @obsoletes ) {
        my $obsoletes = join( " ", @obsoletes );
        $specfile =~ s/Source:/Source:\nObsoletes: $obsoletes/s;
    }

    # Look for licensing and other details
    my $buildroot = "/var/tmp/$ {name}-buildroot";
    my $base = "";
    my @docs;
    my $autoconf = "";
    mkdir $buildroot, 0755 || die "Can't create $buildroot!\n";

    if ( defined( $archive )) {
        print "  Inspecting archive...\n";
        my $compressor;
        my $archiver;
        my $lister;
        if ( $archive =~ /(tar\.(gz|Z)|tgz)/i ) {
            $archiver = "tar xf";
            $compressor = "z";
            $lister = "tar tf";
        } elsif ( $archive =~ /tar.bz2$/i ) {
            $archiver = "tar xf";
            $compressor = "j";
            $lister = "tar tf";
        } elsif ( $archive =~ /zip$/i ) {
            $archiver = "unzip ";
            $compressor = "";
            $lister = "unzip -v";
        }

        # check for a built-in spec file
        print "  Checking for .spec files...";
        my $cmd;
        if ( $lister !~ /unzip/ ) {
            $cmd = "$lister$compressor $origfile \"*.spec*\" 2>/dev/null";
            $havespec = `$cmd`;
        } else {
            $havespec = "";
        }

        for my $ignore ( @ignorespec ) {
            $havespec =~ s/\S+$ignore//;
        }
        $havespec =~ s/^\s*$//;

        if ( $havespec ) {
            chomp( $havespec );

            if ( $havespec =~ /[\r\n]/ ) {
                # let's try and narrow the choices
                my @specs = grep /\.spec(\.in)?$/,
                  split( /[\r\n]/, $havespec );
                if ( $#specs == 1 ) {
                    # favour the ".in" candidate
                    if ( $specs[0] eq $specs[1] . ".in" ) {
                        $havespec = $specs[0];
                    } elsif ( $specs[0] . ".in" eq $specs[1] ) {
                        $havespec = $specs[1];
                    } else {
                        die
                          "multiple specfiles found, you're on your own:\n  " .
                            join( "\n  ", $havespec, @specs ) . "\n";
                    }
                } else {
                    die "multiple specfiles found, you're on your own.\n";
                }
            } else {
                if ( $havespec =~ /\.spec.in/ ) {
                    # need to generate the real .spec file
                    print "found spec.in ($havespec)\n";
                } else {
                    print "found specfile ($havespec)\n";
                }
            }
        } else {
            print "none found\n";
        }

        # XXX this is pretty damned awful
        copy "$origfile", "$buildroot";
        `cd $buildroot; $archiver$compressor $file`;

        # Look for common subdirectories - this will be used for %setup,
        # too.
        if ( -d "$buildroot/$name" ) {
            $base = "$name";
        } elsif ( -d "$buildroot/$name-$version" ) {
            $base = "$name-$version";
        } elsif ( -d "$buildroot/$ {name}_$version" ) {
            $base .= "$ {name}_$version";
        } else {
            # Look for a lone directory in there
            opendir( BASEDIR, "$buildroot" ) or
              die "can't open $buildroot: $!";
            my @dirs = grep !/^(\.\.?|$file)$/, readdir( BASEDIR );
            closedir( BASEDIR );
            if ( scalar( @dirs ) == 1 ) {
                $base = $dirs[0];
            } else {
                print STDERR "Basedir ($buildroot) contents:\n";
                print STDERR join( "\n", @dirs ) . "\n";
                #       die "Okay, make the goddamn base detection smarter.";
                print "    I'm guessing it needs a directory created.\n";
            }
        }

        if ( $base ) {
            print "    Will build in BUILD/$base\n";
            # parse out a new version!
            my $tmpver = $base;
            $tmpver =~ s/^$name//;
            $tmpver =~ s/^.*?([0-9].*)$/$1/;

            if ( $tmpver and $tmpver ne $version ) {
                print "    New version string: $tmpver\n";
                $version = $tmpver;
            }
        }

        # if we need to build a spec file, now would be a good time to do so.
        if ( $havespec =~ /\.spec.in/ ) {
            print "    Building .spec from .spec.in...";
            # .in suggests configure is present. However, we may also
            # need to do the autoconf dance of doom, etc.
            if ( ! -e "$buildroot/$base/configure" ) {
                if ( -e "$buildroot/$base/bootstrap" ) {
                    `cd $buildroot/$base; ./bootstrap`;
                }
            }
            `cd $buildroot/$base; $configure`;
            $havespec =~ s/\.in$//;
            print "done\n";
        }

        if ( $havespec ) {
            print "    Checking provided specfile for sanity...";
            open( SPEC, "<$buildroot/$havespec" ) or
              die "seems like it didn't generate ($buildroot/$havespec: $!)";
            local $/ = undef;
            $specfile = <SPEC>;
            close( SPEC );

            # things that are liable to be hosed: mostly, just the
            # name of the source file.
            # unfortunately, use of macros can make this pretty sucky
            $specfile =~ s/^Source:.*$/Source: $file/m;
            ( $group ) = $specfile =~ m/^Group: (.*)$/m;
            $specfile =~ s/^Version: .*$/Version: $version/m;

            print "done\n";
        }

        opendir( CONTENTS, "$buildroot/$base" );
        my @files = grep !/^\.(\.)?$/, readdir CONTENTS;
        closedir( CONTENTS );

        for my $f ( @files ) {
            # Generally, files in all-caps are documentation. Sometimes
            # they'll be called FILENAME.ext, though.
            if ( $f =~ /^[A-Z]+(\..*)?$/ ) {
                push @docs, $f;
                print "    Found probable doc file $f\n";

                if ( $f =~ /^COPYING(\.LIB)?$/ or $f eq "GPL" or
                     $f eq "LICENSE" ) {
                    if ( open( GPL, "$buildroot/$base/$f" )) {
                        while (<GPL>) {
                            if ( /Apache Software License/ ) {
                                $copyright = "Apache Software License";
                                last;
                            }
                            next if /^\s*$/;
                            if ( /GNU.*GENERAL PUBLIC LICENSE/ ) {
                                print "      This looks like the GPL or LGPL.\n";
                                $copyright = "GPL";
                                last;
                            }
                        }
                    }
                    if ( !$copyright ) {
                        $copyright = "See $f for info";
                    }
                }
            }

            if ( $f eq "Artistic" ) {
                # XXX open it and have a look
                print "      Found Artistic license\n";
                $copyright = "Artistic";
                push @docs, $f;
            }

            # Yay, it's a configure script!
            if ( $f eq "configure" ) {
                $autoconf = '%configure';
                print "    Found configure script\n";
            }

            if ( $f eq "autogen.sh" ) {
                $autoconf = "./autogen.sh\n\%configure";
                print "    Found autogen script\n";
            }

            if ( $f eq "Makefile.PL" ) { # shouldn't you be using cpanflute?
                $autoconf = "perl";
                print "    Found Makefile.PL\n";
            }
        }

        # let's make any perl modules that aren't otherwise licensed
        # into Artistic licenses.
        if ( !$copyright and $autoconf eq "perl" ) {
            $copyright = "Artistic";
        }

        if ( $autoconf eq "perl" ) {
            $autoconf = 'CFLAGS="$RPM_OPT_FLAGS" perl Makefile.PL PREFIX=$RPM_BUILD_ROOT%{_prefix}';
        }

        print "  Cleaning up inspection area...";
        `/bin/rm -rf $buildroot`;
        print "done\n";
    }

    # Summarize
    print "================================================================\n";
    print <<"EOT";
Name: $name
Version: $version
Summary: $summary
Group: $group
License: $copyright
EOT

    my $desc;
    if ( $already ) {
        $desc = `$rpm -q --queryformat \%{DESCRIPTION} $name 2>/dev/null`;
    } else {
        $desc = "";
    }

    # make $specdir if it doesn't exist!
    -d $specdir or mkpath( [ $specdir ], 0, 0755 );
    open( SPEC, ">$specdir/$name.spec" ) or die $!;
    if ( !$havespec ) {
        for my $line ( split /\n/, $specfile ) {
            $line =~ s/^Copyright:/License:/;
            $line =~ /^Summary:/and $line .= " $summary";
            $line =~ /^Name:/ and $line .= " $name";
            $line =~ /^Version:/ and $line .= " $version";
            $line =~ /^Source:/ and $line .= " $file";
            $line =~ /^License:/ and $line .= " $copyright";
            $line =~ /^Group:/ and $line .= " $group";

            # Fix the directory name
            if ( $line =~ /^\%setup/ ) {
                # If there's no base, then we need to fix that
                if ( !$base ) {
                    $line .= " -n $name-$version -c";
                } elsif ( $base and $base ne "$name-$version" ) {
                    $line .= " -n $base";
                }
            }

            if ( $line =~ /^\%description/ ) {
                $line .= "\n$desc" if $desc;
            }

            # Configure script found!
            if ( $line =~ /^%configure$/ ) {
                if ( !$autoconf  ) {
                    $line = "# UNKNOWN CONFIG METHOD\n";
                } else {
                    $line = $autoconf;
                }
            }

            # Add in the docs
            if ( $line =~ /^# \%doc/ ) {
                if ( @docs ) {
                    $line = "\%doc " . join( " ", @docs ) . "\n";
                } else {
                    next;       # don't print a %doc line
                }
            }
            print SPEC "$line\n";
        }
    } else {
        print SPEC $specfile;
    }
    close SPEC;

    print "Wrote $name.spec\n";

    # don't overwrite $origfile if $origfile is in $sourcedir
    if ( -f "$sourcedir/" . basename $origfile ) {
        print "It appears you already have a file in $sourcedir for this package; I'm not going to overwrite that.\n";
    } else {
        if ( ! rename "$origfile", "$sourcedir/" . basename $file ) {
            copy( $origfile, "$sourcedir/" . basename $file );
        }
    }
}

# This used be an entirely separate script...
sub rebuildspec {
    my $file = shift;
    my $pkg;

    # Find out if this is an installed package or something on disk
    open( INFO, "$rpm -q $file|" );
    my @info = <INFO>;
    close( INFO );

    if ( grep /^package $file is not installed$/, @info ) {
        $pkg = "p";
    } else {
        $pkg = "";
    }

    # Handy variable to have around
    my $thispkg = `$rpm -q$pkg --queryformat '[%{NAME}-%{VERSION}]' $file`;

    # see if there's anything else built from the same src.rpm as this
    my @allpkgs = ( $thispkg );
    my $srcrpm = `$rpm -q$pkg --queryformat '[%{SOURCERPM}]' $file`;
    print STDERR "Source came from $srcrpm, looking for other packages built from that...\n";
    for my $line ( split( /\n/, `$rpm -qa --queryformat '%{SOURCERPM} %{NAME}-%{VERSION}\n'` )) {
        my ( $s, $p ) = split( ' ', $line );
        if ( $s eq $srcrpm ) {
            push @allpkgs, $p unless grep /^$p$/, @allpkgs;
        }
    }

    # Some of this is bloody EVIL.
    my $format =<<"EOF";
Summary: %{SUMMARY}
Name: %{NAME}
Version: %{VERSION}
Release: %{RELEASE}
Copyright: %{COPYRIGHT}%|COPYRIGHT?{}:{ DELETEME}|
Group: %{GROUP}
Source: %{SOURCE}%|SOURCE?{}:{ DELETEME}|
%|SOURCE?{ DELETEME}:{Source: $thispkg.tar.gz}|
Url: %{URL}%|URL?{}:{ DELETEME}|
Packager: %{PACKAGER}%|PACKAGER?{}:{ DELETEME}|
Vendor: %{VENDOR}%|VENDOR?{}:{ DELETEME}|
Requires: [%{REQUIRENAME} %{REQUIREFLAGS} %{REQUIREVERSION} ]%|REQUIRENAME?{}:{ DELETEME}|
Provides: [%{PROVIDES} ]

%%description
%{DESCRIPTION}

%%prep

%%setup

%%build

%%install

%%clean

%%pre%|PREIN?{}:{ DELETEME}|
%{PREIN}%|PREIN?{\n}:{ DELETEME}|
%%post%|POSTIN?{}:{ DELETEME}|
%{POSTIN}%|POSTIN?{\n}:{ DELETEME}|
%%preun%|PREUN?{}:{ DELETEME}|
%{PREUN}%|PREUN?{\n}:{ DELETEME}|
%%postun%|POSTUN?{}:{ DELETEME}|
%{POSTUN}%|POSTUN?{\n}:{ DELETEME}|
%%files
EOF

    print "Recovering huge lumpy chunks\n";
    my @lines = grep !/ DELETEME$/, `$rpm -q$pkg --queryformat '$format' $file`;

    # MAGIC!
    @lines = map { if ( /^Requires\: / ) {
        s/\s+0\s+/ /g;
        s/12/>=/g;
        s/16396/>=/g;
        s/ (16384|64|1344|4416) //g; # no version specified
        s/(16777290|74)/<=/g;
    } $_; } @lines;

    # Ideally, we could slim down the above by figuring out what
    # provides each requirement, and sorting and uniquing that.

    # Now figure out the %files section
    print STDERR "recovering files list...\n";
    my @lines2 = `$rpm -q$pkg --queryformat '[%{FILEFLAGS} %{FILENAMES}\n]' $file`;

    # Fix the flags for each file
    @lines2 = map { s|^2 (/usr/(share/)?doc/$thispkg/)?|\%doc |;
                    s|^1 |\%config |;
                    s|^0 ||;
                    s|/usr/doc/$thispkg\n||; # throw away
                    $_ } @lines2;

    # clean up the files list a bit
    my @docs = grep /^\%doc/, @lines2;
    my @files = grep !/^\%doc/, @lines2;

    my @man = grep /\/man\d/, @docs;
    @docs = grep !/\/man\d/, @docs;
    @man = map { s|\%doc ||; $_ } @man;

    push @lines, join( " ", "\%doc", map { s|^\%doc (.*)\n|$1|; $_ } @docs ) . "\n";

    push @lines, ( @files, @man );

    # add in the changelog
    push @lines, "\n";
    push @lines, "\%changelog\n";

    for my $cl ( split( '\n', `$rpm -q$pkg --queryformat '[* %{CHANGELOGTIME} %{CHANGELOGNAME}\n%{CHANGELOGTEXT}\n\n]' $file` )) {
        if ( $cl =~ /^\* (\d+) (.*)$/ ) {
            $cl = strftime( "* %a %b %e %Y $2", gmtime( $1 ));
        }
        push @lines, $cl . "\n";
    }

    return join( '', @lines );
}