#**************************************************************
#
#  Licensed to the Apache Software Foundation (ASF) under one
#  or more contributor license agreements.  See the NOTICE file
#  distributed with this work for additional information
#  regarding copyright ownership.  The ASF licenses this file
#  to you under the Apache License, Version 2.0 (the
#  "License"); you may not use this file except in compliance
#  with the License.  You may obtain a copy of the License at
#
#    http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing,
#  software distributed under the License is distributed on an
#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
#  KIND, either express or implied.  See the License for the
#  specific language governing permissions and limitations
#  under the License.
#
#**************************************************************



package installer::logger;

use installer::files;
use installer::globals;
use Time::HiRes qw(gettimeofday tv_interval);
use English;
use IO::Handle;
use strict;

my $StartTime = undef;

sub PrintStackTrace ();
sub Die ($);

=head1 NAME

	installer::logger

	Logging for the installer modules.

=cut

=head1 DESCRIPTION

	This module is in a transition state from a set of loosely connected functions to a single class.

	There are three globally available logger objects:

=over

=item $Lang

	is language specific and writes messages to a log file.

=cut

=item $Glob

	is independent of the current language. Its messages are prepended to each $Lang logger.

=cut

=item $Info

	is for output to the console.

=cut

=back

=cut


our $Global = installer::logger->new("glob",
	'is_save_lines' => 1,
	'is_print_to_console' => 0,
	'is_show_relative_time' => 1);
our $Lang = installer::logger->new("lang",
	'is_print_to_console' => 0,
	'is_show_relative_time' => 1,
	'is_show_log_id' => 1
	);
our $Info = installer::logger->new("info",
	'is_show_relative_time' => 0,
	'is_show_process_id' => 0,
	'is_show_log_id' => 0
	);



=head2 SetupSimpleLogging ($filename)

	Setup logging so that $Global, $Lang and $Info all print to the console.
	If $filename is given then logging also goes to that file.

=cut
sub SetupSimpleLogging (;$)
{
	my ($log_filename) = @_;

	$Info = installer::logger->new("info",
		'is_print_to_console' => 1,
		'is_show_relative_time' => 1,
		);
	$Global = installer::logger->new("glob",
		'is_print_to_console' => 0,
		'is_show_relative_time' => 1,
		'forward' => [$Info]
		);
	$Lang = installer::logger->new("lang",
		'is_print_to_console' => 0,
		'is_show_relative_time' => 1,
		'forward' => [$Info]
		);
	if (defined $log_filename)
	{
		$Info->set_filename($log_filename);
	}
	$Info->{'is_print_to_console'} = 1;
	$installer::globals::quiet = 0;
	starttime();
}




=head2 new($class, $id, @arguments)

	Create a new instance of the logger class.
	@arguments lets you override default values.

=cut

sub new ($$@)
{
	my ($class, $id, @arguments) = @_;

	my $self = {
		'id' => $id,
		'filename' => "",
		# When set then lines are printed to this file.
		'file' => undef,
		# When true then lines are printed to the console.
		'is_print_to_console' => 1,
		'is_save_lines' => 0,
		# A container of printed lines. Lines are added only when 'is_save_lines' is true.
		'lines' => [],
		# Another logger to which all prints are forwarded.
		'forward' => [],
		# A filter function that for example can recognize build errors.
		'filter' => undef,
		# Show relative time
		'is_show_relative_time' => 0,
		# Show log id (mostly for debugging the logger).
		'is_show_log_id' => 0,
		# Show the process id, useful on the console when doing a multiprocessor build.
		'is_show_process_id' => 0,
		# Current indentation.
		'indentation' => "",
	};
	while (scalar @arguments >= 2)
	{
		my $key = shift @arguments;
		my $value = shift @arguments;
		$self->{$key} = $value;
	}

	bless($self, $class);

	return $self;
}



=head2 printf($self, $message, @arguments)

	Identical in syntax and semantics to the usual perl (s)printf.

