package Log::ProgramInfo;

=head1 NAME

Log::ProgramInfo - log global info from a perl programs.

### HISTORY ###################################################################
# Version               Date            Developer        Comments
# 0.1.1                 2015-04-02      John Macdonald   Initial release to CPAN
# 0.1.2                 2015-04-04      John Macdonald   Minor cleanups to initial release
# 0.1.3                 2015-04-09      John Macdonald   Rename s/JobInof/ProgramInfo/
# 0.1.4                 2015-04-09      John Macdonald   Add README
#

=head1 VERSION

Version 0.1.4

=cut

our $VERSION = '0.1.4';

use feature qw(say);
use Data::Dumper;
use FindBin;
use Time::HiRes qw(time);
use DateTime;
use DateTime::Duration;
use Carp;
use Fcntl qw(:flock);


=head1 SYNOPSIS

		use Log::ProgramInfo qw(
			[ -logname LOGNAME                 ]
			[ -logdir  LOGDIR                  ]
			[ -logext  LOGEXT                  ]
			[ -logdate none|date|time|datetime ]
			[ -stdout                          ]
			[ -suppress                        ]
			);

		# main program does lots of stuff...
		exit 0;

	After the program has run, this module will automatically
	log information about this run into a log file.  It will
	list such things as:
	  - program
	    - name
		- version
	  - command line arguments
	  - version of perl
	  - modules loaded
	    - source code location
	    - Version
	  - run time

	The log is appended to the file:
	    LOGDIR/LOGDATE-LOGNAME.LOGEXT
	where
	    LOGDIR        defaults to . (the current directory when the program terminates)
	    LOGDATE       defaults to the date that the program was started
	    LOGNAME       defaults to the basename of the program
		LOGEXT        defaults to ".jobinfolog"

	The -ARG specifiers in the "import" list can be used to over-ride these defaults.  Specifying:

	-logname LOGNAME  will use LOGNAME instead of the program name
	-logdir  LOGDIR   will use LOGDIR instead of the current directory
	                    - if it is a relative path, it will be based on the
                              current directory at termination of execution
	-logext  EXT      will add .EXT to the log filename
	-logext  .EXT     will add .EXT to the log filename
	-logext  ""       will add no extension to the log filename
	-logdate STRING
	                  will specify the LOGDATE portion of the filename.  The STRING can be:
			      none      LOGNAME (and no dash)
			      date      YYYYMMDD-LOGNAME   (this is the default)
			      time      HHMMSS-LOGNAME
			      datetime  YYYYMMDDHHMMSS-LOGNAME

	-stdout           will cause the log to be sent to stdout instead of a file
	-suppress         will suppress logging (unless environment variable
                              LOGJOBINFO_SUPPRESS is explcitly set to 0 or null)

                              Normally, neither -suppress nor -stdout will be set in the
                              use statement, and the environment variables can then be
                              used to disable the logging completely or to send it to
                              stdout instead of to the selected file.

                              For some programs, however, it may be desired to not normally
                              provide any logging.  Specifying -suppress will accomplish
                              this.  In such a case, setting the environment variable
                              LOGJOBINFO_SUPPRESS=0 will over-ride that choice, causing
                              the log to be written (as specified by the other options
                              and environment variables).

	Environment variables can over-ride some of these:
	    LOGJOBINFO_SUPPRESS=x  boolean suppresses all logging if true
	    LOGJOBINFO_STDOUT=x    boolean sets -stdout
	    LOGJOBINFO_DIR=DIR     string  sets the target directory name
	    LOGJOBINFO_FILE=FILE   string  sets the target filename LOGNAME
	    LOGJOBINFO_EXT=EXT     string  sets the target extension
	    LOGJOBINFO_DATE=DATE   string  sets the target filename LOGDATE selector

=cut

# preserve command line info
my @args      = @ARGV;
my $progbase;
my $starttime;

my %option;

my %valid_dates;

my %_omap;

my $kill_caught;

BEGIN {
	$progbase        = $FindBin::Script;
	$starttime       = DateTime->from_epoch(epoch => time);
	$valid_dates{$_} = 1 for qw( date time datetime none );

	%option = (
		logname   => $progbase,
		logdir    => ".",
		logdate   => "date",
		logext    => ".jobinfo",
		stdout    => 0,
		suppress  => 0,
		importcnt => 0
	);

	%_omap = (
		LOGJOBINFO_SUPPRESS => 'suppress',
		LOGJOBINFO_STDOUT   => 'stdout',
		LOGJOBINFO_DIR      => 'logdir',
		LOGJOBINFO_FILE     => 'logname',
		LOGJOBINFO_EXT      => 'logext',
		LOGJOBINFO_DATE     => 'logdate'
	);
}

