#!/usr/bin/perl -Tw
#
# specgen -- Tool for creating spec files for generic package types.
# 
# Copyright (C) 2004, Michael Jennings
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies of the Software, its documentation and marketing & publicity
# materials, and acknowledgment shall be given in the documentation, materials
# and software packages that this Software was used.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
# THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
# IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#
# $Id: specgen,v 1.13 2006/10/03 22:04:57 mej Exp $
#

use strict;
use POSIX;
use File::Find;
use Mezzanine::Util;
use Mezzanine::Template;
use Mezzanine::Src;
use Mezzanine::PkgVars;
use Mezzanine::Build;
use Mezzanine::RPM;

my $interactive = 0;
my %package_start = (
                     "SUMMARY" => "FIXME -- Brief synopsis goes here",
                     "NAME" => "",
                     "VERSION" => "",
                     "RELEASE" => "1.%{?_vendorsuffix:%{_vendorsuffix}}%{!?_vendorsuffix:%{_vendor}}",
                     "VENDORSUFFIX" => "%{?_vendorsuffix:%{_vendorsuffix}}%{!?_vendorsuffix:%{_vendor}}",
                     "LICENSE" => "OSI-Approved",
                     "GROUP" => "FIXME/SetThis",
                     "TARBALL" => "",
                     "EXTRACTWITH" => "",
                     "PACKAGER" => "%{?_packager:%{_packager}}%{!?_packager:%{_vendor}}",
                     "VENDOR" => "%{?_vendorinfo:%{_vendorinfo}}%{!?_vendorinfo:%{_vendor}}",
                     "DISTRIBUTION" => "%{?_distribution:%{_distribution}}%{!?_distribution:%{_vendor}}",
                     "DESCRIPTION" => "FIXME -- Description goes here",
                     "SETUP" => "",
                     "CFLAGS" => "%{?cflags:%{cflags}}%{!?cflags:\$RPM_OPT_FLAGS}",
                     "CXXFLAGS" => "%{?cxxflags:%{cxxflags}}%{!?cflags:\$RPM_OPT_FLAGS}",
                     "DOCFILES" => "",
                     "INSTFILES" => "/*",
                     "CHANGELOG" => sprintf("* %s Mezzanine <mezzanine\@kainx.org>\n- %s\n",
                                            POSIX::strftime("%a %b %d %Y", localtime()),
                                            "Specfile auto-generated by $PROGNAME"),
                     "TEMPLATE" => undef
                    );

# Print usage information
sub
print_usage_info
{
    my ($leader, $underbar);

    print "\n";
    $leader = "$PROGNAME $VERSION Usage Information";
    $underbar = $leader;
    $underbar =~ s/./-/g;
    print "$leader\n$underbar\n";
    print "\n";
    print "  Syntax:   specgen [ options ] package [...]\n";
    print "\n";
    print "    -h --help                        Show this usage information\n";
    print "    -d --debug                       Turn on debugging\n";
    print "    -v --version                     Show version and copyright\n";
    print "    -t --template <path>             Use specified template file/directory\n";
    print "    -i --interactive                 Confirm each setting interactively\n";
    print "\n";
    exit(MEZZANINE_SUCCESS);
}

# Interactively obtain information from the user IFF stdin and stdout are tty's.
sub
prompt_user($$)
{
    my ($prompt, $default) = @_;
    my $response;

    if (!(-t STDIN && -t STDOUT)) {
        return $default;
    }
    if ($default) {
        print "$prompt (default \"$default\"):  ";
    } else {
        print "$prompt:  ";
    }
    $response = <STDIN>;
    chomp($response);

    return (($response) ? (&untaint(\$response)) : ($default));
}

sub
get_tarball($)
{
    my $tarball = shift;
    my $msg;

    print "Downloading $tarball...";
    $msg = &fetch_url($tarball);
    if (! -e $msg) {
        eprint "\nUnable to fetch $tarball:  $msg.\n";
        return undef;
    }
    return $msg;
}

