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
#!/usr/bin/perl use 5.020; #damit Neuerungen ab Perl 5.012 ohne - use feature ... - verwendet werden #lädt auch gleich >>use strict<< mit use strict; use Data::Dumper; use pck_test::childmodul; # Datenuebergabestruktur vorbereiten. # Die Klasse initialisiert auf Standardwerte, so dass man nur die Daten angeben muss, # die andere Werte bekommen sollen my $hsh_runtimeParam = { ScriptParam => { ScriptName => $0 || '???', Version => 'v.01' || '???', Hilfe => { Usage => 'ruf mich mal richtig auf', Message => 'rufe mal nach Mutti' }, }, Runtime => { ApplName => 'TestClass', Caller => $^O =~ /win32/i ? $ENV{USERNAME} : $ENV{USER}, # Username der dieses Script gestartet hat Loglevel => 'höher geht nicht', RootPath => 'ganz oben' || '???', StartTime => 'am Anfang' || '???', }, DBParam => { RegPar => 'test', dbSession => { ApplName => 'testhash', Action => 'insert', runtime => { dbTable => 'INIT_REG' } } } }; # Objektinstanz der Childklasse erzeugen # dabei auch gleich gewuenschte neue Initialwerte uebergeben my $Object1 = childmodul->new($hsh_runtimeParam); $Object1->set_Data( #block => \$Object1->{DBParam}->{dbSession}->{runtime}, block => {test => [ 'DBParam', 'dbSession', 'runtime' ]}, key =>'dbTable', wert =>'INIT_RUN' ); print Dumper $Object1;
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
#/opt/bin/perl use strict; package childmodul; sub new { my ($class,$hsh_scriptParam) = @_; # Hash mit der Übergabestruktur uebernehmen my @caller = caller(0); my $self; $self = { %{$hsh_scriptParam} }; # Die Funktion bless() verknüpft ein Objekt mit einem Packagenamen (Binden eines Objekts an eine Klasse) bless $self, $class; $self; } sub set_Data() { use Data::Dumper; my $self = shift; # eigene Klassenreferenz holen my $args = {@_}; # Parameterliste in Hash umwandeln my $wert; if (ref($args->{block}) eq 'HASH') { no strict 'refs'; print Dumper $self->{$args->{block}}; print Dumper $args->{block}->{test}; for (@{$args->{block}->{test}}) { $wert .= '{'.$_.'}'."->"; } $wert .= '{'.$args->{key}.'}'; print "wert= $wert\n"; my $wert1 = \$wert; print "wert1= $$wert1\n"; print "wert1= $self->{${$wert1}}\n"; if ( exists($self->{$wert}) ) { # Key existiert --> Wert setzen $wert.'{'.$args->{key}.'}' = $args->{wert}; return 0; } else { # Fehler zurückgeben: Key existiert nicht in der Datenstruktur return -1; } } } 1;
Quotedas Problem ist, dass ich die übergebene Struktur
DBParam -> dbSession -> runtime nicht zur Überprüfung mit $self-> verbinden kann
2015-05-19T15:34:50 mtbf40Ich hoffe das ist verständlich??!!
QuoteGlobal symbol "$hsh_RegPar" requires explicit package name
1
2
3
4
5
6
7
8
9
10
11
12
$VAR1 = bless( {
'DBParam' => {
'RegPar' => '$hsh_RegPar',
'dbSession' => {
'Action' => 'insert',
'ApplName' => 'TestClass',
'runtime' => {
'dbTable' => 'INIT_RUN'
}
}
},
...
1 2 3 4
for (@{$args->{block}->{test}}) { $wert .= '{'.$_.'}'."->"; } $wert .= '{'.$args->{key}.'}';
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
#!/usr/bin/perl use warnings; use strict; use Data::Dumper; package childmodul; sub new { my ($class, $hsh_scriptParam) = @_; my @caller = caller(0); my $self; $self = { %{$hsh_scriptParam} }; bless $self, $class; $self; } sub set_Data() { use Data::Dumper; my $self = shift; # eigene Klassenreferenz holen my $args = {@_}; # Parameterliste in Hash umwandeln my $wert; if (ref($args->{block}) eq 'HASH') { no strict 'refs'; print Dumper $self->{$args->{block}}; print Dumper $args->{block}->{test}; for (@{$args->{block}->{test}}) { $wert .= '{'.$_.'}'."->"; } $wert .= '{'.$args->{key}.'}'; print "wert= $wert\n"; my $wert1 = \$wert; print "wert1= $$wert1\n"; print "wert1= $self->{${$wert1}}\n"; if ( exists($self->{$wert}) ) { # Key existiert --> Wert setzen $wert.'{'.$args->{key}.'}' = $args->{wert}; return 0; } else { return -1; } } } package main; my $hsh_runtimeParam = { ScriptParam => {ScriptName => $0 || '???', Version => 'v.01' || '???', Hilfe => {Usage => 'ruf mich mal richtig auf', Message => 'rufe mal nach Mutti'}, }, Runtime => {ApplName => 'TestClass', Caller => $^O =~ /win32/i ? $ENV{USERNAME} : $ENV{USER}, Loglevel => 'höher geht nicht', RootPath => 'ganz oben' || '???', StartTime => 'am Anfang' || '???', }, DBParam => {RegPar => 'test', dbSession => {ApplName => 'testhash', Action => 'insert', runtime => {dbTable => 'INIT_REG'} } } }; my $Object1 = childmodul->new($hsh_runtimeParam); $Object1->set_Data(block => {test => [ 'DBParam', 'dbSession', 'runtime' ]}, key => 'dbTable', wert =>'INIT_RUN');
2015-05-20T15:33:50 mtbf40das ich über, die Methode set_Data, INIT_REG nicht mit INIT_RUN ersetzten kann!
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
#!/usr/bin/perl use warnings; use strict; package childmodul; sub new { my $classname = shift; my $self = {hsh_scriptParam => shift}; return bless($self, $classname); } sub set_Data { my $self = shift; my $args = {@_}; my $i; my %h = %{$self->{hsh_scriptParam}}; print $h{DBParam}->{dbSession}->{runtime}->{dbTable}; print "\n"; my %h2 = %{$args}; print $h2{wert} . "\n"; $h{DBParam}->{dbSession}->{runtime}->{dbTable} = $h2{wert}; $self->showResult(); } sub showResult { my $self = shift; my %h = %{$self->{hsh_scriptParam}}; print "Result: "; print $h{DBParam}->{dbSession}->{runtime}->{dbTable}; print "\n"; } package main; my $hsh_runtimeParam = { ScriptParam => {ScriptName => $0 || '???', Version => 'v.01' || '???', Hilfe => {Usage => 'ruf mich mal richtig auf', Message => 'rufe mal nach Mutti'}, }, Runtime => {ApplName => 'TestClass', Caller => $^O =~ /win32/i ? $ENV{USERNAME} : $ENV{USER}, Loglevel => 'höher geht nicht', RootPath => 'ganz oben' || '???', StartTime => 'am Anfang' || '???', }, DBParam => {RegPar => 'test', dbSession => {ApplName => 'testhash', Action => 'insert', runtime => {dbTable => 'INIT_REG'} } } }; my $Object1 = childmodul->new($hsh_runtimeParam); $Object1->set_Data(block => {test => [ 'DBParam', 'dbSession', 'runtime' ]}, key => 'dbTable', wert =>'INIT_RUN');
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
#!/usr/bin/perl use warnings; use strict; package childmodul; sub new { my $classname = shift; my $self = {hsh_scriptParam => shift}; return bless($self, $classname); } sub set_Data { my $self = shift; my $args = {@_}; my @vals = @{$args->{block}->{test}}; $self->{hsh_scriptParam}-> {$vals[0]}-> {$vals[1]}-> {$vals[2]}-> {$args->{key}} = $args->{wert}; print "Result: "; print $self->{hsh_scriptParam}-> {$vals[0]}-> {$vals[1]}-> {$vals[2]}-> {$args->{key}}; print "\n"; } package main; my $hsh_runtimeParam = { ScriptParam => {ScriptName => $0 || '???', Version => 'v.01' || '???', Hilfe => {Usage => 'ruf mich mal richtig auf', Message => 'rufe mal nach Mutti'}, }, Runtime => {ApplName => 'TestClass', Caller => $^O =~ /win32/i ? $ENV{USERNAME} : $ENV{USER}, Loglevel => 'höher geht nicht', RootPath => 'ganz oben' || '???', StartTime => 'am Anfang' || '???', }, DBParam => {RegPar => 'test', dbSession => {ApplName => 'testhash', Action => 'insert', runtime => {dbTable => 'INIT_REG'} } } }; my $Object1 = childmodul->new($hsh_runtimeParam); $Object1->set_Data(block => {test => [ 'DBParam', 'dbSession', 'runtime' ]}, key => 'dbTable', wert =>'INIT_RUN');
1 2 3
$Object1->set_Data(block => {test => [ 'DBParam', 'dbSession' ]}, key => 'Action', wert => 'update');
1 2 3
$Object1->set_Data(block => {test => [ 'Runtime' ]}, key => 'Loglevel', wert => 'debug');
$self->{variable} = wert
1 2 3 4 5 6 7
my $h = {k1 => { k2 => { k3 => 'wert' }}}; @keys = qw(k1 k2 k3); $hxx = $h; $hxx = $hxx->{$_} for @keys[0..$#keys-1]; $hxx->{$keys[-1]} = 'neuerWert'; use Data::Dumper; print Dumper $h;
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
#!/usr/bin/perl use warnings; use strict; package childmodul; sub new { my ($classname,$hsh_scriptParam) = @_; my $self = {%{$hsh_scriptParam}}; return bless($self, $classname); } sub set_Data { my( $self, $val, @keys ) = @_ ; # das Objekt als Referenz übergeben # man könnte auch das Objekt selber mit bless gleich referenzieren # das macht aber die weitere Arbeit mit dem Objekt schwierig, da es # dann immer derefernziert werden müsste my $ref_ref = \$self; unless ( @keys ) { warn "deep_hash_assign: no keys" ; return ; } foreach my $key ( @keys ) { my $ref = ${$ref_ref} ; # this is the autoviv step unless ( defined( $ref ) ) { $ref = { $key => undef } ; ${$ref_ref} = $ref ; } # this checks we have a valid hash ref as a current value #**** das funktioniert bei einer Methode nicht??? **** #unless ( ref $ref eq 'HASH' and exists( $ref->{ $key } ) ) { # # warn "deep_hash_assign: not a hash ref at $key in @keys" ; # return ; #} # this points to the next level down the hash tree $ref_ref = \$ref->{ $key } ; } ${$ref_ref} = $val; } package main; my $hsh_runtimeParam = { ScriptParam => {ScriptName => $0 || '???', Version => 'v.01' || '???', Hilfe => {Usage => 'ruf mich mal richtig auf', Message => 'rufe mal nach Mutti' }, }, Runtime => {ApplName => 'TestClass', Caller => $^O =~ /win32/i ? $ENV{USERNAME} : $ENV{USER}, Loglevel => 'höher geht nicht', RootPath => 'ganz oben' || '???', StartTime => 'am Anfang' || '???', }, DBParam => {RegPar => 'test', dbSession => {ApplName => 'testhash', Action => 'insert', runtime => {dbTable => 'INIT_REG'}} } }; my $Object1 = childmodul->new($hsh_runtimeParam); $Object1->set_Data('INIT_RUN', qw( DBParam dbSession runtime dbTable )); print $Object1->{DBParam}->{dbSession}->{runtime}->{dbTable} . "\n"; $Object1->set_Data('update', qw( DBParam dbSession Action )); print $Object1->{DBParam}->{dbSession}->{Action} . "\n"; $Object1->set_Data('debug', qw( Runtime Loglevel )); print $Object1->{Runtime}->{Loglevel} . "\n";
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
#!/usr/bin/perl use warnings; use strict; package childmodul; sub new { my $classname = shift; my $self = {}; $self->{ScriptParam}->{ScriptName} = $0; $self->{ScriptParam}->{Version} = "v.01"; $self->{ScriptParam}->{Hilfe}->{Usage} = "ruf mich mal richtig auf"; $self->{ScriptParam}->{Hilfe}->{Message} = 'rufe mal nach Mutti'; $self->{Runtime}->{ApplName} = "TestClass"; $self->{Runtime}->{Caller} = $^O =~ /win32/i ? $ENV{USERNAME} : $ENV{USER}; $self->{Runtime}->{Loglevel} = "höher geht nicht"; $self->{Runtime}->{RootPath} = "ganz oben"; $self->{Runtime}->{StartTime} = "am Anfang"; $self->{DBParam}->{RegPar} = "test"; $self->{DBParam}->{dbSession}->{ApplName} = "testhash"; $self->{DBParam}->{dbSession}->{Action} = "insert"; $self->{DBParam}->{dbSession}->{runtime}->{dbTable} = "INIT_REG"; return bless($self, $classname); } sub set_Data { my $self = shift; my $val = shift; my @locations = @_; my $str = "\$self"; my $i; foreach $i (@locations) { $str .= "->{$i}"; } $str .= " = \"$val\";"; eval($str) or die; } package main; my $Object1 = childmodul->new(); $Object1->set_Data('INIT_RUN', qw( DBParam dbSession runtime dbTable )); print $Object1->{DBParam}->{dbSession}->{runtime}->{dbTable} . "\n"; $Object1->set_Data('update', qw( DBParam dbSession Action )); print $Object1->{DBParam}->{dbSession}->{Action} . "\n"; $Object1->set_Data('debug', qw( Runtime Loglevel )); print $Object1->{Runtime}->{Loglevel} . "\n";
1
2
# Zeile am Ende eingefügt
$Object1->set_Data( 'evil', "Runtime}; print qq{Hallo Welt\n}; \$self->{bla" );
1
2
3
4
5
INIT_RUN
update
debug
Useless use of hash element in void context at (eval 4) line 1.
Hallo Welt
$self->{DBParam_dbSession_runtime_dbTable} = "INIT_REG";
$self->{$str} = $val;
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
#!/usr/bin/perl use warnings; use strict; package childmodul; sub new { my $classname = shift; my $self = {}; $self->{ScriptParam}->{ScriptName} = $0; $self->{ScriptParam}->{Version} = "v.01"; $self->{ScriptParam}->{Hilfe}->{Usage} = "ruf mich mal richtig auf"; $self->{ScriptParam}->{Hilfe}->{Message} = 'rufe mal nach Mutti'; $self->{Runtime}->{ApplName} = "TestClass"; $self->{Runtime}->{Caller} = $^O =~ /win32/i ? $ENV{USERNAME} : $ENV{USER}; $self->{Runtime}->{Loglevel} = "höher geht nicht"; $self->{Runtime}->{RootPath} = "ganz oben"; $self->{Runtime}->{StartTime} = "am Anfang"; $self->{DBParam}->{RegPar} = "test"; $self->{DBParam}->{dbSession}->{ApplName} = "testhash"; $self->{DBParam}->{dbSession}->{Action} = "insert"; $self->{DBParam}->{dbSession}->{runtime}->{dbTable} = "INIT_REG"; return bless($self, $classname); } sub set_Data { my $self = shift; my $val = shift; my @locations = @_; # save last key my $last_location = pop @locations; # helper ref for each level inside HoHoH... my $ref = $self; for my $location ( @locations ) { # create new hash reference at this level if not already there $ref->{$location} = {} if !exists $ref->{$location}; # save reference to current level in helper ref $ref = $ref->{$location}; } # save value in last key $ref->{$last_location} = $val; } package main; my $Object1 = childmodul->new(); $Object1->set_Data('INIT_RUN', qw( DBParam dbSession runtime dbTable )); print $Object1->{DBParam}->{dbSession}->{runtime}->{dbTable} . "\n"; $Object1->set_Data('update', qw( DBParam dbSession Action )); print $Object1->{DBParam}->{dbSession}->{Action} . "\n"; $Object1->set_Data('debug', qw( Runtime Loglevel )); print $Object1->{Runtime}->{Loglevel} . "\n";
$objekt1->{h1}->{h2}->[0|1|2|...] = wert
2015-05-22T11:50:09 mtbf40Danke für die professionelle Hilfe!
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
#!/usr/bin/perl use warnings; use strict; use DateTime qw(); use feature qw/say switch/; package childmodul; sub new { my ($classname,$hsh_scriptParam) = @_; my $self = {%{$hsh_scriptParam}}; return bless($self, $classname); } sub set_Data { my $self = shift; my $val = shift; my @locations = @_; # save last key my $last_key = pop @locations; # helper ref for each level inside HoHoH... my $ref = $self; for my $location ( @locations ) { # create new hash reference at this level if not already there $ref->{$location} = {} if !exists $ref->{$location}; # this points to the next level down the hash tree $ref = $ref->{$location}; } # save value in last key if (ref($last_key) eq 'ARRAY') { $ref->[$last_key->[0]] = $val; } else { if (ref($val) eq 'HASH') { $ref->{$last_key} = $val->{hash}; } else { $ref->{$last_key} = $val; } } } package main; my $hsh_runtimeParam = { ScriptParam => {ScriptName => $0 || '???', Version => 'v.01' || '???', Hilfe => {Usage => 'ruf mich mal richtig auf', Message => 'rufe mal nach Mutti' }, }, Runtime => {ApplName => 'TestClass', Caller => $^O =~ /win32/i ? $ENV{USERNAME} : $ENV{USER}, Loglevel => 'höher geht nicht', RootPath => 'ganz oben' || '???', StartTime => 'am Anfang' || '???', Instanz => [ 'test1', 'test2', '11', 'array' ] }, DBParam => {RegPar => 'test', dbSession => {ApplName => 'testhash', Action => 'insert', runtime => {dbTable => 'INIT_REG'}} }, }; my $Object1 = childmodul->new($hsh_runtimeParam); my @h_keys = qw(Runtime Instanz); push @h_keys, [3]; $Object1->set_Data('hash', @h_keys ); $Object1->set_Data({hash=>{ RUN_ENDDATE => ["to_date(?,'DD.MM.YYYY HH24:MI:SS')",DateTime->now(time_zone => 'local')->strftime('%d.%m.%Y %H:%M:%S')], RUN_LOGMSG => 'Message', RUN_RC_CODE => '12' }}, qw(DBParam RunPar) ); $Object1->set_Data('update', qw( DBParam dbSession Action )); $Object1->set_Data('debug', qw( Runtime Loglevel )); print 'Ende' . "\n";