#!/usr/bin/perl
use strict;
use warnings;
my($app_svnid) = '$HeadURL$ $LastChangedRevision$'; ## no critic (RequireInterpolationOfMetachars)
use lib substr(`ade-config ade_share_prefix`,0,-1) . '/include';  ## no critic (ProhibitBacktickOperators)
use Fatal qw( close closedir umask );   #  obviate checking close()'s return code

use ADE;
use Getopt::Long qw(:config no_ignore_case);
use IO::Dir;
use Cwd;
use IO::File;
use POSIX qw(strftime);

my(%adebun_defined_errors) = (
    adebun_err_misc     => { fmt => '%s' },
    adebun_err_access   => { fmt => '%s: can\'t %s' },
    adebun_err_convert  => { fmt => '%s: couldn\'t convert from %s to %s' },
    adebun_err_obsolete => { fmt => '%s' },
);

#  Variables for options
my($opt_authoremail, $opt_authorname, $opt_packagename, $opt_outputfile, $opt_makecmd, $opt_releaseid);

#  Other globals
my($release_year);
my($release_time);
my($release_date_man);

sub adebun ## no critic (ProhibitExcessComplexity)
{
    my($errstack_ref) = @_;
    my($rc);
    my($pre_src_dir, $abs_outputfile, $first_line);
    my($post_src_dir, $work_dir, $old_umask, $progname);
    my($targz_handle, $clean_cmd, $rundir, $changelog_handle);

    ###########################################################################
    #
    #  Set ADE options
    #
    ###########################################################################

    #  Register application-specific errors
    ADE::register_error_types(\%adebun_defined_errors);

    ##########################################################################
    #
    #  Process options
    #
    ##########################################################################

    #  Defaults for options
    $opt_authoremail = undef;
    $opt_authorname = undef;
    $opt_packagename = undef;
    $opt_outputfile = undef;
    $opt_makecmd = 'make';
    $opt_releaseid = undef;

    #  Register options
    if (($rc=ADE::register_options($errstack_ref, 'm:so:s', 'author-email:s,author-name:s,release-id:s,make:s,package-name:s,output-file:s', 'main::handle_option_%s')) != $ADE::OK) {
        return($rc);
    }

    #  Register handler functions
    if (($rc=ADE::set_callbacks($errstack_ref, \&adebun_usage_help, \&adebun_version, \&adebun_paths)) != $ADE::OK) {
        return($rc);
    }

    #  Process options
    ADE::debug($errstack_ref, 10, 'adebun: processing options ...');
    if (($rc=ADE::process_options($errstack_ref)) != $ADE::OK) {
        return($rc);
    }

    ##########################################################################
    #
    #  Process arguments
    #
    ##########################################################################

    if (not defined $ARGV[0] or defined $ARGV[1]) {
        ADE::show_bad_usage($errstack_ref)
    }
    $pre_src_dir = $ARGV[0];

    ##########################################################################
    #
    #  Guts start here
    #
    ##########################################################################

    #  Sanity check and option rewrites and derivations
    $clean_cmd = "$opt_makecmd -s clean distclean";

    if (not defined $opt_releaseid) {
        #  Check that there is a ChangeLog and that it has been prepared for a release.
        ADE::debug($errstack_ref, 10, "adebun: checking $pre_src_dir/doc/ChangeLog exists ...");
        if (! -f "$pre_src_dir/doc/ChangeLog") {
            ADE::error($errstack_ref, 'adebun_err_access', "$pre_src_dir/doc/ChangeLog", 'access');
            return($ADE::FAIL);
        }
        #  Get the release id from the ChangeLog
        ADE::debug($errstack_ref, 10, "adebun: extracting release id from $pre_src_dir/doc/ChangeLog ...");
        if (!open $changelog_handle, '<', "$pre_src_dir/doc/ChangeLog") {
            ADE::debug($errstack_ref, 10, 'adebun: couldn\'t open file; reporting error ...');
            ADE::error($errstack_ref, 'adebun_err_access', "$pre_src_dir/doc/ChangeLog", 'open');
            return($ADE::FAIL);
        }
        ADE::debug($errstack_ref, 10, 'adebun: before chomp');
        $first_line=<$changelog_handle>;
        close $changelog_handle;
        chomp $first_line;
        ADE::debug($errstack_ref, 10, "adebun: first line of ChangeLog is \"$first_line\"");
        if ($first_line !~ /^Release:? (\S+) \([^\)]+\)$/) {
            ADE::debug($errstack_ref, 10, 'adebun: couldn\'t parse first line; reporting error ...');
            ADE::error($errstack_ref, 'adebun_err_misc', "$pre_src_dir/doc/ChangeLog: first line is not a release statement");
            return($ADE::FAIL);
        }
        ADE::debug($errstack_ref, 10, "adebun: release id is \"$1\"");
        ADE::debug($errstack_ref, 10, 'adebun: constructing token replacements ...');
        $opt_releaseid = $1; ## no critic (ProhibitCaptureWithoutTest)
    }
    $release_time = time;
    $release_year = 1900+(localtime $release_time)[5];
    $release_date_man = strftime '%e %b %Y', localtime $release_time;

    if (not defined $opt_packagename) {
        ADE::debug($errstack_ref, 10, 'adebun: package name has not been specified; working it out ...');
        #  Going to the directory rather than just using its last component
        #  ensures that things will still work as expected when the user says
        #  '.' or '../..' or whatever. Without this, the package name gets
        #  set to '.' or '../..' and then - althought the resulting tar file
        #  may be correctly named (because of use of '-f <file>' option), the
        #  tar file itself will contain paths like './.-1.2345/doc/COPYING'.
        $rundir = getcwd;
        if (!chdir $pre_src_dir) {
            ADE::error($errstack_ref, 'adebun_err_access', $pre_src_dir, 'access');
            return($ADE::FAIL);
        }
        $opt_packagename = File::Basename::basename(getcwd);
        if (!chdir $rundir) {
            ADE::error($errstack_ref, 'js_err_misc', 'chdir() failed');
            return($ADE::FAIL);
        }
    }
    if (not defined $opt_outputfile) {
        $opt_outputfile = "$opt_packagename-$opt_releaseid.tar.gz";
    }
    ADE::debug($errstack_ref, 4, "adebun: \$opt_packagename=$opt_packagename, \$opt_releaseid=$opt_releaseid");
    #  Get the absolute name of the output file and check access to it

    if (($rc=ADE::get_absolute_path($errstack_ref, $opt_outputfile, undef, \$abs_outputfile)) != $ADE::OK) {
        ADE::error($errstack_ref, 'adebun_err_convert', $abs_outputfile, 'path', 'absolute path');
        return($rc);
    }
    ADE::debug($errstack_ref, 4, "adebun: testing access to $abs_outputfile ...");
    if (($rc=ADE::register_temp_file($errstack_ref, $abs_outputfile)) != $ADE::OK) {
        return($rc);
    }
    if (!open $targz_handle, '>', $abs_outputfile) {
        ADE::error($errstack_ref, 'adebun_err_access', $abs_outputfile, 'create');
        return($ADE::FAIL);
    }
    close $targz_handle;

    #  All temporary files will be stored here so it is the only temp file
    #  we need to register.
    #  Get the name of the program.
    if (($rc=ADE::get_progname($errstack_ref, \$progname)) != $ADE::OK) {
        return($rc);
    }
    $work_dir = "/var/tmp/$progname.$$";
    ADE::info($errstack_ref, 'making temporary copy of files and doing substitutions ...');
    ADE::debug($errstack_ref, 4, "adebun: creating sandpit $work_dir ...");
    if (($rc=ADE::register_temp_file($errstack_ref, $work_dir)) != $ADE::OK) {
        return($rc);
    }
    if (!mkdir $work_dir) {
        ADE::error($errstack_ref, 'adebun_err_access', $work_dir, 'create');
        return($ADE::FAIL);
    }

    #  Go to the source directory so the relative path names can be easily
    #  transported to the temporary target directory.
    if (!chdir $pre_src_dir) {
        ADE::error($errstack_ref, 'adebun_err_access', $pre_src_dir, 'chdir');
        return($ADE::FAIL);
    }

    #  Ensure files are written with permissions that when tarred by the
    #  person running this program, and untarred by somebody who has downloaded
    #  the resulting tgz from the web, that the permissions are sensible.
    $old_umask = umask 022;

    #  This is where the temporary copy will be; no need to create it,
    #  process() will take care of that.
    $post_src_dir = "$work_dir/$opt_packagename-$opt_releaseid";
    if (($rc=process($errstack_ref, '.', $post_src_dir, 1)) != $ADE::OK) {
        ADE::error($errstack_ref, 'adebun_err_misc', '.: failed to process');
        return($rc);
    }

    #  Restore old umask - though won't be used again (tar file access
    #  testing left the zero bytes file there).
    umask $old_umask;

    #  Clean the temporary target directory.
    ADE::info($errstack_ref, 'cleaning the temporary copy ...');
    if (!chdir $post_src_dir) {
         ADE::error($errstack_ref, 'adebun_err_access', $post_src_dir, 'chdir');
         return($ADE::FAIL);
    }

    ADE::debug($errstack_ref, 4, "adebun: calling \"$clean_cmd\" ...");
    #  Brackets used for precendence (i.e. system is system of $clean_cmd, not
    #  system of ($clean_cmd >> 8).
    $rc = system ($clean_cmd) >> 8;
    if ($rc != 0) {
        #  The directory we're in is about to be cleaned by the exit procedures; get
        #  out of it to avoid the cleanup procedures themselves reporting shell-init
        #  errors.
        chdir '/';  ## no critic (RequireCheckedSyscalls)
        ADE::error($errstack_ref, 'adebun_err_misc', 'could not clean temporary sources');
        return($ADE::FAIL);
    }

    #  Tar up the temporary cleaned target directory. Do it from the
    #  right place to put the right names in the tar file.
    ADE::info($errstack_ref, 'creating tar file ...');
    if (!chdir $work_dir) {
        ADE::error($errstack_ref, 'adebun_err_access', $work_dir, 'chdir');
        return($ADE::FAIL);
    }

    $rc = system ("tar cbf 20 - $opt_packagename-$opt_releaseid|gzip>$abs_outputfile") >> 8;
    if ($rc != 0) {
        ADE::error($errstack_ref, 'adebun_err_misc', 'tar/gzip: failed');
        return($ADE::FAIL);
    }

    #  We registered the tgz file as a temporary file earlier in case
    #  something went wrong before we got to here, but now we are
    #  here, the tgz has been successfully written so declassify it.
    if (($rc=ADE::deregister_temp_file($errstack_ref, $abs_outputfile)) != $ADE::OK) {
        return($rc);
    }

    #  leave the tidying to ADE, but get out of the directory
    #  it will try to remove first!
    chdir '/'; ## no critic (RequireCheckedSyscalls)

    #  Ensure sensible return code
    return($ADE::OK);
}