sub import {
	my $mod = shift;

	unless ($option->{importcnt}++) {
		# pull ENV var over-rides
		while (my ($e, $o) = each %_omap) {
			$option{$o} = $ENV{$e} if exists $ENV{$e};
		}
	}

	while (scalar(@_)) {
		if ($_[0] =~ /^-(logname|logdir|logext|logdate)$/) {
			my $key = $1;
			croak "Option to Log::ProgramInfo requires a value: $_[0]" if scalar(@_) == 1;
			shift;
			my $val = shift;
			$option{$key} = $val;
		}
		elsif ($_[0] =~ /^-(stdout|suppress)$/) {
			my $key = $1;
			shift;
			$option{$key} = 1;
		}
		else {
			last;
		}
	}

	croak "Unknown option to Log::ProgramInfo: $_[0]" if (@_ and $_[0] =~ /^-/);
	croak "Import arguments not supported from Log::ProgramInfo: " . join( ',', @_ ) if @_;
	croak "Unknown logdate option: $option{logdate}"
		unless exists $valid_dates{ $option{logdate} };

	$SIG{HUP} = \&catch_sig;
	say STDERR "resolved option hash: ", Dumper(\%option) if $ENV{DUMP_LOG_IMPORTS};
}

END {
	my $exit_status = $?;
	local $?;    # protect program exit code from END actions
	finish_log($exit_status);
}

sub catch_sig {
	my $signame = shift;
	local $?;    # protect program exit code from END actions
	finish_log("Killed with signal: $signame");
}

sub finish_log {
	return if $kill_caught++; # only write log once - first kill, or termination
	my $exit_status = shift;
	unless ($option{suppress}) {
		my $logfh;
		my $endtime = DateTime->from_epoch(epoch => time);

		if ($option{stdout}) {
			open $logfh, ">>&STDOUT";
		}
		else {
			my $dopt = $option{logdate};
			my $date =
				( "none" eq $dopt )   ? ''
				: ( "date" eq $dopt ) ? $starttime->ymd('')
				: ( "time" eq $dopt ) ? $starttime->hms('')

				# : ("datetime" eq $dopt) # validated, so must be 'datetime '
				: ( $starttime->ymd('') . $starttime->hms('') );
			$date .= '-' if $date;
			$option{logext} = ".$option{logext}" if $option{logext} =~ m(^[^.]);
			my $log_path = "$option{logdir}/$date$option{logname}$option{logext}";
			open( $logfh, ">>", $log_path )
				or carp "cannot open log file $log_path: $!";
			say STDERR "Appending log info to $log_path";
			my $lock_cnt = 0;
			while (1) {
				flock $logfh, LOCK_EX and last;
				croak "$0 [$$]: flock failed on $log_path: $!" if $lock_cnt > 30;
				say STDERR "Waiting for lock on $log_path" unless $lock_cnt++;
				print STDERR ".";
				sleep(2);
			}
			say "" if $lock_cnt;
		}

		say $logfh "########";

		my $mod = show_modules();
		for my $key ( sort keys %$mod ) {
			my ( $ver, $loc ) = @{ $mod->{$key} };
			say $logfh "MODULE  : $key($ver)";
			say $logfh "   LOC  :     $loc";
		}
		for my $inc (@INC) {
			say $logfh "INC     : $inc";
		}

		printf $logfh ( "UNAME   : %-8s : %s", $_->[1], qx( uname $_->[0] ) )
			for (
			[ -s => "System" ],
			[ -n => "Name" ],
			[ -r => "OSRel" ],
			[ -v => "OSVer" ],
			[ -m => "Machine" ]
		);
		say $logfh   "PERL    : ", $^X;
		say $logfh   "PERLVer : ", $];
		say $logfh   "ProgDir : $FindBin::Bin";
		say $logfh   "Program : $progbase";
		say $logfh   "Version : ", ( $::VERSION // "(No VERSION)" );
		say $logfh   "Args    : ", scalar(@args);
		my $acnt = 0;
		say $logfh   "  arg   : ", sprintf( "%-8d : %s", ++$acnt, $args[$acnt-1] ) for @args;
		say $logfh   "Start   : ", $starttime->datetime(), ".", sprintf( "%03d", $starttime->millisecond );
		say $logfh   "End     : ", $endtime->datetime(), ".", sprintf( "%03d", $endtime->millisecond );
		my $dur = $endtime->subtract_datetime_absolute($starttime);
		say $logfh   "Elapsed : ", $dur->delta_seconds, ".",
									sprintf( "%03d", $dur->delta_nanoseconds/1_000_000);
		say $logfh   "ExitStat: ", $exit_status;

		say $logfh "";

		close($logfh);
	}
}

# Print version and loading path information for modules
sub show_modules {
	my $module_infos = {};

	# %INC looks like this:
	# {
	#    ...
	#    "Data/Dump.pm"
	#        => "/whatever/perl/lib/site_perl/5.18.1/Data/Dump.pm",
	#    ...
	# }
	# So let's convert it to this:
	# {
	#    ...
	#    "Data/Dump.pm"
	#        => [ "1.4.2",
	#             "/whatever/perl/lib/site_perl/5.18.1/Data/Dump.pm",
	#           ],
	#    ...
	# }
	foreach my $module_inc_name ( keys(%INC) ) {
		my $real_name = $module_inc_name;
		$real_name =~ s|/|::|g;
		$real_name =~ s|\.pm$||;

		my $version = eval { $real_name->VERSION }
			// eval { ${"${real_name}::VERSION"} }
			// 'unknown';
		# stringify, in case it is a weird format
		# - I don't think the 'invalid' alternative can be hit, but safer to have it in
		$version = eval { $version . ''  } // 'invalid';

		$module_infos->{$real_name} = [ $version, $INC{$module_inc_name} ];
	}

	return $module_infos;
}

1;