sub
parse_tarball_name($)
{
    my $href = $_[0];
    my $pkg = $href->{"TARBALL"};

    if (! $pkg) {
        eprint "Ummm...no package?  Somebody screwed the pooch.\n";
        return undef;
    }

    if ($pkg =~ /(\.(t|tar\.)gz)$/i) {
        $href->{"EXTRACTWITH"} = "gzip -d -c \@\@ | tar -xf -";
        $pkg =~ s/$1$//;
    } elsif ($pkg =~ /(\.(t|tar\.)bz2?)$/i) {
        $href->{"EXTRACTWITH"} = "bzip2 -d -c \@\@ | tar -xf -";
        $pkg =~ s/$1$//;
    } elsif ($pkg =~ /(\.(t|tar\.)Z)$/i) {
        $href->{"EXTRACTWITH"} = "compress -d -c \@\@ | tar -xf -";
        $pkg =~ s/$1$//;
    } elsif ($pkg =~ /(\.zip)$/i) {
        $href->{"EXTRACTWITH"} = "unzip \@\@";
        $pkg =~ s/$1$//;
    } elsif ($pkg =~ /(\.(c|cpio\.)gz)$/i) {
        $href->{"EXTRACTWITH"} = "gzip -d -c \@\@ | cpio -iud";
        $pkg =~ s/$1$//;
    } elsif ($pkg =~ /(\.(c|cpio\.)bz2?)$/i) {
        $href->{"EXTRACTWITH"} = "bzip2 -d -c \@\@ | cpio -iud";
        $pkg =~ s/$1$//;
    } elsif ($pkg =~ /(\.(c|cpio\.)Z)$/i) {
        $href->{"EXTRACTWITH"} = "compress -d -c \@\@ | cpio -iud";
        $pkg =~ s/$1$//;
    } elsif ($pkg =~ /(_[^\.]+\.deb)$/i) {
        $href->{"EXTRACTWITH"} = "ar x \@\@";
        $pkg =~ s/$1$//;
    } elsif ($pkg =~ /(\.[^\.]+\.rpm)$/i) {
        $href->{"EXTRACTWITH"} = "rpm2cpio \@\@ | cpio -iud";
        $pkg =~ s/$1$//;
    } elsif ($pkg =~ /(\.jar)$/i) {
        $href->{"EXTRACTWITH"} = "true \@\@";
        $pkg =~ s/$1$//;
    } else {
        wprint "Unrecognized package file format.\n";
        for ($href->{"EXTRACTWITH"} = ""; $href->{"EXTRACTWITH"}; ) {
            $href->{"EXTRACTWITH"} = &prompt_user("Please enter command to extract $pkg (specify \@\@ for $pkg)");
            if ($href->{"EXTRACTWITH"} !~ /\@\@/) {
                eprint "The command must contain \@\@ at the position where the archive filename should go.  Please try again.\n\n";
                $href->{"EXTRACTWITH"} = "";
            }
        }
    }
    if (! $href->{"EXTRACTWITH"}) {
        eprint "Unrecognized package file format.\n";
        return undef;
    } else {
        if ($interactive) {
            $href->{"EXTRACTWITH"} = &prompt_user("Please enter command to extract $href->{TARBALL} "
                                                  . "(specify \@\@ for archive)", $href->{"EXTRACTWITH"});
        }
        dprint "Extraction command for $pkg is $href->{EXTRACTWITH}.\n";
    }

    # Parse out package name and version.
    if ($pkg =~ /^(.*)-(\d[^-]+)$/) {
        @{$href}{("NAME", "VERSION")} = ($1, $2);
    } elsif ($pkg =~ /^(.*)_(\d[^_]+)$/) {
        @{$href}{("NAME", "VERSION")} = ($1, $2);
    } else {
        wprint "Unable to parse package name/version from base name $pkg.\n";
        $href->{"NAME"} = &prompt_user("Please enter package name", $pkg);
        $href->{"VERSION"} = &prompt_user("Please enter package version", "1.0");
    }
    if (! $href->{"NAME"} || ! $href->{"VERSION"}) {
        eprint "Unparseable package file base name $pkg.\n";
        return undef;
    } else {
        if ($interactive) {
            $href->{"NAME"} = &prompt_user("Please enter package name", $href->{"NAME"});
            $href->{"VERSION"} = &prompt_user("Please enter package version", $href->{"VERSION"});
        }
        dprint "Package $href->{NAME}, version $href->{VERSION}.\n";
    }
    return 1;
}

