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