#!/usr/bin/perl
use strict;
#  Allow bare words, so &ade_err_error() calls look nicer.
no strict 'subs';
BEGIN {
use lib substr `ade-config ade_include_prefix`,0,-1;
require "ade.pl";
ADE->import(qw($ade_app_progname ade_gep_main ade_tmp_registerfile ade_err_debug ade_tmp_deregisterfile ade_err_error ade_msg_usage ade_fnm_basename ade_fnm_makeabsolute ade_err_info $ade_tmp_dir ade_err_warning $ade_err_ok $ade_err_fail stupid_error_in_ade_space ade_err_registerdefderrs ade_msg_version ade_tmf_extractversionfromsvnstring ade_msg_listpaths));
}

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

my($subversion_string) = '# $HeadURL$ $LastChangedRevision$';

&ade_err_registerdefderrs({
    aderel_err_misc     => { fmt => "%s" },
});

#  The 'dsc' field is only used in error messages relating to undefined stuff. Maybe 
#  if there was a config file keyword assigned then I could use that instead.
my($opt_authoremail, $opt_authorname, $opt_packagename, $opt_outputfile, $opt_makecmd, $opt_releaseid);
my(@config_hasharray) = (
    { dsc => "opt_authoremail", var => \$opt_authoremail                            },
    { dsc => "opt_authorname",  var => \$opt_authorname                             },
    { dsc => "opt_packagename", var => \$opt_packagename, dfl => "getatargproctime" },
    { dsc => "opt_outputfile",  var => \$opt_outputfile,  dfl => "getatargproctime" },
    { dsc => "opt_makecmd",     var => \$opt_makecmd,     dfl => "make"             },
    { dsc => "opt_releaseid",   var => \$opt_releaseid,   dfl => "workoutlater"     },
);

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

