#semaphores my $writelog = Thread::Semaphore->new(); #sequential log writing #LIBS: use common; open my $LOGFH ,">", $files{log}{file}; #from common #disable write buffer my $stdout = select($LOGFH); $| = 1; select($stdout); require other; other->import(\$LOGFH, \$writelog); #FH, SEM logLine("TEST"); sub logLine { my ($text) =@_; chomp($text); my ($package, $filename, $line) = caller; my $FunctionName = (caller(1))[3]; if ($FunctionName =~ m/::(.+)/) { $FunctionName = $1; } my $time = localtime time; #do sprintf left align truncate until sprintf supports if ($files{log}{fileNameLen} =~ m/-\d+\.(\d+)/) { $filename = substr($filename, 0, $1); } if ($files{log}{funNameLen} =~ m/-\d+\.(\d+)/) { $FunctionName = substr($FunctionName, 0, $1); } my $header = sprintf("%*s, %*s, %*s, %*s:", $files{log}{timeLen}, $time, $files{log}{fileNameLen}, $filename, $files{log}{funNameLen}, $FunctionName, $files{log}{lineNumLen}, $line); print "$header $text\n"; #only for testing if (defined $writelog and defined $LOGFH) { $writelog->down(); print $LOGFH "$header $text\n"; $writelog->up(); } } #### package other; use Exporter; our @ISA = qw(Exporter); our @EXPORT = qw($sourcepath %files); our $sourcepath = dirname(Cwd::abs_path(__FILE__)); #Where am I located at? unless ($sourcepath =~ m/\\$/) { $sourcepath .= "\\"; } our %files = ( log => { file => $sourcepath."file.log", fileNameLen => -22.22, funNameLen => -21.21, lineNumLen => 5, timeLen => 24.24, }, ); #### package other.pm use common; sub import { shift; $LOGFH = ${$_[0]}; $writelog = ${$_[1]}; } logLine("TEST"); sub logLine { my ($text) =@_; chomp($text); my ($package, $filename, $line) = caller; my $FunctionName = (caller(1))[3]; if ($FunctionName =~ m/::(.+)/) { $FunctionName = $1; } my $time = localtime time; #do sprintf left align truncate until sprintf supports if ($files{log}{fileNameLen} =~ m/-\d+\.(\d+)/) { $filename = substr($filename, 0, $1); } if ($files{log}{funNameLen} =~ m/-\d+\.(\d+)/) { $FunctionName = substr($FunctionName, 0, $1); } my $header = sprintf("%*s, %*s, %*s, %*s:", $files{log}{timeLen}, $time, $files{log}{fileNameLen}, $filename, $files{log}{funNameLen}, $FunctionName, $files{log}{lineNumLen}, $line); print "$header $text\n"; #only for testing if (defined $writelog and defined $LOGFH) { $writelog->down(); print $LOGFH "$header $text\n"; $writelog->up(); } } #### sub debugLogFunctionNameLineNum { #debugLogFunctionNameLineNum((caller(0))[2],(caller(1))[3], @_); my ($callerline, $caller, @input) = @_; my $input_msg = ""; for (my $i = 0; $i < @input; $i++) { unless (defined $input[$i]) { $input[$i] = "undef"; } $input_msg .= "$i=>$input[$i]"; if ($i < $#input) { $input_msg .= ", "; } } my ($package, $filename, $line) = caller; unless ($caller) { $caller = $filename; } if ($caller =~ m/eval/) { $caller = "Tk call"; $callerline = "Unknown"; } else { if ($callerline =~ m/::(.+)/) { $callerline = $1; } } my $FunctionName = (caller(1))[3]; if ($FunctionName =~ m/::(.+)/) { $FunctionName = $1; } my $time = localtime time; unless ($FunctionName) { $FunctionName = "MAIN"; } #do sprintf left align truncate until sprintf supports if ($files{log}{fileNameLen} =~ m/-\d+\.(\d+)/) { $filename = substr($filename, 0, $1); } if ($files{log}{funNameLen} =~ m/-\d+\.(\d+)/) { $FunctionName = substr($FunctionName, 0, $1); } my $header = sprintf("%*s, %*s, %*s, %*s:", $files{log}{timeLen}, $time, $files{log}{fileNameLen}, $filename, $files{log}{funNameLen}, $FunctionName, $files{log}{lineNumLen}, $line); print "$header Called from [$caller] at [$callerline] with options [$input_msg]\n"; #only for testing if (defined $writelog and defined $LOGFH) { $writelog->down(); print $LOGFH "$header Called from [$caller] at [$callerline] with options [$input_msg]\n"; $writelog->up(); } }