sub
scan_package(\%)
{
    my $href = $_[0];
    my $template = $href->{"TEMPLATE"};
    my $pkgname = $href->{"NAME"};
    my $tarball = $href->{"TARBALL"};
    my ($tmpdir, $savecwd, $cmd, $topdir);
    my @filelist;

    $tmpdir = &create_temp_space($pkgname, "dironly");
    $savecwd = &getcwd();
    if (!chdir($tmpdir)) {
        eprint "Unable to chdir to $tmpdir -- $!\n";
        return;
    }

    if (substr($tarball, 0, 1) ne '/') {
        $tarball = "$savecwd/$tarball";
    }
    $cmd = $href->{"EXTRACTWITH"};
    $cmd =~ s/\@\@/$tarball/eg;
    &run_cmd($cmd, "", "extract:  ");
    &File::Find::find({ "no_chdir" => 1, "wanted" => sub { s/^\.\/?//; if ($_) {push @filelist, $_;} } }, '.');
    @filelist = sort(@filelist);
    dprint "Archive contents:\n", join("\n", @filelist), "\n";

    if (!scalar(@filelist)) {
        @filelist = (&basename($tarball));
    } else {
        $topdir = shift @filelist;
    }

    # Find top-level source directory name.
    if (scalar(@filelist) == 1) {
        dprint "Single-source detected.  Compensating.\n";
        $href->{"SETUP"} = "-T -c";
        unshift @filelist, $topdir;
        $topdir = "$href->{NAME}-$href->{VERSION}";
        unshift @filelist, $topdir;
        dprint "Filelist is now ", join(' ', @filelist), "\n";
    } elsif (!scalar(grep { $_ !~ /^\Q$topdir\E/ } @filelist)) {
        if ($topdir ne "$href->{NAME}-$href->{VERSION}") {
            $href->{"SETUP"} = "-n $topdir";
        }
    } else {
        $href->{"SETUP"} = "-T -c -a 0";
        $topdir = "$href->{NAME}-$href->{VERSION}";
        unshift @filelist, $topdir;
    }

    # Strip top-level directory from all files.
    @filelist = map { $_ =~ s/^$topdir\///; $_ } @filelist;
    dprint "Topdir removal of $topdir gives:\n", join("\n", @filelist), "\n";

    ### Scan for signs of package type.
    if (! $OPTION{"template"}) {
        if (grep { $_ =~ /^configure(\.ac|\.in)?$/ } @filelist) {
            $template->file("GNU-autosplat.spec");
        } elsif (grep { $_ =~ /\.jar$/i } @filelist) {
            $template->file("jar.spec");
        } elsif (grep { $_ eq "Imakefile" } @filelist) {
            $template->file("imake.spec");
        } elsif (grep { $_ =~ /^makefile\.pro$/i } @filelist) {
            $template->file("qmake.spec");
        } elsif (grep { $_ =~ /^SConstruct$/i } @filelist) {
            $template->file("scons.spec");
        } elsif (grep { $_ =~ /^makefile$/i } @filelist) {
            $template->file("make.spec");
        }
        $template->find();
    }

    # Scan for documentation files and directories.
    foreach my $doc ("README", "INSTALL", "COPYING", "LICENSE", "LICENCE",
                     "TODO", "MANIFEST", "BUGS", "AUTHORS", "CONTRIBUTORS",
                     "FAQ", "NEWS", "MANUAL", "CHANGES", "ChangeLog", "CHANGELOG",
                     "WHATSNEW", "ReleaseNotes", "RELNOTES", "doc", "dox") {
        dprint "Checking for $doc.\n";
        $href->{"DOCFILES"} .= ' ' . join(' ', grep { $_ =~ /^\Q$doc\E/ && $_ !~ /\// } @filelist);
    }
    $href->{"DOCFILES"} =~ s/^\s*//;
    $href->{"DOCFILES"} =~ s/\s+/ /g;
    $href->{"DOCFILES"} =~ s/\s*$//;

    ### Scan for license.
    foreach my $license (grep { $_ =~ /^(COPYING|LICEN[CS]E)$/ } @filelist) {
        my $contents = &cat_file("$topdir/$license");

        $contents =~ s/\s+/ /gs;
        if ($contents =~ /GNU GENERAL PUBLIC LICEN[CS]E/) {
            $href->{"LICENSE"} = "GPL";
        } elsif ($contents =~ /GNU (LESSER|LIBRARY) GENERAL PUBLIC LICEN[CS]E/) {
            $href->{"LICENSE"} = "LGPL";
        } elsif ($contents =~ /The Apache Software Licen[cs]e/) {
            $href->{"LICENSE"} = "Apache";
        } elsif ($contents =~ /^\s*Apache Licen[cs]e/) {
            $href->{"LICENSE"} = "Apache";
        } elsif ($contents =~ /"Freely Available" means that no fee is charged for the item/) {
            $href->{"LICENSE"} = "Artistic";   
        } elsif ($contents =~ /Regents of the University of California/) {
            $href->{"LICENSE"} = "BSD";
        } elsif ($contents =~ /IBM PUBLIC LICEN[CS]E VERSION (\S+)/) {
            $href->{"LICENSE"} = "IBM Public License, Version $1";
        } elsif ($contents =~ /PSF LICEN[CS]E AGREEMENT/) {
            $href->{"LICENSE"} = "Python License";
        } elsif ($contents =~ /Mozilla Public License/) {
            $href->{"LICENSE"} = "Mozilla Public License (MPL)";
        } elsif ($contents =~ /copyright notice and this permission notice/) {
            $href->{"LICENSE"} = "BSD-like";
        } elsif ($contents =~ /must include the following acknowledgment/) {
            $href->{"LICENSE"} = "BSD with mandatory acknowledgement clause";
        } elsif ($contents =~ /all copies of the Software, its documentation and marketing/) {
            $href->{"LICENSE"} = "BSD with advertising clause";
        } elsif ($contents =~ /Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions/) {
            $href->{"LICENSE"} = "BSD-like";
        } elsif ($contents =~ /Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions/) {
            $href->{"LICENSE"} = "BSD-like";
        } elsif ($contents =~ /copyright notice and this permission notice/) {
            $href->{"LICENSE"} = "BSD-like";
        }
    }

    chdir($savecwd);
    &clean_temp_space($tmpdir);
}

sub
confirm_info(\%)
{
    my $href = $_[0];
    my $tarball = $href->{"TARBALL"};
    my $pkgname = $href->{"NAME"};

    print "Please verify and correct the following header values:\n";
    foreach my $key ("SUMMARY", "RELEASE", "LICENSE", "GROUP", "PACKAGER",
                     "VENDOR", "DISTRIBUTION", "DESCRIPTION", "SETUP",
                     "CFLAGS", "CXXFLAGS", "DOCFILES") {
        $href->{$key} = &prompt_user($key, $href->{$key});
    }
}

sub
replace_macros(\% @)
{
    my ($href, @keys) = @_;
    my %replacements = (
                        "$href->{NAME}" => "%{name}",
                        "$href->{VERSION}" => "%{version}"
                       );

    foreach my $key (@keys) {
        foreach my $repl (keys(%replacements)) {
            $href->{$key} =~ s/\Q$repl\E/$replacements{$repl}/eg;
        }
    }
    return $href;
}

sub
copy_tarball(\%)
{
    my $href = $_[0];
    my $tarball = $href->{"TARBALL"};
    my $pkgname = $href->{"NAME"};

    if (! -d $pkgname && ! &mkdirhier($pkgname)) {
        eprint "Unable to create directory $pkgname -- $!\n";
    } elsif (! &copy_files($tarball, $pkgname)) {
        eprint "Unable to copy $tarball to $pkgname/ -- $!\n";
    }
}

sub
create_spec_file(\%)
{
    my $href = $_[0];
    my $template = $href->{"TEMPLATE"};
    my $pkgname = $href->{"NAME"};
    my $specfile = sprintf("%s/%s.spec", $pkgname, $pkgname);
    my $ret;

    if (! $template->verify()) {
        eprintf("Cannot package; template %s/%s not found.\n",
                $template->directory(), $template->file());
        return 0;
    }

    # Assign variables.
    foreach my $key (keys(%{$href})) {
        $template->vars($key, $href->{$key});
    }
    $template->delimiter('@');

    # Generate the spec file
    $ret = $template->generate($specfile);
    if (!defined($ret)) {
        eprint "Unable to open template file -- $!\n";
        return 0;
    } elsif (! $ret) {
        eprint "Unable to create spec file $specfile -- $!\n";
        return 0;
    } else {
        dprint "Package $pkgname created.\n";
        return 1;
    }
}

sub
watch_install(\%)
{
    my $href = $_[0];
    my $pkgname = $href->{"NAME"};
    my ($tmpdir, $savecwd, $buildroot, $err, $msg, $outfiles);
    my @filelist;
    my %replace_paths = (
                         "/var/www" => "%{webroot}",
                         "/usr/bin" => "%{_bindir}",
                         "/usr/sbin" => "%{_sbindir}",
                         "/usr/libexec" => "%{_libexecdir}",
                         "/usr/share" => "%{_datadir}",
                         "/etc" => "%{_sysconfdir}",
                         "/usr/com" => "%{_sharedstatedir}",
                         "/var" => "%{_localstatedir}",
                         "/usr/lib" => "%{_libdir}",
                         "/usr/include" => "%{_includedir}",
                         "/usr/share/info" => "%{_infodir}",
                         "/usr/share/man" => "%{_mandir}",
                         "/etc/rc.d/init.d" => "%{_initrddir}",
                         "/etc/init.d" => "%{_initrddir}",
                         "/usr" => "%{_prefix}"
                        );

    $tmpdir = &create_temp_space($pkgname, "build");
    $buildroot = "$tmpdir/buildroot";
    $savecwd = &getcwd();
    if (!chdir($pkgname)) {
        eprint "Unable to chdir to $pkgname -- $!\n";
        return;
    }

    &pkgvar_filename(".");
    &pkgvar_instructions("$pkgname.spec");
    &pkgvar_topdir($tmpdir);
    &mkdirhier($buildroot, 0775);
    &pkgvar_buildroot($buildroot);

    ($err, $msg, $outfiles) = &build_package();
    if ($err != MEZZANINE_SUCCESS) {
        eprint "Unable to run test build -- $msg\n";
    } else {
        my @filelist;

        $outfiles =~ s/^.*\.(no)?src\.rpm\s+//;
        &pkgvar_filename($outfiles);
        &pkgvar_command("");
        @filelist = &rpm_show_contents();

        @filelist = grep { $_ !~ /^d/ && $_ !~ m^/usr/share/doc^ } @filelist;
        for (my $i = 0; $i < scalar(@filelist); $i++) {
            chomp($filelist[$i]);
            $filelist[$i] =~ s/\s+->\s+.*$//;
            $filelist[$i] =~ s/^[-a-z]+\s+\d+\s+.{16}\s+\d+\s+\w+\s+\d+\s+[\d:]+\s+//;
            if (! $filelist[$i]) {
                splice(@filelist, $i, 1);
                $i--;
            } else {
                foreach my $path (sort { length($b) <=> length($a) } keys(%replace_paths)) {
                    if ($filelist[$i] =~ /^\Q$path\E/) {
                        $filelist[$i] =~ s/^\Q$path\E/$replace_paths{$path}/eg;
                    }
                }
            }
        }

        $href->{"INSTFILES"} = join("\n", @filelist);
        chdir($savecwd);
        &create_spec_file($href);
    }

    chdir($savecwd);
    &clean_temp_space($tmpdir);
}


# main() here is basically the same as main() in C
sub
main
{
    my $errors = 0;
    my %package;

    # For taint checks
    delete @ENV{("IFS", "CDPATH", "ENV", "BASH_ENV")};
    $ENV{"PATH"} = "/bin:/usr/bin:/sbin:/usr/sbin";
    foreach my $shell ("/bin/bash", "/usr/bin/ksh", "/bin/ksh", "/bin/sh", "/sbin/sh") {
        if (-f $shell) {
            $ENV{"SHELL"} = $shell;
            last;
        }
    }

    &mezz_init("specgen", "0.1", "help|h", "version|v", "debug|d!", "template|t=s", "interactive|i");
    if ($OPTION{"version"}) {
        # Do not edit this.  It is updated automatically by CVS when you commit.
        &print_version($PROGNAME, $VERSION, "Michael Jennings",
                       'CVS Revision $Revision: 1.13 $ created on $Date: 2006/10/03 22:04:57 $ by $Author: mej $ ');
    } elsif ($OPTION{"help"} || !scalar(@ARGV)) {
	&print_usage_info();
    }
    if (defined($OPTION{"debug"}) && !($OPTION{"debug"})) {
        &debug_set(0);
    } else {
        &debug_set($OPTION{"debug"} || 0);
    }
    $interactive = (($OPTION{"interactive"}) ? (1) : (0));

    foreach my $pkg (@ARGV) {
        my $template = new Mezzanine::Template;

        # Untaint package.
        $pkg = &untaint(\$pkg);
        if (! $pkg) {
            next;
        }

        # Initialize hash.
        %package = %package_start;

        # Create template object for new spec file.
        if ($OPTION{"template"}) {
            $OPTION{"template"} = &untaint(\$OPTION{"template"});
            if (-d $OPTION{"template"}) {
                $template->directory($OPTION{"template"});
            } elsif (-f $OPTION{"template"}) {
                $template->file(&basename($OPTION{"template"}));
                $template->directory(&dirname($OPTION{"template"}));
            } else {
                my $tmp = $OPTION{"template"};

                if (substr($tmp, -5, 5) ne ".spec") {
                    $tmp .= ".spec";
                }
                $template->file($tmp);
            }
        }
        if (! $template->file()) {
            $template->file("GNU-autosplat.spec");
        }
        $template->find($template->directory());
        $package{"TEMPLATE"} = $template;

        # Make sure we have our package; download it if not.
        if (! -s $pkg) {
            $package{"TARBALL_URL"} = $pkg;
            $pkg = &get_tarball($pkg);
            if ((! $pkg) || (! -s $pkg)) {
                next;
            }
        } else {
            $package{"TARBALL_URL"} = &basename($pkg);
        }
        $package{"TARBALL"} = $pkg;

        # Get to it.
        &parse_tarball_name(\%package);
        &scan_package(\%package);
        if ($interactive) {
            &confirm_info(\%package);
        }
        &copy_tarball(\%package);
        &replace_macros(\%package, "DOCFILES", "INSTFILES", "SETUP", "TARBALL", "TARBALL_URL");
        if (! &create_spec_file(\%package)) {
            $errors++;
            next;
        }
        &watch_install(\%package);
    }
    return $errors;
}

exit &main();