=cut
sub printf ($$@)
{
	my ($self, $format, @arguments) = @_;

	if ($format =~ /\%\{/)
	{
		printf(">%s<\n", $format);
		PrintStackTrace();
	}
	my $message = sprintf($format, @arguments);
	$self->print($message, 0);
}




=head2 print ($self, $message, [optional] $force)

	Print the given message.
	If the optional $force parameter is given and it evaluates to true then the message
	is printed even when the global $installer::globals::quiet is true.

=cut
sub print ($$;$)
{
	my ($self, $message, $force) = @_;

	Die "newline at start of line" if ($message =~ /^\n.+/);

	$force = 0 unless defined $force;

	my $relative_time = tv_interval($StartTime, [gettimeofday()]);
	foreach my $target ($self, @{$self->{'forward'}})
	{
		$target->process_line(
			$relative_time,
			$self->{'id'},
			$PID,
			$message,
			$force);
	}
}




=head2 process_line ($self, $relative_time, $log_id, $pid, $message, $force)

	Internal function that decides whether to
	a) write to a log file
	b) print to the console
	c) store in an array for later use
	the preformatted message.

=cut
sub process_line ($$$$$$)
{
	my ($self, $relative_time, $log_id, $pid, $message, $force) = @_;

	# Apply the line filter.
	if (defined $self->{'filter'})
	{
		$message = &{$self->{'filter'}}($relative_time, $log_id, $pid, $message);
	}

	# Format the line.
	my $line = "";
	if ($self->{'is_show_relative_time'})
	{
		$line .= sprintf("%12.6f : ", $relative_time);
	}
	if ($self->{'is_show_log_id'})
	{
		$line .= $log_id . " : ";
	}
	if ($self->{'is_show_process_id'})
	{
		$line .= $pid . " : ";
	}
	$line .= $self->{'indentation'};
	$line .= $message;

	# Print the line to a file or to the console or store it for later use.
	my $fid = $self->{'file'};
	if (defined $fid)
	{
		print $fid ($line);
	}
	if (($force || ! $installer::globals::quiet)
		&& $self->{'is_print_to_console'})
	{
		print($line);
	}
	if ($self->{'is_save_lines'})
	{
		push @{$self->{'lines'}}, [$relative_time, $log_id, $pid, $message, $force];
	}
}




=head2 set_filename (Self, $filename)

	When the name of a writable file is given then all future messages will go to that file.
	Output to the console is turned off.
	This method is typically used to tie the language dependent $Lang logger to different log files.

=cut
sub set_filename ($$)
{
	my ($self, $filename) = @_;

	$filename = "" unless defined $filename;
	if ($self->{'filename'} ne $filename)
	{
		if (defined $self->{'file'})
		{
			$self->{'is_print_to_console'} = 1;
			close $self->{'file'};
			$self->{'file'} = undef;
		}

		$self->{'filename'} = $filename;

		if ($filename ne "")
		{
			open $self->{'file'}, ">", $self->{'filename'}
			|| Die "can not open log file ".$self->{'filename'}." for writing";
			$self->{'is_print_to_console'} = 0;

			# Make all writes synchronous so that we don't loose any messages on an
			# 'abrupt' end.
			my $handle = select $self->{'file'};
			$| = 1;
			select $handle;
		}
	}
}




=head2 set_filter ($self, $filter)

	Sets $filter (a function reference) as line filter. It is applied to each line.
	The filter can extract information from the given message and modify it before it is printed.

=cut
sub set_filter ($$)
{
	my ($self, $filter) = @_;
	$self->{'filter'} = $filter;
}




=head2 add_timestamp ($self, $message)

	Print the given message together with the current (absolute) time.

=cut
sub add_timestamp ($$)
{
	my ($self, $message) = @_;

	my $timestring = get_time_string();
	$self->printf("%s\t%s", $message, $timestring);
}



=head2 copy_lines_from ($self, $other)

	Copy saved lines from another logger object.

=cut
sub copy_lines_from ($$)
{
	my ($self, $other) = @_;

	my $is_print_to_console = $self->{'is_print_to_console'};
	my $is_save_lines = $self->{'is_save_lines'};
	my $fid = $self->{'file'};

	foreach my $line (@{$other->{'lines'}})
	{
		$self->process_line(@$line);
	}
}




