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