sub handle_option_author_name
{
    my($errstack_ref, $authorname) = @_;

    $opt_authorname = $authorname;

    return $ADE::OK;
}

sub handle_option_author_email
{
    my($errstack_ref, $authoremail) = @_;

    $opt_authoremail = $authoremail;

    return $ADE::OK;
}

sub handle_option_package_name
{
    my($errstack_ref, $packagename) = @_;

    $opt_packagename = $packagename;

    return $ADE::OK;
}

sub handle_option_release_id
{
    my($errstack_ref, $releaseid) = @_;

    $opt_releaseid = $releaseid;

    return $ADE::OK;
}

sub handle_option_output_file
{
    my($errstack_ref, $outputfile) = @_;

    $opt_outputfile = $outputfile;

    return $ADE::OK;
}

sub handle_option_make
{
    my($errstack_ref, $makecmd) = @_;

    $opt_makecmd = $makecmd;

    return $ADE::OK;
}

sub handle_option_o  ## no critic (RequireArgUnpacking)
{
    return(handle_option_output_file(@_));
}

sub handle_option_m  ## no critic (RequireArgUnpacking)
{
    return(handle_option_make(@_));
}

sub adebun_version
{
    my($errstack_ref, $version_text_ref) = @_;

    return(ADE::extract_version($errstack_ref, $app_svnid, $version_text_ref));
}