=head2 set_forward ($self, $other)

	Set a forwarding target. All future messages are forwarded (copied) to $other.
	A typical use is to tie $Info to $Lang so that all messages sent to $Info are
	printed to the console AND written to the log file.

=cut
sub set_forward ($$)
{
	my ($self, $other) = @_;

	# At the moment at most one forward target is allowed.
	if (defined $other)
	{
		$self->{'forward'} = [$other];
	}
	else
	{
		$self->{'forward'} = [];
	}
}




sub increase_indentation ($)
{
	my ($self) = @_;
	$self->{'indentation'} .= "    ";
}




sub decrease_indentation ($)
{
	my ($self) = @_;
	$self->{'indentation'} = substr($self->{'indentation'}, 4);
}




####################################################
# Including header files into the logfile
####################################################

sub include_header_into_logfile
{
	my ($message) = @_;

	$Lang->print("\n");
	$Lang->print(get_time_string());
	$Lang->print("######################################################\n");
	$Lang->print($message."\n");
	$Lang->print("######################################################\n");
}

####################################################
# Including header files into the logfile
####################################################

sub include_header_into_globallogfile
{
	my ($message) = @_;

	$Global->print("\n");
	$Global->print(get_time_string());
	$Global->print("######################################################\n");
	$Global->print($message."\n");
	$Global->print("######################################################\n");
}

####################################################
# Write timestamp into log file
####################################################

sub include_timestamp_into_logfile
{
	Die "deprecated";
	my ($message) = @_;

	my $infoline;
	my $timestring = get_time_string();
	$Lang->printf("%s\t%s", $message, $timestring);
}

####################################################
# Writing all variables content into the log file
####################################################

sub log_hashref
{
	my ($hashref) = @_;

	$Global->print("\n");
	$Global->print("Logging variable settings:\n");

	my $itemkey;

	foreach $itemkey ( keys %{$hashref} )
	{
		my $line = "";
		my $itemvalue = "";
		if ( $hashref->{$itemkey} ) { $itemvalue = $hashref->{$itemkey}; }
		$Global->printf("%s=%s\n", $itemkey, $itemvalue);
	}

	$Global->print("\n");
}

#########################################################
# Including global logging info into global log array
#########################################################

sub globallog
{
	my ($message) = @_;

	my $infoline;

	$Global->print("\n");
	$Global->print(get_time_string());
	$Global->print("################################################################\n");
	$Global->print($message."\n");
	$Global->print("################################################################\n");
}

###############################################################
# For each product (new language) a new log file is created.
# Therefore the global logging has to be saved in this file.
###############################################################

