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