# Copyright 1999-2012. Parallels IP Holdings GmbH. All Rights Reserved. package Logging; use strict; use POSIX; use Carp; use File::Basename qw( dirname ); use File::Path qw( mkpath ); use XmlLogger; use HelpFuncs; use IO::Handle; use utf8; use open ':encoding(utf8)'; binmode(STDERR, ':utf8'); use vars qw|$verbosity $xmlLogger|; $verbosity = 5; my %handlerProc; sub setXmlLogging { $xmlLogger = XmlLogger->new(); } sub setVerbosity { $verbosity = shift; } sub getVerbosity { return $verbosity; } sub setOnError { $handlerProc{onerror} = shift; } sub setOnWarning { $handlerProc{onwarning} = shift; } my $outputHandle; my $customHandle; sub getOutputHandle { return $outputHandle; } sub setOutputHandle { $outputHandle = shift; } sub open { my ($dumpLogPath, $customLogPath) = @_; if (defined $dumpLogPath) { open $outputHandle, ">> $dumpLogPath"; $outputHandle->autoflush(1); # disable output buffering } if ($customLogPath) { my $customLogDirPath = dirname($customLogPath); if (-e $customLogDirPath or mkpath($customLogDirPath)) { open $customHandle, ">> $customLogPath"; $customHandle->autoflush(1); # disable output buffering } } } sub close { close $outputHandle if defined $outputHandle; close $customHandle if defined $customHandle; } sub date { return "[".$$."]: ".POSIX::strftime("%T", gmtime(time())); } sub _getMessage { my ($marker, $uuid, $message, $code) = @_; my $msg = date(). " $marker "; $msg .= "$uuid " if defined($uuid); $msg .= $message; if ( defined $code ) { if (( $code eq 'assert') || ($code eq 'fatal')) { #local $Carp::CarpLevel = +1; $msg .= ": \n" . Carp::longmess(); } } $msg .= "\n"; return $msg; } sub _writeMessage { my ($message) = @_; if ($outputHandle) { print $outputHandle ($message); } else { print STDERR ($message); } print $customHandle ($message) if ($customHandle); } sub error { my $uuid = HelpFuncs::generateUuid(); if ( $verbosity > 0 ) { _writeMessage(_getMessage('ERROR',$uuid, @_)); } __addXmlMessage('error',$uuid, @_); $handlerProc{onerror}->( @_ ) if exists $handlerProc{onerror} and ref $handlerProc{onerror} eq 'CODE'; } sub warning { my $uuid = HelpFuncs::generateUuid(); if ( $verbosity > 1) { _writeMessage(_getMessage('WARN',$uuid, @_)); } __addXmlMessage('warning',$uuid, @_); $handlerProc{onwarning}->( @_ ) if exists $handlerProc{onwarning} and ref $handlerProc{onwarning} eq 'CODE'; } sub info { my $uuid = HelpFuncs::generateUuid(); if ( $verbosity > 2) { _writeMessage(_getMessage('INFO',$uuid, @_)); } __addXmlMessage('info',$uuid, @_); $handlerProc{oninfo}->( @_ ) if exists $handlerProc{oninfo} and ref $handlerProc{oninfo} eq 'CODE'; } sub debug { if ( $verbosity > 3) { _writeMessage(_getMessage('DEBUG',undef, @_)); } } sub trace { if ( $verbosity > 4) { _writeMessage(_getMessage('TRACE',undef, @_)); } } sub beginObject { my ( $type, $name, $uuid ) = @_; if( ref($xmlLogger) =~ /XmlLogger/ ) { $xmlLogger->beginObject( $type, $name, $uuid ); } } sub endObject { if( ref($xmlLogger) =~ /XmlLogger/ ) { $xmlLogger->endObject(); } } sub __addXmlMessage { if( ref($xmlLogger) =~ /XmlLogger/ ) { $xmlLogger->addMessage( @_); } } sub serializeXmlLog { my ($filename) = @_; if( ref($xmlLogger) =~ /XmlLogger/ ) { $xmlLogger->serializeToFile( $filename, 1); } } 1;