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