#!/usr/bin/perl

=begin plans

one class per task:
    inherit from superclass
    new():
        no getopt module
        parses args
        must know how not to consume too much!
    cmd() builds commandline

superclass:
    new() croaks
    run():
        system( $self->cmd() )
        die on error

main program is dispatcher:
    pull mode from args
    construct object
    call run()

modes:
    cd -- configure with defaults
    cf -- configure (no defaults)
    ch -- configure --help
    mk -- build
    pk -- package

in configure modes:
    += => --enable-
    -= => --disable-
    -: => --with-
    +: => --without-

=end plans

=head1 NAME

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 ARGUMENTS

=over 4

=item B<-h>, B<--help>

=item B<--man>

=item B<-c>, B<--configure>

=item B<-m>, B<--make>

=item B<-p>, B<--package>

=item B<-i>, B<--install>

=back

=head1 OPTIONS

=over 4

=item B<-n>, B<--dry-run>

=item B<-N>, B<--pkg-name>

=item B<-E>, B<--ac-enable>

=item B<-D>, B<--ac-disable>

=item B<-W>, B<--ac-with>

=item B<-O>, B<--ac-without>

=item B<-V>, B<--ac-var>

=item B<--pkg-info>

=back

=head1 SEE ALSO

=head1 AUTHORS

Aristotle Pagaltzis

=head1 COPYRIGHT

This script is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.

=cut

use strict;
use warnings;

use Pod::Usage;
use Getopt::Long 2.24, qw( :config bundling no_ignore_case no_auto_abb
+rev );

use Cwd;
use File::Spec::Functions qw( catdir catfile tmpdir );
use File::Basename;
use File::Temp qw( mkdtemp );
use File::Path;
use POSIX qw( strftime );

use constant PWD => getcwd();

my %pkg_info = (
    ver  => 1,
    arch => do { chomp( $_ = qx/arch/ ); $_ },
    (
        basename( PWD ) =~ /\A(.*)-(.*)\z/
        ? ( distname => $1, distver => $2 )
        : ( distname => basename( PWD ), distver => "0.nover" )
    ),
);