sub copy_globalinfo_into_logfile
{
	for ( my $i = 0; $i <= $#installer::globals::globallogfileinfo; $i++ )
	{
		push(@installer::globals::logfileinfo, $installer::globals::globallogfileinfo[$i]);
	}
}

###############################################################
# For each product (new language) a new log file is created.
# Therefore the global logging has to be saved in this file.
###############################################################

sub debuginfo
{
	my ( $message ) = @_;

	$message = $message . "\n";
	push(@installer::globals::functioncalls, $message);
}

###############################################################
# Saving the debug information.
###############################################################

sub savedebug
{
	my ( $outputdir ) = @_;

	installer::files::save_file($outputdir . $installer::globals::debugfilename, \@installer::globals::functioncalls);
	print_message( "... writing debug file " . $outputdir . $installer::globals::debugfilename . "\n" );
}

###############################################################
# Starting the time
###############################################################

sub starttime
{
	$installer::globals::starttime = time();
	$StartTime = [gettimeofday()];

	my $localtime = localtime();
}

###############################################################
# Convert time string
###############################################################

sub convert_timestring
{
	my ($secondstring) = @_;

	my $timestring = "";

	if ( $secondstring < 60 )	 # less than a minute
	{
		if ( $secondstring < 10 ) { $secondstring = "0" . $secondstring; }
		$timestring = "00\:$secondstring min\.";
	}
	elsif ( $secondstring < 3600 )
	{
		my $minutes = $secondstring / 60;
		my $seconds = $secondstring % 60;
		if ( $minutes =~ /(\d*)\.\d*/ ) { $minutes = $1; }
		if ( $minutes < 10 ) { $minutes = "0" . $minutes; }
		if ( $seconds < 10 ) { $seconds = "0" . $seconds; }
		$timestring = "$minutes\:$seconds min\.";
	}
	else	# more than one hour
	{
		my $hours = $secondstring / 3600;
		my $secondstring = $secondstring % 3600;
		my $minutes = $secondstring / 60;
		my $seconds = $secondstring % 60;
		if ( $hours =~ /(\d*)\.\d*/ ) { $hours = $1; }
		if ( $minutes =~ /(\d*)\.\d*/ ) { $minutes = $1; }
		if ( $hours < 10 ) { $hours = "0" . $hours; }
		if ( $minutes < 10 ) { $minutes = "0" . $minutes; }
		if ( $seconds < 10 ) { $seconds = "0" . $seconds; }
		$timestring = "$hours\:$minutes\:$seconds hours";
	}

	return $timestring;
}

###############################################################
# Returning time string for logging
###############################################################

sub get_time_string
{
	my $currenttime = time();
	$currenttime = $currenttime - $installer::globals::starttime;
	$currenttime = convert_timestring($currenttime);
	$currenttime = localtime() . " \(" . $currenttime . "\)\n";
	return $currenttime;
}

###############################################################
# Returning the age of a file (in seconds)
###############################################################

sub get_file_age
{
	my ( $filename ) = @_;

	my $filetime = (stat($filename))[9];
	my $timediff = time() - $filetime;
	return $timediff;
}

###############################################################
# Stopping the time
###############################################################

sub stoptime
{
	my $localtime = localtime();
	$Info->printf("stopping log at %s\n", $localtime);
}

###############################################################
# Set date string, format: yymmdd
###############################################################

sub set_installation_date
{
	my $datestring = "";

	my @timearray = localtime(time);

	my $day = $timearray[3];
	my $month = $timearray[4] + 1;
	my $year = $timearray[5] - 100;

	if ( $year < 10 ) { $year = "0" . $year; }
	if ( $month < 10 ) { $month = "0" . $month; }
	if ( $day < 10 ) { $day = "0" . $day; }

	$datestring = $year . $month . $day;

	return $datestring;
}

###############################################################
# Console output: messages
###############################################################

sub print_message
{
	Die "print_message is deprecated";

	my $message = shift;
	chomp $message;
	my $force = shift || 0;
	print "$message\n" if ( $force || ! $installer::globals::quiet );
	return;
}

sub print_message_without_newline
{
	my $message = shift;
	chomp $message;
	print "$message" if ( ! $installer::globals::quiet );
	return;
}

###############################################################
# Console output: warnings
###############################################################

sub print_warning
{
	my $message = shift;
	chomp $message;
	print STDERR "WARNING: $message";
	return;
}

###############################################################
# Console output: errors
###############################################################

sub print_error
{
	my $message = shift;
	chomp $message;

	PrintError($message);

	print STDERR "\n";
	print STDERR "**************************************************\n";
	print STDERR "ERROR: $message";
	print STDERR "\n";
	print STDERR "**************************************************\n";
	return;
}




sub PrintError ($@)
{
	my ($format, @arguments) = @_;

	$Info->printf("Error: ".$format, @arguments);
}




=head2 PrintStackTrace()
	This is for debugging the print and printf methods of the logger class and their use.
	Therefore we use the Perl print/printf directly and not the logger methods to avoid loops in case of errors.
=cut
sub PrintStackTrace ()
{
	print "Stack Trace:\n";
	my $i = 1;
	while ((my @call_details = (caller($i++))))
	{
		printf("%s:%s in function %s\n", $call_details[1], $call_details[2], $call_details[3]);
	}
}


sub Die ($)
{
	my ($message) = @_;
	PrintStackTrace();
	die $message;
}

1;
