1#**************************************************************
2#
3#  Licensed to the Apache Software Foundation (ASF) under one
4#  or more contributor license agreements.  See the NOTICE file
5#  distributed with this work for additional information
6#  regarding copyright ownership.  The ASF licenses this file
7#  to you under the Apache License, Version 2.0 (the
8#  "License"); you may not use this file except in compliance
9#  with the License.  You may obtain a copy of the License at
10#
11#    http://www.apache.org/licenses/LICENSE-2.0
12#
13#  Unless required by applicable law or agreed to in writing,
14#  software distributed under the License is distributed on an
15#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
16#  KIND, either express or implied.  See the License for the
17#  specific language governing permissions and limitations
18#  under the License.
19#
20#**************************************************************
21
22
23
24package installer::logger;
25
26use installer::files;
27use installer::globals;
28use Time::HiRes qw(gettimeofday tv_interval);
29use English;
30use IO::Handle;
31use strict;
32
33my $StartTime = undef;
34
35sub PrintStackTrace ();
36sub Die ($);
37
38=head1 NAME
39
40	installer::logger
41
42	Logging for the installer modules.
43
44=cut
45
46=head1 DESCRIPTION
47
48	This module is in a transition state from a set of loosely connected functions to a single class.
49
50	There are three globally available logger objects:
51
52=over
53
54=item $Lang
55
56	is language specific and writes messages to a log file.
57
58=cut
59
60=item $Glob
61
62	is independent of the current language. Its messages are prepended to each $Lang logger.
63
64=cut
65
66=item $Info
67
68	is for output to the console.
69
70=cut
71
72=back
73
74=cut
75
76
77our $Global = installer::logger->new("glob",
78	'is_save_lines' => 1,
79	'is_print_to_console' => 0,
80	'is_show_relative_time' => 1);
81our $Lang = installer::logger->new("lang",
82	'is_print_to_console' => 0,
83	'is_show_relative_time' => 1,
84	'is_show_log_id' => 1
85	);
86our $Info = installer::logger->new("info",
87	'is_show_relative_time' => 0,
88	'is_show_process_id' => 0,
89	'is_show_log_id' => 0
90	);
91
92
93
94=head2 SetupSimpleLogging ($filename)
95
96	Setup logging so that $Global, $Lang and $Info all print to the console.
97	If $filename is given then logging also goes to that file.
98
99=cut
100sub SetupSimpleLogging (;$)
101{
102	my ($log_filename) = @_;
103
104	$Info = installer::logger->new("info",
105		'is_print_to_console' => 1,
106		'is_show_relative_time' => 1,
107		);
108	$Global = installer::logger->new("glob",
109		'is_print_to_console' => 0,
110		'is_show_relative_time' => 1,
111		'forward' => [$Info]
112		);
113	$Lang = installer::logger->new("lang",
114		'is_print_to_console' => 0,
115		'is_show_relative_time' => 1,
116		'forward' => [$Info]
117		);
118	if (defined $log_filename)
119	{
120		$Info->set_filename($log_filename);
121	}
122	$Info->{'is_print_to_console'} = 1;
123	$installer::globals::quiet = 0;
124	starttime();
125}
126
127
128
129
130=head2 new($class, $id, @arguments)
131
132	Create a new instance of the logger class.
133	@arguments lets you override default values.
134
135=cut
136
137sub new ($$@)
138{
139	my ($class, $id, @arguments) = @_;
140
141	my $self = {
142		'id' => $id,
143		'filename' => "",
144		# When set then lines are printed to this file.
145		'file' => undef,
146		# When true then lines are printed to the console.
147		'is_print_to_console' => 1,
148		'is_save_lines' => 0,
149		# A container of printed lines. Lines are added only when 'is_save_lines' is true.
150		'lines' => [],
151		# Another logger to which all prints are forwarded.
152		'forward' => [],
153		# A filter function that for example can recognize build errors.
154		'filter' => undef,
155		# Show relative time
156		'is_show_relative_time' => 0,
157		# Show log id (mostly for debugging the logger).
158		'is_show_log_id' => 0,
159		# Show the process id, useful on the console when doing a multiprocessor build.
160		'is_show_process_id' => 0,
161		# Current indentation.
162		'indentation' => "",
163	};
164	while (scalar @arguments >= 2)
165	{
166		my $key = shift @arguments;
167		my $value = shift @arguments;
168		$self->{$key} = $value;
169	}
170
171	bless($self, $class);
172
173	return $self;
174}
175
176
177
178=head2 printf($self, $message, @arguments)
179
180	Identical in syntax and semantics to the usual perl (s)printf.
181
182=cut
183sub printf ($$@)
184{
185	my ($self, $format, @arguments) = @_;
186
187	if ($format =~ /\%\{/)
188	{
189		printf(">%s<\n", $format);
190		PrintStackTrace();
191	}
192	my $message = sprintf($format, @arguments);
193	$self->print($message, 0);
194}
195
196
197
198
199=head2 print ($self, $message, [optional] $force)
200
201	Print the given message.
202	If the optional $force parameter is given and it evaluates to true then the message
203	is printed even when the global $installer::globals::quiet is true.
204
205=cut
206sub print ($$;$)
207{
208	my ($self, $message, $force) = @_;
209
210	Die "newline at start of line" if ($message =~ /^\n.+/);
211
212	$force = 0 unless defined $force;
213
214	my $relative_time = tv_interval($StartTime, [gettimeofday()]);
215	foreach my $target ($self, @{$self->{'forward'}})
216	{
217		$target->process_line(
218			$relative_time,
219			$self->{'id'},
220			$PID,
221			$message,
222			$force);
223	}
224}
225
226
227
228
229=head2 process_line ($self, $relative_time, $log_id, $pid, $message, $force)
230
231	Internal function that decides whether to
232	a) write to a log file
233	b) print to the console
234	c) store in an array for later use
235	the preformatted message.
236
237=cut
238sub process_line ($$$$$$)
239{
240	my ($self, $relative_time, $log_id, $pid, $message, $force) = @_;
241
242	# Apply the line filter.
243	if (defined $self->{'filter'})
244	{
245		$message = &{$self->{'filter'}}($relative_time, $log_id, $pid, $message);
246	}
247
248	# Format the line.
249	my $line = "";
250	if ($self->{'is_show_relative_time'})
251	{
252		$line .= sprintf("%12.6f : ", $relative_time);
253	}
254	if ($self->{'is_show_log_id'})
255	{
256		$line .= $log_id . " : ";
257	}
258	if ($self->{'is_show_process_id'})
259	{
260		$line .= $pid . " : ";
261	}
262	$line .= $self->{'indentation'};
263	$line .= $message;
264
265	# Print the line to a file or to the console or store it for later use.
266	my $fid = $self->{'file'};
267	if (defined $fid)
268	{
269		print $fid ($line);
270	}
271	if (($force || ! $installer::globals::quiet)
272		&& $self->{'is_print_to_console'})
273	{
274		print($line);
275	}
276	if ($self->{'is_save_lines'})
277	{
278		push @{$self->{'lines'}}, [$relative_time, $log_id, $pid, $message, $force];
279	}
280}
281
282
283
284
285=head2 set_filename (Self, $filename)
286
287	When the name of a writable file is given then all future messages will go to that file.
288	Output to the console is turned off.
289	This method is typically used to tie the language dependent $Lang logger to different log files.
290
291=cut
292sub set_filename ($$)
293{
294	my ($self, $filename) = @_;
295
296	$filename = "" unless defined $filename;
297	if ($self->{'filename'} ne $filename)
298	{
299		if (defined $self->{'file'})
300		{
301			$self->{'is_print_to_console'} = 1;
302			close $self->{'file'};
303			$self->{'file'} = undef;
304		}
305
306		$self->{'filename'} = $filename;
307
308		if ($filename ne "")
309		{
310			open $self->{'file'}, ">", $self->{'filename'}
311			|| Die "can not open log file ".$self->{'filename'}." for writing";
312			$self->{'is_print_to_console'} = 0;
313
314			# Make all writes synchronous so that we don't loose any messages on an
315			# 'abrupt' end.
316			my $handle = select $self->{'file'};
317			$| = 1;
318			select $handle;
319		}
320	}
321}
322
323
324
325
326=head2 set_filter ($self, $filter)
327
328	Sets $filter (a function reference) as line filter. It is applied to each line.
329	The filter can extract information from the given message and modify it before it is printed.
330
331=cut
332sub set_filter ($$)
333{
334	my ($self, $filter) = @_;
335	$self->{'filter'} = $filter;
336}
337
338
339
340
341=head2 add_timestamp ($self, $message)
342
343	Print the given message together with the current (absolute) time.
344
345=cut
346sub add_timestamp ($$)
347{
348	my ($self, $message) = @_;
349
350	my $timestring = get_time_string();
351	$self->printf("%s\t%s", $message, $timestring);
352}
353
354
355
356=head2 copy_lines_from ($self, $other)
357
358	Copy saved lines from another logger object.
359
360=cut
361sub copy_lines_from ($$)
362{
363	my ($self, $other) = @_;
364
365	my $is_print_to_console = $self->{'is_print_to_console'};
366	my $is_save_lines = $self->{'is_save_lines'};
367	my $fid = $self->{'file'};
368
369	foreach my $line (@{$other->{'lines'}})
370	{
371		$self->process_line(@$line);
372	}
373}
374
375
376
377
378=head2 set_forward ($self, $other)
379
380	Set a forwarding target. All future messages are forwarded (copied) to $other.
381	A typical use is to tie $Info to $Lang so that all messages sent to $Info are
382	printed to the console AND written to the log file.
383
384=cut
385sub set_forward ($$)
386{
387	my ($self, $other) = @_;
388
389	# At the moment at most one forward target is allowed.
390	if (defined $other)
391	{
392		$self->{'forward'} = [$other];
393	}
394	else
395	{
396		$self->{'forward'} = [];
397	}
398}
399
400
401
402
403sub increase_indentation ($)
404{
405	my ($self) = @_;
406	$self->{'indentation'} .= "    ";
407}
408
409
410
411
412sub decrease_indentation ($)
413{
414	my ($self) = @_;
415	$self->{'indentation'} = substr($self->{'indentation'}, 4);
416}
417
418
419
420
421####################################################
422# Including header files into the logfile
423####################################################
424
425sub include_header_into_logfile
426{
427	my ($message) = @_;
428
429	$Lang->print("\n");
430	$Lang->print(get_time_string());
431	$Lang->print("######################################################\n");
432	$Lang->print($message."\n");
433	$Lang->print("######################################################\n");
434}
435
436####################################################
437# Including header files into the logfile
438####################################################
439
440sub include_header_into_globallogfile
441{
442	my ($message) = @_;
443
444	$Global->print("\n");
445	$Global->print(get_time_string());
446	$Global->print("######################################################\n");
447	$Global->print($message."\n");
448	$Global->print("######################################################\n");
449}
450
451####################################################
452# Write timestamp into log file
453####################################################
454
455sub include_timestamp_into_logfile
456{
457	Die "deprecated";
458	my ($message) = @_;
459
460	my $infoline;
461	my $timestring = get_time_string();
462	$Lang->printf("%s\t%s", $message, $timestring);
463}
464
465####################################################
466# Writing all variables content into the log file
467####################################################
468
469sub log_hashref
470{
471	my ($hashref) = @_;
472
473	$Global->print("\n");
474	$Global->print("Logging variable settings:\n");
475
476	my $itemkey;
477
478	foreach $itemkey ( keys %{$hashref} )
479	{
480		my $line = "";
481		my $itemvalue = "";
482		if ( $hashref->{$itemkey} ) { $itemvalue = $hashref->{$itemkey}; }
483		$Global->printf("%s=%s\n", $itemkey, $itemvalue);
484	}
485
486	$Global->print("\n");
487}
488
489#########################################################
490# Including global logging info into global log array
491#########################################################
492
493sub globallog
494{
495	my ($message) = @_;
496
497	my $infoline;
498
499	$Global->print("\n");
500	$Global->print(get_time_string());
501	$Global->print("################################################################\n");
502	$Global->print($message."\n");
503	$Global->print("################################################################\n");
504}
505
506###############################################################
507# For each product (new language) a new log file is created.
508# Therefore the global logging has to be saved in this file.
509###############################################################
510
511sub copy_globalinfo_into_logfile
512{
513	for ( my $i = 0; $i <= $#installer::globals::globallogfileinfo; $i++ )
514	{
515		push(@installer::globals::logfileinfo, $installer::globals::globallogfileinfo[$i]);
516	}
517}
518
519###############################################################
520# For each product (new language) a new log file is created.
521# Therefore the global logging has to be saved in this file.
522###############################################################
523
524sub debuginfo
525{
526	my ( $message ) = @_;
527
528	$message = $message . "\n";
529	push(@installer::globals::functioncalls, $message);
530}
531
532###############################################################
533# Saving the debug information.
534###############################################################
535
536sub savedebug
537{
538	my ( $outputdir ) = @_;
539
540	installer::files::save_file($outputdir . $installer::globals::debugfilename, \@installer::globals::functioncalls);
541	print_message( "... writing debug file " . $outputdir . $installer::globals::debugfilename . "\n" );
542}
543
544###############################################################
545# Starting the time
546###############################################################
547
548sub starttime
549{
550	$installer::globals::starttime = time();
551	$StartTime = [gettimeofday()];
552
553	my $localtime = localtime();
554}
555
556###############################################################
557# Convert time string
558###############################################################
559
560sub convert_timestring
561{
562	my ($secondstring) = @_;
563
564	my $timestring = "";
565
566	if ( $secondstring < 60 )	 # less than a minute
567	{
568		if ( $secondstring < 10 ) { $secondstring = "0" . $secondstring; }
569		$timestring = "00\:$secondstring min\.";
570	}
571	elsif ( $secondstring < 3600 )
572	{
573		my $minutes = $secondstring / 60;
574		my $seconds = $secondstring % 60;
575		if ( $minutes =~ /(\d*)\.\d*/ ) { $minutes = $1; }
576		if ( $minutes < 10 ) { $minutes = "0" . $minutes; }
577		if ( $seconds < 10 ) { $seconds = "0" . $seconds; }
578		$timestring = "$minutes\:$seconds min\.";
579	}
580	else	# more than one hour
581	{
582		my $hours = $secondstring / 3600;
583		my $secondstring = $secondstring % 3600;
584		my $minutes = $secondstring / 60;
585		my $seconds = $secondstring % 60;
586		if ( $hours =~ /(\d*)\.\d*/ ) { $hours = $1; }
587		if ( $minutes =~ /(\d*)\.\d*/ ) { $minutes = $1; }
588		if ( $hours < 10 ) { $hours = "0" . $hours; }
589		if ( $minutes < 10 ) { $minutes = "0" . $minutes; }
590		if ( $seconds < 10 ) { $seconds = "0" . $seconds; }
591		$timestring = "$hours\:$minutes\:$seconds hours";
592	}
593
594	return $timestring;
595}
596
597###############################################################
598# Returning time string for logging
599###############################################################
600
601sub get_time_string
602{
603	my $currenttime = time();
604	$currenttime = $currenttime - $installer::globals::starttime;
605	$currenttime = convert_timestring($currenttime);
606	$currenttime = localtime() . " \(" . $currenttime . "\)\n";
607	return $currenttime;
608}
609
610###############################################################
611# Returning the age of a file (in seconds)
612###############################################################
613
614sub get_file_age
615{
616	my ( $filename ) = @_;
617
618	my $filetime = (stat($filename))[9];
619	my $timediff = time() - $filetime;
620	return $timediff;
621}
622
623###############################################################
624# Stopping the time
625###############################################################
626
627sub stoptime
628{
629	my $localtime = localtime();
630	$Info->printf("stopping log at %s\n", $localtime);
631}
632
633###############################################################
634# Set date string, format: yymmdd
635###############################################################
636
637sub set_installation_date
638{
639	my $datestring = "";
640
641	my @timearray = localtime(time);
642
643	my $day = $timearray[3];
644	my $month = $timearray[4] + 1;
645	my $year = $timearray[5] - 100;
646
647	if ( $year < 10 ) { $year = "0" . $year; }
648	if ( $month < 10 ) { $month = "0" . $month; }
649	if ( $day < 10 ) { $day = "0" . $day; }
650
651	$datestring = $year . $month . $day;
652
653	return $datestring;
654}
655
656###############################################################
657# Console output: messages
658###############################################################
659
660sub print_message
661{
662	Die "print_message is deprecated";
663
664	my $message = shift;
665	chomp $message;
666	my $force = shift || 0;
667	print "$message\n" if ( $force || ! $installer::globals::quiet );
668	return;
669}
670
671sub print_message_without_newline
672{
673	my $message = shift;
674	chomp $message;
675	print "$message" if ( ! $installer::globals::quiet );
676	return;
677}
678
679###############################################################
680# Console output: warnings
681###############################################################
682
683sub print_warning
684{
685	my $message = shift;
686	chomp $message;
687	print STDERR "WARNING: $message";
688	return;
689}
690
691###############################################################
692# Console output: errors
693###############################################################
694
695sub print_error
696{
697	my $message = shift;
698	chomp $message;
699
700	PrintError($message);
701
702	print STDERR "\n";
703	print STDERR "**************************************************\n";
704	print STDERR "ERROR: $message";
705	print STDERR "\n";
706	print STDERR "**************************************************\n";
707	return;
708}
709
710
711
712
713sub PrintError ($@)
714{
715	my ($format, @arguments) = @_;
716
717	$Info->printf("Error: ".$format, @arguments);
718}
719
720
721
722
723=head2 PrintStackTrace()
724	This is for debugging the print and printf methods of the logger class and their use.
725	Therefore we use the Perl print/printf directly and not the logger methods to avoid loops in case of errors.
726=cut
727sub PrintStackTrace ()
728{
729	print "Stack Trace:\n";
730	my $i = 1;
731	while ((my @call_details = (caller($i++))))
732	{
733		printf("%s:%s in function %s\n", $call_details[1], $call_details[2], $call_details[3]);
734	}
735}
736
737
738sub Die ($)
739{
740	my ($message) = @_;
741	PrintStackTrace();
742	die $message;
743}
744
7451;
746