GetOptions(
    'h|help'         => sub { pod2usage( -verbose => 1 ) },
    'man'            => sub { pod2usage( -verbose => 2 ) },
    'c|configure:s'  => \my $opt_configure,
    'm|make:s'       => \my $opt_make,
    'p|package'      => \my $opt_package,
    'i|install'      => \my $opt_install,
    'n|dry-run'      => \my $opt_dryrun,
    'N|pkg-name=s'   => \my $opt_pkgname,
    'E|ac-enable=s'  => \my @ac_enable,
    'D|ac-disable=s' => \my @ac_disable,
    'W|ac-with=s'    => \my @ac_with,
    'O|ac-without=s' => \my @ac_without,
    'V|ac-var=s'     => \my %autoconf_var,
    'pkg-info=s'     => \%pkg_info,
    'cvs'            => sub { $pkg_info{ distver } = strftime( '%Y%m%d
+', localtime ) },
) or pod2usage( -verbose => 1 );

$opt_pkgname = join( '-', @pkg_info{ qw( distname distver arch ver ) }
+ ) . '.tgz'
    unless defined $opt_pkgname;

if( not defined $autoconf_var{ prefix } ) {
    $autoconf_var{ prefix }         ||= '/usr';
    $autoconf_var{ sysconfdir }     ||= catdir( '/etc', $pkg_info{ dis
+tname } );
    $autoconf_var{ sharedstatedir } ||= '/var/com';
    $autoconf_var{ localstatedir }  ||= '/var';
}

delete @autoconf_var{ grep !length $autoconf_var{ $_ }, keys %autoconf
+_var };

sub parse_features { map /\G ,? ( .+? (?: =.* \z | (?=,) | \z ) ) /xg,
+ @_ }

sub pull_argv {
    my @pulled;
    while ( @ARGV ) {
        my $curr = shift @ARGV;
        last if $curr eq '--';
        push @pulled, $curr;
    }
    return @pulled;
}

sub run {
    if ( $opt_dryrun ) {
        print join( ' ', @_ ), "\n";
        return 1;
    }
    return system( @_ ) == 0;
}

######################################################################
+#########
my $success = 1;
######################################################################
+#########

if ( defined $opt_configure ) {
    $success = run(
        ( -x $opt_configure ? $opt_configure : './configure' ),
        map ( "--$_=$autoconf_var{$_}", sort { length $a <=> length $b
+ } keys %autoconf_var ),
        map ( "--enable-$_",  parse_features @ac_enable ),
        map ( "--disable-$_", parse_features @ac_disable ),
        map ( "--with-$_",    parse_features @ac_with ),
        map ( "--without-$_", parse_features @ac_without ),
        pull_argv(),
    );
}

######################################################################
+#########
print( "Configure failed.\n" ), exit 1 unless $success;
######################################################################
+#########

if ( defined $opt_make ) {
    $success = run( ( -x $opt_make ? $opt_make : 'make' ), pull_argv()
+, );
}

######################################################################
+#########
print( "Make failed.\n" ), exit 1 unless $success;
######################################################################
+#########

if ( $opt_package ) {
    unless ( $opt_dryrun or $< == 0 ) {
        print STDERR "Creating package as non-root. Continue (y/n)? ";
        last unless <> =~ /^\s*y/i;
    }

    my $tmpdir = $opt_dryrun
        ? '$tmpdir'
        : mkdtemp( catdir( tmpdir, 'slakmk.XXXXXXXX' ) );

    chmod 0755, $tmpdir unless $opt_dryrun;

    my @cmd;
    ( @cmd = pull_argv() ) or ( @cmd = qw( make install DESTDIR=%d/ ) 
+);

    s/ \G ( %(.) | . ) /
        ( !defined $2 ) ? $1      :
        $2 eq '%'       ? '%'     :
        $2 eq 'd'       ? $tmpdir :
        do { warn "Unknown format sequence '$1', ignoring\n"; '' }
    /xge for @cmd;
    run( @cmd );

    chdir $tmpdir unless $opt_dryrun;

    $success =
        run( makepkg => -c => 'n', -l => 'y', catfile( PWD, $opt_pkgna
+me ) );

    chdir PWD unless $opt_dryrun;

    rmtree $tmpdir unless $opt_dryrun;
}

######################################################################
+#########
print( "Package creation failed.\n" ), exit 1 unless $success;
######################################################################
+#########

$success = run( installpkg => catfile( PWD, $opt_pkgname ) )
    if $opt_install;

######################################################################
+#########
print( "Installation failed.\n" ), exit 1 unless $success;
######################################################################
+#########
[download]

#!/usr/bin/perl
use warnings;
use strict;

use Getopt::Long;
use File::Copy qw(move);
use File::Temp qw(tempdir);
use File::Basename qw(basename);
use File::Spec::Functions qw(catdir no_upwards rootdir);

use constant BASEDIR => do { require Cwd; Cwd::cwd() };

sub slurp_dir {
    my $dir = shift;
    opendir my ($dh), $dir
        or die "Couldn't read directory $dir: $!\n";
    readdir $dh;
}

sub run_cmd {
    print "\t@_\n";

    my $exit = system(@_);

    require POSIX;
    if (POSIX::WIFEXITED($exit)) {
        return 1 if POSIX::WEXITSTATUS($exit) == 0;
        print "\tReturned non-zero exit status\n";
        return;
    }
    else {
        print "\tQuitting: Subprocess exited abnormally\n";
        exit 1;
    }
}

sub mangle_targetdir {
    my ($exdir) = @_;

    my $basedir_rx = join '.?', map quotemeta, split /[-_ ]/, $exdir;

    my ($tarbase, @morefiles) = no_upwards(slurp_dir $exdir);

    my $exdir_tar = catdir($exdir, $tarbase);

    if (@morefiles or ! -d $exdir_tar or $tarbase !~ /\A$basedir_rx/i)
+ {
        print "\tExtracted in $exdir\n";
        return;
    }

    print "\tExtracted in $tarbase\n"
        if $tarbase ne $exdir;

    my $tempdir = tempdir(DIR => BASEDIR);
    my $tempdir_tar = catdir($tempdir, $tarbase);
    my $basedir_tar = catdir(BASEDIR, $tarbase);

    move $exdir_tar, $tempdir_tar
        and rmdir $exdir
        and move $tempdir_tar, $basedir_tar
        and rmdir $tempdir
        or print "\tFailed moving $exdir_tar to $basedir_tar: $!\n";
}

sub run_in_dir {
    my $basename = basename shift;
    mkdir $basename;
    run_cmd(@_);
    mangle_targetdir($basename);
}

GetOptions(
    'list|l!'      => \(my $list      = ''),
    'overwrite|o!' => \(my $overwrite = ''),
    'remove|r!'    => \(my $remove    = ''),
) and @ARGV or die "usage: FIXME\n"; # FIXME

my %ext = $list
    ? (
        zip  => sub { local %_ = @_; unzip => -l => $_{archive} },
        tar  => sub { local %_ = @_; tar => tv =>               -f => 
+$_{archive}, },
        tgz  => sub { local %_ = @_; tar => tv => '--gzip',     -f => 
+$_{archive}, },
        tbz2 => sub { local %_ = @_; tar => tv => '--bzip2',    -f => 
+$_{archive}, },
        tarz => sub { local %_ = @_; tar => tv => '--compress', -f => 
+$_{archive}, },
    )
    : (
        zip  => sub { local %_ = @_; unzip => -q => -d => $_{dir}, $_{
+archive} },
        tar  => sub { local %_ = @_; tar => x =>               -f => $
+_{archive}, -C => $_{dir}, },
        tgz  => sub { local %_ = @_; tar => x => '--gzip',     -f => $
+_{archive}, -C => $_{dir}, },
        tbz2 => sub { local %_ = @_; tar => x => '--bzip2',    -f => $
+_{archive}, -C => $_{dir}, },
        tarz => sub { local %_ = @_; tar => x => '--compress', -f => $
+_{archive}, },
    );

@ext{qw(tar.gz tar.bz2 tar.z tar.Z)} = @ext{qw(tgz tbz2 tarz tarz)};

my $rx = join '|', map quotemeta, keys %ext;
$rx = qr/\A (.*) \. ($rx) \z/ix;

select(STDERR);

for (@ARGV) {
    print "\n$_:\n";
    if (-f and my ($basename, $ext) = m/$rx/) {
        $list
            ? run_cmd($ext{$ext}->(archive => $_, dir => $basename))
            : run_in_dir($basename, $ext{$ext}->(archive => $_, dir =>
+ $basename));
    }
    elsif (not $list and -d) {
        my $basename = basename catdir $_;
        my $rootdir = quotemeta rootdir;

        $basename =~ s/\A$rootdir\z/rootdir/;
        $basename .= '.tar.bz2';

        -e $basename
            ? print "$basename already exists\n"
            : run_cmd(tar => c => '--bzip2', -f => $basename, $_);
    }
    else {
        print "\tNo handler found\n";
    }
}
[download]