sub aderel
{
    my($errstack_ref) = @_;
    my($rc, $listpaths, $optval);
    my($pre_src_dir, $abs_outputfile, $first_line);
    my($post_src_dir, $app_tmp_dir, $old_umask, $count, $tar_chunk_buf);
    my($tgzfh, $clean_cmd, $rundir, $saved_PATH);

    #
    #  Load defaults, command line options and stuff from config file
    #

    if (($rc=&load_options_and_config_file($errstack_ref)) != $ade_err_ok) {
        return($rc);
    }
    &ade_err_debug($errstack_ref, 10, "aderel: config loaded");

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

    (!defined($ARGV[0]) || defined($ARGV[1])) && &ade_msg_usage($errstack_ref, \&app_usage, 1);
    $pre_src_dir = $ARGV[0];

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

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

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

    &ade_err_debug($errstack_ref, 10, "aderel: \$opt_packagename=$opt_packagename");
    if ($opt_packagename eq "getatargproctime") {
        &ade_err_debug($errstack_ref, 10, "aderel: 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_err_error($errstack_ref, ade_err_access, $pre_src_dir, "access", $@);
            return($ade_err_fail);
        }
        if (($rc=&ade_fnm_basename($errstack_ref, getcwd, \$opt_packagename)) != $ade_err_ok) {
            &ade_err_error($errstack_ref, aderel_err_misc, "can't work out package name from $pre_src_dir");
            return($rc);
        }
        chdir($rundir);
    }
    if ($opt_outputfile eq "getatargproctime") {
        $opt_outputfile = "$opt_packagename-$opt_releaseid.tar.gz";
    }
    &ade_err_debug($errstack_ref, 4, "aderel: \$opt_packagename=$opt_packagename, \$opt_releaseid=$opt_releaseid");
    #  Get the absolute name of the output file and check access to it

    if (($rc=&ade_fnm_makeabsolute($errstack_ref, $opt_outputfile, undef, \$abs_outputfile)) != $ade_err_ok) {
        &ade_err_error($errstack_ref, ade_err_convert, $abs_outputfile, "path", "absolute path");
        return($rc);
    }
    &ade_err_debug($errstack_ref, 4, "aderel: testing access to $abs_outputfile ...");
    if (($rc=&ade_tmp_registerfile($errstack_ref, $abs_outputfile)) != $ade_err_ok) {
        return($rc);
    }
    if (($tgzfh=new IO::File ">$abs_outputfile") == undef) {
        &ade_err_error($errstack_ref, ade_err_access, $abs_outputfile, "create", $@);
        return($ade_err_fail);
    }
    $tgzfh->close;
    
    #  All temporary files will be stored here so it is the only temp file
    #  we need to register.
    $app_tmp_dir = "$ade_tmp_dir/$ade_app_progname.$$";
    &ade_err_info($errstack_ref, "making temporary copy of files and doing substitutions ...");
    &ade_err_debug($errstack_ref, 4, "aderel: creating sandpit $app_tmp_dir ...");
    if (($rc=&ade_tmp_registerfile($errstack_ref, $app_tmp_dir)) != $ade_err_ok) {
        return($rc);
    }
    if (!mkdir($app_tmp_dir)) {
        &ade_err_error($errstack_ref, ade_err_access, $app_tmp_dir, "create", $!);
        return($ade_err_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_err_error($errstack_ref, ade_err_access, $pre_src_dir, "chdir", $!);
        return($ade_err_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 = "$app_tmp_dir/$opt_packagename-$opt_releaseid";
    if (($rc=&process($errstack_ref, ".", $post_src_dir, 1)) != $ade_err_ok) {
        &ade_err_error($errstack_ref, aderel_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_err_info($errstack_ref, "cleaning the temporary copy ...");
    if (!chdir($post_src_dir)) {
         &ade_err_error($errstack_ref, ade_err_access, $post_src_dir, "chdir", $!);
         return($ade_err_fail);
    }

#    $saved_PATH = $ENV{'PATH'};
#    $ENV{'PATH'} = $orig_PATH;
    &ade_err_debug($errstack_ref, 4, "aderel: calling \"$clean_cmd\" ...");
#    system("bash --norc");
    $rc = system($clean_cmd) >> 8;
#    $ENV{'PATH'} = $saved_PATH;
    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("/");
        &ade_err_error($errstack_ref, aderel_err_misc, "could not clean temporary sources");
        return($ade_err_fail);
    }

    #  Tar up the temporary cleaned target directory. Do it from the
    #  right place to put the right names in the tar file.
    &ade_err_info($errstack_ref, "creating tar file ...");
    if (!chdir($app_tmp_dir)) {
        &ade_err_error($errstack_ref, ade_err_access, $app_tmp_dir, "chdir", $!);
        return($ade_err_fail);
    }

    $rc = system("tar cbf 20 - $opt_packagename-$opt_releaseid|gzip>$abs_outputfile") >> 8;
    if ($rc != 0) {
        &ade_err_error($errstack_ref, aderel_err_misc, "tar/gzip: failed");
        return($ade_err_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_tmp_deregisterfile($errstack_ref, $abs_outputfile)) != $ade_err_ok) {
        return($rc);
    }

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

    #  Ensure sensible return code
    return($ade_err_ok);
}

sub app_version
{
    my($errstack_ref, $version_ref) = @_;
    my($rc);

    if (($rc=&ade_tmf_extractversionfromsvnstring($errstack_ref, $subversion_string, $version_ref)) != $ade_err_ok) {
        &ade_err_internal($errstack_ref, "app_version: ade_tmf_extractversionfromsvnstring failed\n");
    }

    return($ade_err_ok);
}

sub app_listpaths
{
    my($errstack_ref, $pathlist_ref) = @_;
    my($rc);

    %$pathlist_ref = {};
    return($ade_err_ok);
}

sub app_usage
{
    print "Usage:   $ade_app_progname [ <options> ] <srcdir>\n";
    print "\n";
    #  standard options
    print "Options: -V | --version              display program version\n";
    print "         -v | --verbose              verbose\n";
    print "         -d | --debug=<level>        set debug level\n";
    print "         -h | --help                 display this text\n";
    print "         -p | --list-paths           list used paths\n";
    #  application-specific options
    print "              --author-name=<name>   set package author's name\n";
    print "              --author-email=<addr>  set package author's email address\n";
    print "              --package-name=<pkg>   set name of package to <pkg>\n";
    print "              --release-id=<relid>   set release ID (default to check ChangeLog)\n";
    print "         -f | --output-file=<file>   write to <file> instead of default\n";
    print "         -m | --make=<cmd>           path of 'make' command\n";
    print "\n";

    return($ade_err_ok);
}

sub app_listpaths
{
    my($errstack_ref) = @_;

    return($ade_err_ok);
}

sub load_options_and_config_file
{
    my($errstack_ref) = @_;
    my($key, $old_sigwarn_handler, $i);

    #
    #  Unset everything.
    #
    #  (This function needs to be re-entrant;it can be called when the
    #  program starts, but it can also be called when SIGHUP is recieved.)
    #

    for ($i=0; $i<=$#config_hasharray; $i++) {
        undef ${$config_hasharray[$i]{var}};
    }

    #
    #  Process command line options (top priority).
    #

    #  Redirect GetOptions's alerts to our alerter.
    $old_sigwarn_handler = $SIG{'__WARN__'};
    $SIG{'__WARN__'} = sub { &ade_msg_usage($errstack_ref, \&app_usage, 1); };
    Getopt::Long::GetOptions(
        #  Standard opts
        "V|version"       => sub { &ade_msg_version($errstack_ref, \&app_version); },
        "v|verbose"       => sub { $main::verboselevel = 3; },
        "d|debug=i"       => \$main::verboselevel,
        "h|help"          => sub { &ade_msg_usage($errstack_ref, \&app_usage, 0); },
        "p|list-paths"    => sub { &ade_msg_listpaths($errstack_ref, \&app_listpaths); },
        #  Application specific opts
        "author-name=s"   => \$opt_authorname,
        "author-email=s"  => \$opt_authoremail,
        "package-name=s"  => \$opt_packagename,
        "release-id=s"    => \$opt_releaseid,
        "f|output-file=s" => \$opt_outputfile,
        "m|make=s"        => \$opt_makecmd,
    );
    $SIG{'__WARN__'} = $old_sigwarn_handler;

    #
    #  Assign defaults (third priority therefore done third)
    #

    for ($i=0; $i<=$#config_hasharray; $i++) {
        #print "examining ${$config_hasharray[$i]}{dsc} ...\n";
        #  Skip using default if variable already has value
        next if (defined(${$config_hasharray[$i]{var}}));
        #  Skip using default if there is no default!
        next if (!defined($config_hasharray[$i]{dfl}));
        #  Use default
        ${$config_hasharray[$i]{var}} = $config_hasharray[$i]{dfl};
    }

    #print "\$opt_makecmd=$opt_makecmd\n";

    #
    #  Derivations
    #
    #  Some values depend on others. Work those out now.
    #
    #  Note that the order in which they are worked out is important
    #  (e.g. mail_log_dir needs to be determined *before* mail_log_file
    #  because if the second is not absolute then the first is used as
    #  a prefix). Hence the 'sort' and 'if (key is ...) elsif (key is ..)'
    #

#    foreach $key (sort { if (!defined($a{pri})) { return($ade_err_fail); } elsif (!defined($b{pri})) { return(-1); } else { return ($a{pri} <=> $b{pri}); }} @config_hasharray) {
#        &ade_err_debug($errstack_ref, 10, "load_options_and_config_file: key: $key");
#        if ($key =~ /mail_retr_port/ && !defined(${$confighash_map{$key}{var}})) {
#            ${$confighash_map{$key}{var}} = (${$confighash_map{mail_retr_method}{var}} eq "IMAP")
#? 143 : 110;
#        } elsif ($key =~ /mail_retr_(username|password)/ && !defined(${$confighash_map{$key}{var}}) && ${$confighash_map{mail_retr_authenticate}{var}} eq "NONE") {
#            #  Put dummy text in so that the 'is everything set?' test below passes.
#            #  Put dummy text in so that the 'is everything set?' test below passes.
#            ${$confighash_map{$key}{var}} = "unused";
#        } elsif ($key =~ /mail_send_(username|password)/ && !defined(${$confighash_map{$key}{var}}) && ${$confighash_map{mail_send_authenticate}{var}} eq "NONE") {
#            #  Put dummy text in so that the 'is everything set?' test below passes.
#            ${$confighash_map{$key}{var}} = "unused";
#        } elsif ($key =~ /mail_.*_dir/) {
#            #  If a directtory specification is not absolute, make it so.
#            ${$confighash_map{$key}{var}} =~ s/^(?!\/)/getcwd."\/"/e;
#        } elsif ($key =~ /mail_lock_file/) {
#            #  If lock file not absolute, make it so.
#            ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$lock_dir\//;
#        } elsif ($key =~ /mail_log_file/) {
#            #  If log file not absolute, make it so.
#            ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$log_dir\//;
#        } elsif ($key =~ /mail_(retr|send)_mbox_file/) {
#            #  If log file not absolute, make it so.
#            ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$log_dir\//;
#        } elsif ($key =~ /mail_(status|stats_archive)_table/) {
#            #  If status table not absolute, make it so.
#            ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$state_dir\//;
#        }
#    }

    #
    #  Verify that everything is now set.
    #

    for ($i=0; $i<=$#config_hasharray; $i++) {
        next if (defined(${$config_hasharray[$i]{var}}));
        &ade_err_error($errstack_ref, ade_err_undefined, $config_hasharray[$i]{dsc});
        return($ade_err_fail);
    }

    #
    #  Miscellaneous sanity checks
    #

#    if (!$retr_interval && !$send_interval && !$stat_interval) {
#        &ade_err_error($errstack_ref, ade_err_config, "retrieve, send and stat intervals are all zero!");
#        return($ade_err_fail);
#    }

    #
    #  If we get this far everything is ok.
    #

    return($ade_err_ok);
}

sub process
{
    my($errstack_ref, $srcthing, $dstthing, $do_subst) = @_;
    my($dh, $rc, $infh, $outfh, $subthing, $l_x, $atime, $mtime);
    
    #  Skip Subversion and RCS control directories
    if (-d $srcthing && $srcthing =~ /\/(\.svn|RCS|CVS)$/) {
        return($ade_err_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 aderel runs 'make clean distclean' in the temporary copy.
    if ($srcthing =~ /\.orig$/ || $srcthing =~ /\.gz$/ ||
	    $srcthing =~ /\.ps$/ || $srcthing =~ /\.old$/) {
        &ade_err_warning($errstack_ref, aderel_err_misc, "$srcthing: skipping (should it be here?)");
        return($ade_err_ok);
    }

    #  Skip 'debian' subdir or symlink used for making .deb from sources. Likewise
    #  for 'redhat'
    if ((-d $srcthing || -l $srcthing) && $srcthing =~ /^\.\/(debian|redhat)$/) {
        &ade_err_info($errstack_ref, "$srcthing: skipping (presumably for making distribution package)");
        return($ade_err_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 && $srcthing =~ /.*\/template_modules\/$l_x/) {
        $do_subst = 0 
        &ade_err_warning($errstack_ref, aderel_err_misc, "$srcthing: skipping substitution (ade template?)");
    }

    #  if srcthing is a directory then recurse into each thing
    if (-d $srcthing) {
        &ade_err_debug($errstack_ref, 10, "process: $srcthing is a directory; will now process its contents ...");
        if (!mkdir($dstthing)) {
            &ade_err_error($errstack_ref, ade_err_access, $dstthing, "create", $!);
            return($ade_err_fail);
        }
        if (($dh=new IO::Dir $srcthing) == undef) {
            &ade_err_error($errstack_ref, ade_err_access, $srcthing, "open", $!);
            return($ade_err_fail);
        }
        while (defined($subthing = $dh->read)) {
            #  Skip . and ..
            next if ($subthing =~ /^\.$/ || $subthing =~ /^\.\.$/);
            if (($rc=&process($errstack_ref, "$srcthing/$subthing", "$dstthing/$subthing", $do_subst)) != $ade_err_ok) {
                &ade_err_error($errstack_ref, aderel_err_misc, "$srcthing/$subthing: failed to process");
                return($rc);
            }
        }

    } elsif (-f $srcthing) {
        &ade_err_debug($errstack_ref, 10, "process: $srcthing is a file");
        #  Copy the content
        if (($infh=new IO::File $srcthing) == undef) {
            &ade_err_error($errstack_ref, ade_err_access, $srcthing, "open", $!);
            return($ade_err_fail);
        }
        if (($outfh=new IO::File ">$dstthing") == undef) {
            $infh->close;
            &ade_err_error($errstack_ref, ade_err_access, $dstthing, "open", $!);
            return($ade_err_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_err_error($errstack_ref, ade_err_obsolete, "SP\PSYM_AUTHOR_EMAIL", "ADE_APP_TO\KEN_AUTHOR_EMAIL", "placeholder");
                    return($ade_err_fail);
 		}
                if (s/ADE_APP_TO(K)EN_AUTHOR_EMAIL/$opt_authoremail/g && !$opt_authoremail) {
                    &ade_err_error($errstack_ref, aderel_err_misc, "ADE_APP_TO\KEN_AUTHOR_EMAIL: found in sources without '--author-email=<addr>' option");
                    return($ade_err_fail);
 		}
                if (/SP(P)SYM_AUTHOR_NAME/) {
                    &ade_err_error($errstack_ref, ade_err_obsolete, "SP\PSYM_AUTHOR_NAME", "ADE_APP_TO\KEN_AUTHOR_NAME", "placeholder");
                    return($ade_err_fail);
                }
                if (s/ADE_APP_TO(K)EN_AUTHOR_NAME/$opt_authorname/g && !$opt_authorname) {
                    &ade_err_error($errstack_ref, aderel_err_misc, "'ADE_APP_TO\KEN_AUTHOR_NAME: found in sources without '--author-name=<name>' option");
                    return($ade_err_fail);
                }
                if (/SP(P)SYM_RELEASE_ID/) {
                    &ade_err_error($errstack_ref, ade_err_obsolete, "SP\PSYM_RELEASE_ID", "ADE_APP_TO\KEN_RELEASE_ID", "placeholder");
                    return($ade_err_fail);
                }
                s/ADE_APP_TO(K)EN_RELEASE_ID/$opt_releaseid/g;
                if (/SP(P)SYM_RELEASE_YEAR/) {
                    &ade_err_error($errstack_ref, ade_err_obsolete, "SP\PSYM_RELEASE_YEAR", "ADE_APP_TO\KEN_RELEASE_YEAR", "placeholder");
                    return($ade_err_fail);
                }
                s/ADE_APP_TO(K)EN_RELEASE_YEAR/$release_year/g;
                if (/SP(P)SYM_RELEASE_DATE_MAN/) {
                    &ade_err_error($errstack_ref, ade_err_obsolete, "SP\PSYM_RELEASE_DATE_MAN", "ADE_APP_TO\KEN_RELEASE_DATE_MAN", "placeholder");
                    return($ade_err_fail);
                }
                s/ADE_APP_TO(K)EN_RELEASE_DATE_MAN/$release_date_man/g;
                $outfh->print($_);
            } 
        } else {
            while (<$infh>) {
                $outfh->print($_);
            } 
        }
        $infh->close;
        $outfh->close;
        #  Copy the executability
        if (-x $srcthing) { chmod 0755, $dstthing; }
        #  Copy the timestamp
        $atime = $mtime = (lstat $srcthing)[9];
        utime $atime, $mtime, $dstthing;
    } else {
        &ade_err_debug($errstack_ref, 10, "process: $srcthing is not a file or directory");
        &ade_err_internal($errstack_ref, "$srcthing/$_: unknown file type");
    }

    return($ade_err_ok);
}

&ade_gep_main(\&aderel);