sub Log { my ( $Self, %Parameter ) = @_; # Festlegung der Prio des Aufrufs my $Priority = lc $Parameter{ Priority } || 'debug'; my $Caller = $Parameter{ Caller } || 0; # Speicherung der Fehler - Details für das Debugging ( Aufruf , Datei , Zeile , Sub - Routine ) my ( $Package1 , $Filename1 , $Line1 , $Subroutine1 ) = caller( $Caller + 0 ); my ( $Package2 , $Filename2 , $Line2 , $Subroutine2 ) = caller( $Caller + 1 ); $Subroutine2 ||= $0; # Log Backend $Self -> { Backend } -> Log( Priority => $Priority , Message => $Message , LogPrefix => $Self -> { LogPrefix } , Module => $Subroutine2 , Line => $Line1 , ); # Nur im Fehler - Fall ( Log - Level : Error ) if ( $Priority =~ /^error/i ) { my $Error = sprintf "ERROR : $Self->{LogPrefix} PERL : %vd OS : $^O Time : " . localtime( ) . "\n\n", $^V; $Error .= "Fehler - Meldung : $Message"; # DEBUG # $Error .= " Traceback ( $$ ) : \n"; COUNT: for ( my $Count = 0; $Count < 30; $Count++ ) { my ( $Package1, $Filename1, $Line1, $Subroutine1 ) = caller( $Caller + $Count ); last COUNT if !$Line1; my ( $Package2, $Filename2, $Line2, $Subroutine2 ) = caller( $Caller + 1 + $Count ); $Subroutine2 ||= $0; my $VersionString = ''; eval { $VersionString = $Package1 -> VERSION || ''; }; if ( $VersionString ) { $VersionString = ' ( v' . $VersionString . ' )'; } # DEBUG # $Error .= " Module : $Subroutine2$VersionString Line : $Line1\n"; last COUNT if !$Line2; } }