1
2
3
4
5
6
7
8
9
10
if ( $@ )
{
if ( $CurrentObject && $CurrentObject ne $Package )
{
$Self -> _DieWithError( Error => "Fehler bei der Initialisierung des Unter - Moduls $Package im Modul $CurrentObject" );
} else {
$Self -> _DieWithError( Error => "Fehler bei der Initialisierung des Moduls $Package" );
}
}
1
2
3
4
5
6
7
8
9
10
11
12
13
sub _DieWithError {
my ( $Self, %Parameter ) = @_;
if ( $Self -> { Objects } -> { 'Kernel::System::Log' } )
{
$Self -> { Objects } -> { 'Kernel::System::Log' } -> Log( Priority => 'Error' ,
Message => $Parameter{ Error } );
}
Carp::croak $Parameter{ Error };
}
1
2
3
4
5
if( $Self -> { Debug } == 1 )
{
$Kernel::OM -> Get( 'Kernel::System::Falsch' ) -> start( Priority => 'notice' ,
Message => "Test" );
}
1
2
3
4
5
6
7
8
9
10
11
12
Fehler - Details :
Stufe : error
Meldung : Fehler bei der Initialisierung des Moduls Kernel::System::Falsch
Identifier : ?LogPrefix?-10
Sub - Routine : Kernel::System::ObjectManager::_DieWithError
Zeile : 205
ERROR : ?LogPrefix?-10 PERL : 5.30.0 OS : MSWin32 Time : Fri May 31 20:06:53 2019
Fehler - Meldung : Fehler bei der Initialisierung des Moduls Kernel::System::Falsch
Fehler bei der Initialisierung des Moduls Kernel::System::Falsch at C:\Scripts\Aktuell/Kernel/System/InterfaceInstaller.pm line 27.
1
2
Fri May 31 20:06:53 2019 : Error [ Error ][ Kernel::System::ObjectManager::_DieWithError ][ Line:205 ] : Fehler bei der Initialisierung des Moduls
Kernel::System::Falsch
1
2
3
4
5
6
7
8
9
10
11
12
13
sub _DieWithError {
my ( $Self, %Parameter ) = @_;
if ( $Self -> { Objects } -> { 'Kernel::System::Log' } )
{
$Self -> { Objects } -> { 'Kernel::System::Log' } -> Log( Priority => 'Error' ,
Message => $Parameter{ Error } );
}
Carp::croak $Parameter{ Error };
}
Carp::croak $Parameter{ Error };
our @ObjectDependencies = ( );
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Fehler - Details :
Stufe : error
Meldung : Fehler bei der Initialisierung des Moduls Kernel::System::Lo
Identifier : ?LogPrefix?-10
Sub - Routine : Kernel::System::ObjectManager::_DieWithError
Zeile : 205
ERROR : ?LogPrefix?-10 PERL : 5.30.0 OS : MSWin32 Time : Fri May 31 20:17:06 2019
Fehler - Meldung : Fehler bei der Initialisierung des Moduls Kernel::System::Lo
Verarbeitung des Pakets ...
Pruefung der Object - Dependencies ...
Prio : error
Prio - Num : 16
Message : Fehler : Fehler bei der Erkennung der Object - Dependencies fuer Kernel::System::Lo
Caller : 0
Modul : Kernel::System::ObjectManager | Datei : C:\Scripts\Aktuell/Kernel/System/ObjectManager.pm | Zeile : 205 | Sub - Routine : Kernel::System::Log::Log
Modul : Kernel::System::ObjectManager | Datei : C:\Scripts\Aktuell/Kernel/System/ObjectManager.pm | Zeile : 136 | Sub - Routine : Kernel::System::ObjectManager::_DieWithError
Lade Sys - Log Parameter
Lade Parameter $_[ 0 ] : Kernel::System::ObjectManager=HASH(0x6ba6e8)
Lade Parameter $_[ 1 ] : Kernel::Config
Rueckgabe des Objekts ...
Fehler - Details :
Stufe : error
Meldung : Fehler : Fehler bei der Erkennung der Object - Dependencies fuer Kernel::System::Lo
Identifier : ?LogPrefix?-10
Sub - Routine : Kernel::System::ObjectManager::_DieWithError
Zeile : 205
ERROR : ?LogPrefix?-10 PERL : 5.30.0 OS : MSWin32 Time : Fri May 31 20:17:06 2019
Fehler - Meldung : Fehler : Fehler bei der Erkennung der Object - Dependencies fuer Kernel::System::Lo
Zuweisung der Object - Dependencies ...
Abschliessende Erstellung des Objekts ...
------------------------------------------------------------------------------------------------------------
Can't locate object method "new" via package "Kernel::System::Lo" at C:\Scripts\Aktuell/Kernel/System/ObjectManager.pm line 172.
Carp::croak $Parameter{ Error };
Carp::carp $Parameter{ Error };
Carp::croak $Parameter{ Error };
1
2
3
4
5
6
7
8
9
10
if ( $@ )
{
print "Aktuelles Objekt : $CurrentObject" , "\n";
if ( $CurrentObject && $CurrentObject ne $Package )
{
[color=red]$Self -> _DieWithError( Error => "Fehler bei der Initialisierung des Unter - Moduls $Package im Modul $CurrentObject" );[/color]
} else { $Self -> _DieWithError( Error => "Fehler bei der Initialisierung des Moduls $Package" ); }
}
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
my ( $Self, %Parameter ) = @_;
# Übergabe des Caller - Aufrufs
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 );
print "Modul : $Package1 | Datei : $Filename1 | Zeile : $Line1 | Sub - Routine : $Subroutine1" , "\n";
print "Modul : $Package2 | Datei : $Filename2 | Zeile : $Line2 | Sub - Routine : $Subroutine2" , "\n";
$Subroutine2 ||= $0;
# Log Backend
$Self -> { Backend } -> Log( Priority => $Priority ,
Message => $Message ,
LogPrefix => $Self -> { LogPrefix } ,
Module => $Subroutine2 ,
Line => $Line1 ,
);
1
2
3
4
5
6
Prio : error
Prio - Num : 16
Message : Fehler bei der Initialisierung des Moduls Kernel::Modules::Mist
Caller : 0
Modul : Kernel::System::ObjectManager | Datei : .../ObjectManager.pm | Zeile : 225 | Sub - Routine : Kernel::System::Log::Log
Modul : Kernel::System::ObjectManager | Datei : .../ObjectManager.pm | Zeile : 139 | Sub - Routine : Kernel::System::ObjectManager::_DieWithError
my $Zusaetzliches_Loader = $Kernel::OM -> Get( 'Kernel::Modules::Mist' );
1
2
3
4
5
6
7
8
9
10
11
12
13
sub _DieWithError {
my ( $Self, %Parameter ) = @_;
if ( $Self -> { Objects } -> { 'Kernel::System::Log' } )
{
$Self -> { Objects } -> { 'Kernel::System::Log' } -> Log( Priority => 'Error' ,
Message => $Parameter{ Error } );
}
# Carp::croak $Parameter{ Error };
}
1
2
$Kernel::OM -> Get( 'Kernel::System::Log' ) -> Log( Priority => 'notice' ,
Message => "Test" );
1
2
3
4
5
Stufe : notice
Meldung : Test
Identifier : ?LogPrefix?-10
Sub - Routine : Kernel::System::InterfaceInstaller::new
Zeile : 27
1 2 3 4 5 6 7
package Foo; # $CurrentObject = 'Foo' package Bar; # da gibt's nun mehrere Schreibweisen... use parent -norequire, 'Foo'; # use base 'Foo'; # our @ISA = ('Foo');
2019-05-31T20:36:39 YAPDAußerdem noch :
Wenn ich die Log - Ausgabe bemühe, werden die Subroutinen übergeben.
Leider die Falschen. Das ist der relevante Teil des Log() Aufrufs :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
sub new {
my ( $Type, %Parameter ) = @_;
my $Self = { };
bless( $Self , $Type );
$Self -> { Debug } = $Parameter{ Debug } || 0;
if( $Self -> { Debug } == 1 )
{
$Kernel::OM -> Get( 'Kernel::System::Low' ) -> Ausfuehrung( Priority => 'notice' ,
Message => "Test" );
}
my $Zusaetzliches_Loader = $Kernel::OM -> Get( 'Kernel::Modules::Mist' );
return $Self;
}
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
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;
}
}
1
2
my ( $Package1 , $Filename1 , $Line1 , $Subroutine1 ) = caller( $Caller + 0 );
my ( $Package2 , $Filename2 , $Line2 , $Subroutine2 ) = caller( $Caller + 1 );
my ( $Package2 , $Filename2 , $Line2 , $Subroutine2 ) = caller( $Caller + 4 );
1
2
3
4
5
6
7
Fehler - Details :
Stufe : error
Meldung : Fehler bei der Initialisierung des Moduls Kernel::System::Lo
Identifier : ?LogPrefix?-10
Sub - Routine : Kernel::System::InterfaceInstaller::new
Zeile : 227
1
2
3
4
5
6
7
8
9
10
Prio : notice
Prio - Num : 8
Message : Test
Caller : 0
Modul : Kernel::System::InterfaceInstaller | Datei : C:\Scripts\Aktuell/Kernel/System/InterfaceInstaller.pm | Zeile : 27 | Sub - Routine : Kernel::System::Log::Log
Use of uninitialized value $Package2 in concatenation (.) or string at C:\Scripts\Aktuell/Kernel/System/Log.pm line 99.
Use of uninitialized value $Filename2 in concatenation (.) or string at C:\Scripts\Aktuell/Kernel/System/Log.pm line 99.
Use of uninitialized value $Line2 in concatenation (.) or string at C:\Scripts\Aktuell/Kernel/System/Log.pm line 99.
Use of uninitialized value $Subroutine2 in concatenation (.) or string at C:\Scripts\Aktuell/Kernel/System/Log.pm line 99.
Modul : | Datei : | Zeile : | Sub - Routine :
1
2
3
for ( my $Count = 0; $Count < 30; $Count++ ) {
my ( $Package1, $Filename1, $Line1, $Subroutine1 ) = caller( $Caller + $Count );
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
package Kernel::System::ObjectManager;
use strict;
use warnings;
use Carp qw( carp confess );
# use Kernel::Config;
# use Kernel::System::Log;
our $CurrentObject;
# -------------------------------------------------------------------------------------------------------------------------------
sub new {
# Übergabe der Parameter aus Aufruf
my ( $Typ , %Parameter ) = @_;
# Asssozierung eines Hashes zu einer Klasse
my $Self = bless { }, $Typ;
# Entfernung des Debug - Parameters
$Self -> { Debug } = delete $Parameter{ Debug };
# Sortierung der Parameter des Hashes & Zuordnung über Befehl "$Self -> { Param } -> { $Parameter }"
# ( Nur bei Übergabe eines Parameters über NEW - Methode des Object - Managers )
for my $Schluessel ( sort keys %Parameter )
{
$Self -> { Parameter } -> { $Schluessel } = $Parameter{ $Schluessel };
}
# Rückgabe des OM - Objektes
return $Self;
}
# -------------------------------------------------------------------------------------------------------------------------------
sub Get {
# No param unpacking for increased performance
if ( $_[ 1 ] && $_[ 0 ] -> { Objects } -> { $_[ 1 ] } )
{
return $_[ 0 ] -> { Objects } -> { $_[ 1 ] };
}
if ( !$_[ 1 ] )
{
$_[ 0 ] -> _DieWithError( Error => "Fehler : Fehlender Parameter ( Objekt - Bez. )" );
}
local $CurrentObject = $_[ 1 ] if !$CurrentObject;
return $_[ 0 ] -> _ObjectBuild( Package => $_[ 1 ] );
}
# -------------------------------------------------------------------------------------------------------------------------------
sub _ObjectBuild {
my ( $Self, %Parameter ) = @_;
my $Package = $Parameter{ Package };
my $Datei_Bezeichnung = $Package;
$Datei_Bezeichnung =~ s{::}{/}g;
$Datei_Bezeichnung .= '.pm';
eval { require $Datei_Bezeichnung; };
if ( $@ )
{
if ( $CurrentObject && $CurrentObject ne $Package )
{
$Self -> _DieWithError( Error => "Fehler bei der Initialisierung des Unter - Moduls $Package im Modul $CurrentObject" );
} else {
$Self -> _DieWithError( Error => "Fehler bei der Initialisierung des Moduls $Package" );
}
}
}
# -------------------------------------------------------------------------------------------------------------------------------
sub _DieWithError {
my ( $Self, %Parameter ) = @_;
print $Parameter{ Error };
}
# -------------------------------------------------------------------------------------------------------------------------------
1;
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
#!/usr/bin/perl
package Installer;
use strict;
use warnings;
use Kernel::System::InterfaceInstaller;
use Kernel::System::ObjectManager;
local $Kernel::OM = Kernel::System::ObjectManager -> new( 'test' => "Test" ); # Erstellung des Kernels für Objekt - Manager
# --------------------------------------------------------------------------------------------------------------------------------------------------------
Initialisierung( );
# --------------------------------------------------------------------------------------------------------------------------------------------------------
sub Initialisierung {
my $Debug = 1;
my $Test = $Kernel::OM -> Get( 'Kernel::Modules::test' );
}
1
2
3
4
5
6
7
8
9
10
if ( $@ )
{
if ( $CurrentObject && $CurrentObject ne $Package )
{
$Self -> _DieWithError( Error => "Fehler bei der Initialisierung des Unter - Moduls $Package im Modul $CurrentObject" );
} else {
$Self -> _DieWithError( Error => "Fehler bei der Initialisierung des Moduls $Package" );
}
}
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
#!/usr/bin/perl
package Kernel::Modules::test;
use strict;
use warnings;
our @ObjectDependencies = ( 'Kernel::Config' );
# --------------------------------------------------------------------------------------------------------------------------------------------------------
sub new {
my ( $Type, %Parameter ) = @_;
# Asssozierung eines Hashes zu einer Klasse
my $Self = { };
bless( $Self, $Type );
my $Test = $Kernel::OM -> Get( 'Kernel::Modules::FalschesModul' );
}
# --------------------------------------------------------------------------------------------------------------------------------------------------------
sub Ausfuehrung {
print "Ausfuehrung !" , "\n";
}
# --------------------------------------------------------------------------------------------------------------------------------------------------------
1;
local $CurrentObject = $_[ 1 ] if !$CurrentObject;
QuoteIch möchte nun herausfinden ( Ja immer noch :) ), wann "$CurrentObject && $CurrentObject ne $Package" wahr ist.
2019-06-02T17:02:08 YAPDNa ja, das sieht stellenweise so aus wie "Ärmel hochgekrempelt und drauflosprogrammiert". Immer ein bißchen abseits des Üblichen, was Groß/Kleinschreibung, Leerzeichen und -Zeilen angeht. Das ist persönlicher Stil, nicht unmoralisch, aber bei Code, der länger lebt, zahlt man irgendwann den Preis dafür. Ich bringe mal ein paar Beispiele aus Deinem Code:Was meinst du denn mit "Rustikalem Design" :)
Schlecht, oder nur veraltet ?
2019-06-02T17:02:08 YAPDEine Baumarkt-Reklame sagt dazu: "Respekt, wer's selber macht". Der Objektmanager macht nicht viel. Wenn man vermeiden will, für Dutzende von Klassen beinuhe identische new-Methoden zu schreiben, dann wäre das zeitgemäße Verfahren so etwas wie Moose oder Moo.Ich habe jetzt nur noch den Objekt - Manager :
2019-06-02T17:02:08 YAPDDas würde ich ja so schreiben:Code: (dl )1
2
3
4for my $Schluessel ( sort keys %Parameter )
{
$Self -> { Parameter } -> { $Schluessel } = $Parameter{ $Schluessel };
}
$Self -> { Parameter } = { %Parameter }
2019-06-02T17:02:08 YAPDDas gab's mal als Tipp. In den Achzigern des vorigen Jahrhunderts. Seither sind die Computer ein bisschen flotter geworden und es hat sich die Einsicht durchgesetzt, dass man mehr an Lesbarkeit verliert als an Performance gewinnt.Code (perl): (dl )1 2# No param unpacking for increased performance if ( $_[ 1 ] && $_[ 0 ] -> { Objects } -> { $_[ 1 ] } )
2019-06-02T17:02:08 YAPDDas && verweist doch darauf, dass in dem Paket "test" nochmal den Objekt - Manager aufrufe,
was ich ja mit dem Get Befehl mache. Ist das Paket dann falsch, müsste dann nicht die Meldung :
"Fehler bei der Initialisierung des Unter - Moduls $Package im Modul $CurrentObject"
erscheinen ?
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
sub _ObjectBuild { my ( $Self, %Parameter ) = @_; my $Package = $Parameter{ Package }; my $Datei_Bezeichnung = $Package; $Datei_Bezeichnung =~ s{::}{/}g; $Datei_Bezeichnung .= '.pm'; eval { require $Datei_Bezeichnung; }; if ( $@ ) { if ( $CurrentObject && $CurrentObject ne $Package ) { $Self -> _DieWithError( Error => "Fehler bei der Initialisierung des Unter - Moduls $Package im Modul $CurrentObject" ); } else { $Self -> _DieWithError( Error => "Fehler bei der Initialisierung des Moduls $Package" ); } } else { return $Package->new; } }