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