1 2 3 4 5 6 7 8 9 10 11 12 13
my $aufruf = \&testsub; # das package definiere ich, weil die externen Scripte teilweise # selbe sub Namen haben, damit will ich "Subroutine ... redefined at ..." verhindern { require 'externes_script.pl'; package testoben; testoben::$aufruf->('a'); } # der Code ab hier steht in der externes_script.pl # ist für diesen Versuch aber egal, Fehlermeldung ist die selbe my testsub = sub { print "Sub $_[0]\n"; }
QuoteBad name after testoben:: at test.pl line 7.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
my $aufruf = \&testsub; my $script = 'externes_script.pl'; # das package definiere ich, weil die externen Scripte teilweise # selbe sub Namen haben, damit will ich "Subroutine ... redefined at ..." verhindern { require $script; package mein_namensraum; } mein_namensraum::$aufruf->('a'); # der Code ab hier steht in der externes_script.pl # ist für diesen Versuch aber egal, Fehlermeldung ist die selbe sub testsub { print "Sub $_[0]\n"; }
1 2 3 4 5 6 7 8 9 10
# externe Datei lib.pl my $foo = sub{}; my $bar = sub{}; # anstelle der üblichen 1; notieren wir hier eine Hashreferenz { foo => $foo, bar => $bar };
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
my $main = bless{}; # als Beispiel einer Instanz # foo soll im Scope der main afgerufen werden $main->execute('foo'); sub execute{ my $self = shift; my $name = shift; # entweder haben wir die sub im eigenen Scope # oder wir binden sie als CodeRef ein if( my $code = $self->can($name) ){ $self->$code(@_) } else{ my $codehash = do 'lib.pl'; if( my $coderef = $codehash->{$name} ){ $self->$coderef(@_); } } }
$mein_namensraum::aufruf->('a');
$main::aufruf->('a');
2015-02-19T13:42:40 GUIfreundVielleicht ist es einfacher, wenn du umgekehrt vorgehst: schreibe deinen Kode ganz normal in main:: und stecke das require in ein package.
2015-02-19T15:33:17 bianca2015-02-19T13:42:40 GUIfreundVielleicht ist es einfacher, wenn du umgekehrt vorgehst: schreibe deinen Kode ganz normal in main:: und stecke das require in ein package.
Das require steht doch im package.
2015-02-19T15:33:17 biancaDeine anderen beiden Vorschläge gehen auch nicht, kommen ganze Seiten voller Fehlermeldungen raus.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
my $aufruf = \&testsub; my $script = 'externes_script.pl'; # das package definiere ich, weil die externen Scripte teilweise # selbe sub Namen haben, damit will ich "Subroutine ... redefined at ..." verhindern $aufruf->('a'); { package mein_namensraum; require $script; } # der Code ab hier steht in der externes_script.pl # ist für diesen Versuch aber egal, Fehlermeldung ist die selbe sub testsub { print "Sub $_[0]\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
#!/usr/bin/perl use strict; use warnings; my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_sub => 'testsub', }, { moduldatei => 'test_extern2.pl', aufruf_sub => 'testsub2', }, # hier sind natürlich noch ganz viele ); foreach my $ref (@dispatchtab) { # nur der Code innerhalb dieser Schleife darf geändert werden, sonst nichts! { package modulscope; require $ref->{moduldatei}; no strict 'refs'; &{$ref->{aufruf_sub}}('a'); } }
QuoteSubroutine testsub redefined
2015-02-20T18:26:42 GUIfreundHattest du übersehen, dass diese Struktur noch fehlerhaft ist?
2015-02-20T18:26:42 GUIfreundWie auch immer, ich habe mich dran versucht und hätte "beinahe" eine (hoffentlich) akzeptable Lösung gefunden.
2015-02-20T18:26:42 GUIfreundhabe ich noch undef $INC{modulscope}; in der Schleife angehängt, damit require nicht mehr weiß, dass das package schon geladen ist. Das hat aber leider nicht geklappt.
2015-02-19T11:36:30 clmsDann der Auslöser der Fehlermeldung: was erwartest Du von testoben::$aufruf? Was soll das sein?
2015-02-19T12:43:42 bianca2015-02-19T11:36:30 clmsDann der Auslöser der Fehlermeldung: was erwartest Du von testoben::$aufruf? Was soll das sein?
Als Ausgabe erwarte ich Sub a
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
#!/usr/bin/perl use strict; use warnings; my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_sub => \&testsub, } # hier sind natürlich noch ganz viele ); foreach my $ref (@dispatchtab) { # nur der Code innerhalb dieser Schleife darf geändert werden, sonst nichts! { package modulscope; require $ref->{moduldatei}; $ref->{aufruf_sub}->('a'); } } sub testsub { print "Fehler, falsche sub!\n"; }
1 2 3 4 5 6 7 8 9
#!/usr/bin/perl use strict; use warnings; # dieser Code hier steht in der test_extern.pl sub testsub { print "Gewonnen! Sub $_[0]\n"; } return '1';
1 2 3 4 5 6 7 8 9 10 11 12 13
foreach my $ref (@dispatchtab) { # nur der Code innerhalb dieser Schleife darf geändert werden, sonst nichts! my $coderef = do $ref->{moduldatei}; $ref->$coderef('a'); # beachte: $ref is not blessed } # in Moduldatei steht drin sub{ print "@_"; };
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
#!/usr/bin/perl use strict; use warnings; my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_sub => \&testsub, }, { moduldatei => 'test_extern2.pl', aufruf_sub => \&testsub, }, # hier sind natürlich noch ganz viele ); foreach my $ref (@dispatchtab) { # nur der Code innerhalb dieser Schleife darf geändert werden, sonst nichts! { require $ref->{moduldatei}; package modulscope; $ref->{aufruf_sub}->('a'); } }
1 2 3 4 5 6 7 8
#!/usr/bin/perl use strict; use warnings; sub testsub { print "Gewonnen! Sub $_[0]\n"; } return '1';
QuoteGewonnen! Sub a
Subroutine testsub redefined at test_extern2.pl line 6.
Gewonnen! Sub a
QuoteUndefined subroutine &main::testsub called at test.pl line 21.
1 2 3 4 5 6 7 8
foreach my $ref (@dispatchtab) { # nur der Code innerhalb dieser Schleife darf geändert werden, sonst nichts! { package modulscope; require $ref->{moduldatei}; } modulscope::$ref->{aufruf_sub}->('a'); }
QuoteBad name after modulscope:: at test.pl line 22.
QuoteGewonnen! Sub a
Gewonnen! Sub a
1 2 3 4 5
foreach my $ref (@dispatchtab) { # nur der Code innerhalb dieser Schleife darf geändert werden, sonst nichts! require $ref->{moduldatei}; local *$ref->{aufruf_sub}; }
QuoteNot a GLOB reference at test.pl line 19.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
#!/usr/bin/perl use strict; use warnings; my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_sub => \&testsub, aufruf_neu => \&modulscope::testsub, }, { moduldatei => 'test_extern2.pl', aufruf_sub => \&testsub, aufruf_neu => \&modulscope::testsub, }, # hier sind natürlich noch ganz viele ); foreach my $ref (@dispatchtab) { # nur der Code innerhalb dieser Schleife darf geändert werden, sonst nichts! package modulscope; require $ref->{moduldatei}; $ref->{aufruf_neu}->('a'); }
QuoteGewonnen! Sub a
Subroutine testsub redefined at test_extern2.pl line 6.
Gewonnen! Sub a
QuoteWie erreiche ich das unter der Prämisse, dass nur der Code in der Schleife geändert werden darf?
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
# Datei Foo.pm package Foo; sub foo{} 1; # Datei Bar.pm package Bar; sub foo{} 1; # Datei Baz.pl package Baz; sub foo{}; 1; require Foo; Foo::foo(); require Bar; Bar::foo(); require "Baz.pl"; # beachte den Unterschied, weil nicht .pm Baz::foo();
1 2 3 4 5 6 7 8
require Foo; # Datei siehe oben my $foo = bless{}, 'Foo'; # unschön, nur zur Veranschaulichung!!! # Besser: class Foo definiert einen Konstruktor $foo->foo(); # Aufruf über eine Instanz der Klasse Foo # Oder Aufruf der Funktion foo() als Klassenmethode Foo->foo();
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
use strict; use warnings; use IO::File; my @units = qw(foo bar); foreach my $unit(@units){ my $source = do{ my $fh = IO::File->new; $fh->open("$unit.pm", "r") or die $!; read($fh, my $buffer, -s $fh); $fh->close; "package $unit;\n".$buffer; }; eval "$source"; $unit->foo(); # FQN: Der Name der Package ist das erste Argument! }
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
#!/usr/bin/perl use strict; use warnings; my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', unit => 'unit1', }, { moduldatei => 'test_extern2.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', unit => 'unit2', }, # hier sind natürlich noch ganz viele ); foreach my $ref (@dispatchtab) { my $source = do{ my $fh = IO::File->new; $fh->open($ref->{moduldatei},'r') or die $!; read($fh, my $buffer, -s $fh); $fh->close; "package $ref->{unit};\n".$buffer; }; eval "$source"; $ref->{aufruf_neu}->('a'); # FQN: Der Name der Package ist das erste Argument! }
QuoteCan't use string ("testsub") as a subroutine ref while "strict refs" in use at test.pl line 29.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
use strict; use warnings; my @units = qw(foo.pm bar.pm); # Alle Funtionen heißen sub foo my $arg = 0; foreach my $unit(@units){ my $packname = $unit; $packname =~ s/\W//g; my $source = do{ my $fh = IO::File->new; $fh->open($unit, "r") or die $!; read($fh, my $buffer, -s $fh); $fh->close; "package $packname;\n".$buffer; }; eval "$source" or die $@; my $coderef = $packname->can('foo'); $coderef->(++$arg); }
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
#!/usr/bin/perl use strict; use warnings; my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', unit => 'test1', }, { moduldatei => 'test_extern2.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', unit => 'test2', }, # hier sind natürlich noch ganz viele ); my $arg = 0; foreach my $ref (@dispatchtab) { my $packname = $ref->{unit}; $packname =~ s/\W//g; my $source = do{ my $fh = IO::File->new; $fh->open($ref->{moduldatei}, "r") or die $!; read($fh, my $buffer, -s $fh); $fh->close; "package $packname;\n".$buffer; }; eval "$source" or die $@; my $coderef = $packname->can($ref->{aufruf_sub}); $coderef->(++$arg); }
QuoteUse of uninitialized value in subroutine entry at test.pl line 34.
Use of uninitialized value in subroutine entry at test.pl line 34.
Can't use string ("") as a subroutine ref while "strict refs" in use at test.pl line 34.
QuoteIch finde das toal schwer, deinen Code immer zu implementieren.
2015-02-20T15:33:56 rostiLiegt auch nicht an mir.
2015-02-20T15:33:56 rostiIch kann Dir gerne die ganze Anwendung schreiben, jetzt, wo ich soviel Zeit da inverstiert habe, kommts auf die paar Minuten auch nicht mehr an. Willste?
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
#! /usr/bin/perl -I. use strict; use warnings; use 5.010.000; my @dispatch = ( { file => 'x5-1.pl', subroutine => 'foo', # string here, not coderef } ); sub foo { say "wrong sub"; } for my $ref ( @dispatch ) { package MyModule; # declare package to contain imported functions require $ref->{file}; # import function(s) eval $ref->{subroutine}."('a')"; # call function with string-eval; remember to insert error handling # We are inside package MyModule, so no need for package name in string } say "At the end:"; # just a check what happens now with main::foo foo( 'b' ); say "Last Test:"; # and a final test MyModule::foo( 'c' );
1 2 3 4 5 6 7 8 9 10
#! /usr/bin/perl use strict; use warnings; use 5.010.000; sub foo { say "sub $_[0]"; } 1;
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
#!/usr/bin/perl use strict; use warnings; my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', }, { moduldatei => 'test_extern2.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', }, # hier sind natürlich noch ganz viele ); foreach my $ref (@dispatchtab) { # nur der Code innerhalb dieser Schleife darf geändert werden, sonst nichts! package MyModule; require $ref->{moduldatei}; eval $ref->{aufruf_neu}."('a')"; }
QuoteGewonnen! Sub a
Subroutine testsub redefined at test_extern2.pl line 6.
Gewonnen! Sub a
2015-02-20T07:56:13 MuffiNaja, du legst in einer Schleife immer wieder die gleiche sub im Package MyModule an.
Und ich glaub hinter das package kannst du keine Variable schreiben.
Das Einzige was mir einfällt ist die .pl Dateien per Hand einlesen, vorne package MyModule$index davorhängen und per string-eval ausführen.
2015-02-20T07:56:13 Muffiedit: Oder vielleicht gehts auch die Symboltabelle jedesmal wegzukopieren und dann in MyModule zu löschen. Aber da müsst ich erst die Syntax googlen.
UNIVERSAL::can($ref->{moduldatei}, $ref->{aufruf_neu}); # $ref->{moduldatei} auch wieder ohne Dateiendung
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
#!/usr/bin/perl use strict; use warnings; my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', unit => 'test1', }, { moduldatei => 'test_extern2.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', unit => 'test2', }, # hier sind natürlich noch ganz viele ); foreach my $ref (@dispatchtab) { # nur der Code innerhalb dieser Schleife darf geändert werden, sonst nichts! package $ref->{unit}; require $ref->{moduldatei}; # eval $ref->{aufruf_neu}."('a')"; UNIVERSAL::can($ref->{unit},$ref->{aufruf_neu}); # $ref->{moduldatei} auch wieder ohne Dateiendung }
QuoteInvalid version format (non-numeric data) at test.pl line 22, near "package "
syntax error at test.pl line 22, near "package $ref"
Global symbol "$ref" requires explicit package name at test.pl line 23.
Global symbol "$ref" requires explicit package name at test.pl line 25.
Global symbol "$ref" requires explicit package name at test.pl line 25.
syntax error at test.pl line 26, near "}"
Execution of test.pl aborted due to compilation errors.
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
#!/usr/bin/perl use strict; use warnings; my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', unit => 'unit1', }, { moduldatei => 'test_extern2.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', unit => 'unit2', }, # hier sind natürlich noch ganz viele ); foreach my $ref (@dispatchtab) { my $source = do{ my $fh = IO::File->new; $fh->open($ref->{moduldatei},'r') or die $!; read($fh, my $buffer, -s $fh); $fh->close; "package $ref->{unit};\n".$buffer; }; eval "$source"; # $ref->{aufruf_neu}->('a'); # FQN: Der Name der Package ist das erste Argument! UNIVERSAL::can($ref->{moduldatei},$ref->{aufruf_neu}); # $ref->{moduldatei} auch wieder ohne Dateiendung }
UNIVERSAL::can($ref->{unit},$ref->{aufruf_neu}); # statt $ref->{moduldatei}
2015-02-20T14:13:06 MuffiAufrufen musst du die dann schon selber ;)
QuoteCan't use string ("testsub") as a subroutine ref while "strict refs" in use at test.pl line 30.
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
#!/usr/bin/perl use strict; use warnings; my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', unit => 'unit1', }, { moduldatei => 'test_extern2.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', unit => 'unit2', }, # hier sind natürlich noch ganz viele ); foreach my $ref (@dispatchtab) { my $source = do{ my $fh = IO::File->new; $fh->open($ref->{moduldatei},'r') or die $!; read($fh, my $buffer, -s $fh); $fh->close; "package $ref->{unit};\n".$buffer; }; eval "$source"; UNIVERSAL::can($ref->{moduldatei},$ref->{aufruf_neu}); # $ref->{moduldatei} auch wieder ohne Dateiendung $ref->{aufruf_neu}->('a'); }
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
#! /usr/bin/perl -I. use strict; use warnings; use 5.010.000; use File::Basename qw( basename ); my @dispatch = ( { file => 'x5_1.pl', subroutine => 'foo', # string here, not coderef }, { file => 'x5_2.pl', subroutine => 'foo', # string here, not coderef }, ); sub foo { say "wrong sub"; } for my $ref ( @dispatch ) { # clean up file name for usage as namespace name (remove file path and extension and convert '-' to '_') ( my $namespace = basename( $ref->{file}, '.pl' ) ) =~ tr/-/_/; eval <<"EVAL_CODE"; package $namespace; # declare package to contain imported functions require "$ref->{file}"; # "import" function(s) $ref->{subroutine}('a'); # call function with string-eval; remember to insert error handling # We are inside package MyModule, so no need for package name in string EVAL_CODE warn "$@\n" if $@; } say "At the end:"; # just a check what happens now with main::foo foo( 'b' );
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
#!/usr/bin/perl use strict; use warnings; use 5.010.000; use File::Basename qw( basename ); my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', unit => 'unit1', }, { moduldatei => 'test_extern2.pl', aufruf_sub => \&testsub, aufruf_neu => 'testsub', unit => 'unit2', }, # hier sind natürlich noch ganz viele ); for my $ref ( @dispatchtab ) { # clean up file name for usage as namespace name (remove file path and extension and convert '-' to '_') ( my $namespace = basename( $ref->{moduldatei}, '.pl' ) ) =~ tr/-/_/; eval <<"EVAL_CODE"; package $namespace; # declare package to contain imported functions require "$ref->{moduldatei}"; # "import" function(s) $ref->{aufruf_sub}('a'); # call function with string-eval; remember to insert error handling # We are inside package MyModule, so no need for package name in string EVAL_CODE warn "$@\n" if $@; }
Quotesyntax error at (eval 1) line 3, near ")("
syntax error at (eval 2) line 3, near ")("
1 2 3 4 5
C:\Windows\system32\cmd.exe /c (perl x5.pl) x5_1: sub a x5_2: sub a At the end: wrong sub
1 2 3 4 5 6 7 8 9 10
#! /usr/bin/perl use strict; use warnings; use 5.010.000; sub foo { say "x5_1: sub $_[0]"; } 1;
2015-02-20T16:16:14 LinuxerWas soll der Eintrag mit aufruf_neu in der Dispatch-Tabelle bringen, wenn Du ihn später nicht nutzt und doch aufruf_sub im eval-Code verwendest.
2015-02-20T16:16:14 LinuxerMein Code funktionierte bei mir; siehe Ausgabe[1]:
aufruf_sub => 'testsub',
aufruf_sub => \&testsub,
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
#!/usr/bin/perl use strict; use warnings; my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_neu => 'testsub', unit => 'unit1', referenz => defined, }, { moduldatei => 'test_extern2.pl', aufruf_neu => 'testsub', unit => 'unit2', returnval => defined, }, # hier sind natürlich noch ganz viele ); for my $ref ( @dispatchtab ) { # # besonderer Code folgt wegen des Problems der doppelten sub Namen und des darauf folgenden "...redefined at..." # dies ist nur eine Übergangslösung, bis alle sub's in sub's aufgelöst sind # Quelle: Linuxer: https://www.perl-community.de/bat/poard/thread/19514#ms_179778 # my ($back,%back); eval <<"EVAL_CODE"; package $ref->{unit}; require "$ref->{moduldatei}"; if ($ref->{returnval}) { $back = $ref->{aufruf_neu}->("$ref->{unit}"); print "Back: '$back'\n"; } else { $ref->{aufruf_neu}->("$ref->{unit}",\%back); print "Back: '$back{text}'\n"; } EVAL_CODE ; warn "$@\n" if $@; }
1 2 3 4 5 6 7 8
#!/usr/bin/perl use strict; use warnings; sub testsub { return "Gewonnen! Sub $_[0]\n"; } return '1';
1 2 3 4 5 6 7 8 9 10
#!/usr/bin/perl use strict; use warnings; sub testsub { my ($val,$back) = @_; $back{text} = "Gewonnen! Sub $val\n"; return; } return '1';
QuoteUse of uninitialized value in concatenation (.) or string at test.pl line 27.
Use of uninitialized value $back in concatenation (.) or string at test.pl line 27.
Use of uninitialized value $back in concatenation (.) or string at test.pl line 27.
Use of uninitialized value in concatenation (.) or string at test.pl line 27.
syntax error at (eval 1) line 3, near "() "
syntax error at (eval 1) line 7, near ";
}"
(Might be a runaway multi-line "" string starting on line 5)
syntax error at (eval 1) line 12, near ";
}"
(Might be a runaway multi-line "" string starting on line 10)
Use of uninitialized value $back in concatenation (.) or string at test.pl line 27.
Use of uninitialized value $back in concatenation (.) or string at test.pl line 27.
Use of uninitialized value in concatenation (.) or string at test.pl line 27.
syntax error at (eval 2) line 3, near "() "
syntax error at (eval 2) line 7, near ";
}"
(Might be a runaway multi-line "" string starting on line 5)
syntax error at (eval 2) line 12, near ";
}"
(Might be a runaway multi-line "" string starting on line 10)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
my $back = 1; if ($back =~ /HASH/){ print "Das ist eine Hashreferenz, der Inhalt = $back->{'text'}\n" } else { print "Das ist eine normale Variable, der Inhalt = $back\n" } my $back = {text => 'b'}; if ($back =~ /HASH/){ print "Das ist eine Hashreferenz, der Inhalt = $back->{'text'}\n" } else { print "Das ist eine normale Variable, der Inhalt = $back\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
#!/usr/bin/perl use strict; use warnings; my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_neu => 'testsub', unit => 'unit1', }, { moduldatei => 'test_extern2.pl', aufruf_neu => 'testsub', unit => 'unit2', }, # hier sind natürlich noch ganz viele ); for my $ref ( @dispatchtab ) { eval <<"EVAL_CODE"; package $ref->{unit}; require "$ref->{moduldatei}"; $ref->{'aufruf_neu'}('a'); EVAL_CODE warn "ACHTUNG: '$@'\n" if $@; }
QuoteHier erweitern wir den String-eval() und reiten fröhlich in den Abgrund ;-)
1 2 3 4 5 6 7 8 9 10 11
for my $ref ( @dispatch ) { my $argument = "Bla"; # etwas zum Weiterreichen an die Sub eval <<"EVAL_CODE"; package $ref->{unit}; require "$ref->{file}"; $ref->{subroutine}(\$argument); # $argument ist maskiert, weil es nicht im String interpoliert, sondern erst beim eval() ausgewertet werden soll EVAL_CODE warn "ACHTUNG: $@\n" if $@; }
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
#!/usr/bin/perl use strict; use warnings; my @dispatchtab = ( { moduldatei => 'test_extern.pl', aufruf_neu => 'testsub', unit => 'unit1', stringval => defined, }, { moduldatei => 'test_extern2.pl', aufruf_neu => 'testsub', unit => 'unit2', }, # hier sind natürlich noch ganz viele ); for my $ref ( @dispatchtab ) { my %back; if (defined $ref->{stringval}) { eval <<"EVAL_CODE"; package $ref->{unit}; require "$ref->{moduldatei}"; \$back{text} = $ref->{aufruf_neu}->(\$ref->{unit}); EVAL_CODE warn "ACHTUNG: '$@'\n" if $@; } else { eval <<"EVAL_CODE"; package $ref->{unit}; require "$ref->{moduldatei}"; $ref->{aufruf_neu}->(\$ref->{unit},\\%back); EVAL_CODE warn "ACHTUNG: '$@'\n" if $@; } print $back{text}; }