sub adebun_paths
{
    my($errstack_ref, $pathlist_text_ref) = @_;
    my($rc);

    ${$pathlist_text_ref} = undef;

    return($ADE::OK);
}

sub adebun_usage_help
{
    my($errstack_ref, $usage_text_short_ref, $usage_text_long_ref) = @_;

    ${$usage_text_short_ref} = "<srcdir>\n";
    ${$usage_text_long_ref}  = "                     --author-name=<name>    set package author's name\n" .
                               "                     --author-email=<addr>   set package author's email address\n" .
                               "                     --package-name=<pkg>    set name of package to <pkg>\n" .
                               "                     --release-id=<relid>    set release ID\n" .
                               "         -o <file> | --output-file=<file>    write to <file>\n" .
                               '         -m <cmd>  | --make=<cmd>            use <cmd> as make';
    return($ADE::OK);
}

sub process  ## no critic (ProhibitExcessComplexity)
{
    my($errstack_ref, $srcthing, $dstthing, $do_subst) = @_;
    my($dh, $rc, $infh, $outfh, $subthing, $l_x, $atime, $mtime, $target);

    #  Skip Subversion and RCS control directories
    if (-d $srcthing and $srcthing =~ /\/(\.svn|RCS|CVS)$/) {
        return($ADE::OK);
    }
    #  Skip .orig, .ps and other files which may exist but will not be cleaned
    #  from the temporary copy. Note that *~ is ok, since the makefiles *should*
    #  clean these when adebun runs 'make clean distclean' in the temporary copy.
    if ($srcthing =~ /\.orig$/ or $srcthing =~ /\.ps$/ or $srcthing =~ /\.old$/) {
        ADE::warning($errstack_ref, 'adebun_err_misc', "$srcthing: processing, but should it be here?");
        return($ADE::OK);
    }

    #  Skip 'debian' subdir or symlink used for making .deb from sources. Likewise
    #  for 'redhat'
    if ((-d $srcthing or -l $srcthing) and $srcthing =~ /^\.\/(debian|redhat)$/) {
        ADE::info($errstack_ref, "$srcthing: skipping (presumably for making distribution package)");
        return($ADE::OK);
    }

    #  This daft l_x variable and its use in the substitution is to avoid
    #  putting the 'l' and 'x' characters next to each other, 'cos bsfr
    #  is looking for this.
    $l_x = 'l' . 'x';
    if ($do_subst and $srcthing =~ /.*\/templates\/$l_x/) {
        $do_subst = 0;
        ADE::warning($errstack_ref, 'adebun_err_misc', "$srcthing: skipping substitution (ade template?)");
    }

    #  if srcthing is a symlink then do nothing
    if (-l $srcthing) {
        ADE::debug($errstack_ref, 10, "process: $srcthing is a symlink; copying ...");
        $target = readlink $srcthing;
        if (!symlink $target, $dstthing) {
            ADE::error($errstack_ref, 'js_err_misc', 'symlink() failed');
            return($ADE::FAIL);
        }

    #  if srcthing is a directory then recurse into each thing
    } elsif (-d $srcthing) {
        ADE::debug($errstack_ref, 10, "process: $srcthing is a directory; will now process its contents ...");
        if (!mkdir $dstthing) {
            ADE::error($errstack_ref, 'adebun_err_access', $dstthing, 'create');
            return($ADE::FAIL);
        }
        if (!opendir $dh, $srcthing) {
            ADE::error($errstack_ref, 'adebun_err_access', $srcthing, 'open');
            return($ADE::FAIL);
        }
        while ($subthing = readdir $dh) {
            #  Skip . and ..
            next if ($subthing =~ /^\.$/ or $subthing =~ /^\.\.$/);
            if (($rc=process($errstack_ref, "$srcthing/$subthing", "$dstthing/$subthing", $do_subst)) != $ADE::OK) {
                ADE::error($errstack_ref, 'adebun_err_misc', "$srcthing/$subthing: failed to process");
                return($rc);
            }
        }
        closedir $dh;

    } elsif (-f $srcthing) {
        ADE::debug($errstack_ref, 10, "process: $srcthing is a file");
        #  Copy the content
        if (!open $infh, '<', $srcthing) {
            ADE::error($errstack_ref, 'adebun_err_access', $srcthing, 'open');
            return($ADE::FAIL);
        }
        if (!open $outfh, '>', $dstthing) {
            close $infh;
            ADE::error($errstack_ref, 'adebun_err_access', $dstthing, 'open');
            return($ADE::FAIL);
        }
        if ($do_subst) {
            while (<$infh>) {
                #   Note the way to make the text of the sppsym markers
                #   not look sppsym markers!
                if (/SP[P]SYM_AUTHOR_EMAIL/) {
                    ADE::error($errstack_ref, 'adebun_err_obsolete', 'SP\PSYM_AUTHOR_EMAIL', 'ADE_APP_TO\KEN_AUTHOR_EMAIL', 'placeholder');
                    return($ADE::FAIL);
                }
                if ((s/ADE_APP_TO[K]EN_AUTHOR_EMAIL/$opt_authoremail/g) and not $opt_authoremail) {
                    ADE::error($errstack_ref, 'adebun_err_misc', 'ADE_APP_TO\KEN_AUTHOR_EMAIL: found in sources without \'--author-email=<addr>\' option');
                    return($ADE::FAIL);
                }
                if (/SP[P]SYM_AUTHOR_NAME/) {
                    ADE::error($errstack_ref, 'adebun_err_obsolete', 'SP\PSYM_AUTHOR_NAME', 'ADE_APP_TO\KEN_AUTHOR_NAME', 'placeholder');
                    return($ADE::FAIL);
                }
                if ((s/ADE_APP_TO[K]EN_AUTHOR_NAME/$opt_authorname/g) and  not $opt_authorname) {
                    ADE::error($errstack_ref, 'adebun_err_misc', 'ADE_APP_TO\KEN_AUTHOR_NAME: found in sources without \'--author-name=<name>\' option');
                    return($ADE::FAIL);
                }
                if (/SP[P]SYM_RELEASE_ID/) {
                    ADE::error($errstack_ref, 'adebun_err_obsolete', 'SP\PSYM_RELEASE_ID', 'ADE_APP_TO\KEN_RELEASE_ID', 'placeholder');
                    return($ADE::FAIL);
                }
                s/ADE_APP_TO[K]EN_RELEASE_ID/$opt_releaseid/g;
                if (/SP[P]SYM_RELEASE_YEAR/) {
                    ADE::error($errstack_ref, 'adebun_err_obsolete', 'SP\PSYM_RELEASE_YEAR', 'ADE_APP_TO\KEN_RELEASE_YEAR', 'placeholder');
                    return($ADE::FAIL);
                }
                s/ADE_APP_TO[K]EN_RELEASE_YEAR/$release_year/g;
                if (/SP[P]SYM_RELEASE_DATE_MAN/) {
                    ADE::error($errstack_ref, 'adebun_err_obsolete', 'SP\PSYM_RELEASE_DATE_MAN', 'ADE_APP_TO\KEN_RELEASE_DATE_MAN', 'placeholder');
                    return($ADE::FAIL);
                }
                s/ADE_APP_TO[K]EN_RELEASE_DATE_MAN/$release_date_man/g;
                print $outfh $_;
            }
        } else {
            while (<$infh>) {
                print $outfh $_;
            }
        }
        close $infh;
        close $outfh;
        #  Copy the executability
        if (-x $srcthing) {
            if (!chmod 0755, $dstthing) {
                ADE::error($errstack_ref, 'js_err_misc', 'chmod() failed');
                return($ADE::FAIL);
            }
        }
        #  Copy the timestamp
        $atime = $mtime = (lstat $srcthing)[9];
        if (!utime $atime, $mtime, $dstthing) {
            ADE::error($errstack_ref, 'js_err_misc', 'utime() failed');
            return($ADE::FAIL);
        }
    } else {
        ADE::debug($errstack_ref, 10, "process: $srcthing is not a file or directory");
        ADE::internal($errstack_ref, "$srcthing/$_: unknown file type");
    }

    return($ADE::OK);
}

ADE::main(\&adebun);