Re^4: Getting Special Perl Variables for last Regexp from Debugger

I didnt expect it, frankly I just had no idea how I can get them. So far I managed to get to the other "special vars" with:


# Output Perl Special Variables
sub OutputGlobalVars {

    local $| = 1;
    print STDOUT "DBGOUT+=GLOBAL_VARIABLES_START\n";
    print STDOUT 'DBGOUT+=$!:='.$!."\n";
    print STDOUT 'DBGOUT+=$":='.$"."\n";
    print STDOUT 'DBGOUT+=$#:='.$#."\n";
    print STDOUT 'DBGOUT+=$$:='.$$."\n";
    print STDOUT 'DBGOUT+=$(:='.$(."\n";
    print STDOUT 'DBGOUT+=$):='.$)."\n";
    print STDOUT 'DBGOUT+=$.:='.$.."\n";
    print STDOUT 'DBGOUT+=$/:='.unpack('U*',$/)."\n";
    print STDOUT 'DBGOUT+=$0:='.$0."\n";
    print STDOUT 'DBGOUT+=$::='.unpack('U*',$:)."\n";
    print STDOUT 'DBGOUT+=$;:='.unpack('U*',$;)."\n";
    print STDOUT 'DBGOUT+=$<:='.$<."\n";
    print STDOUT 'DBGOUT+=$>:='.$>."\n";
    print STDOUT 'DBGOUT+=$?:='.$?."\n";
    print STDOUT 'DBGOUT+=$@:='.$@."\n";
    print STDOUT 'DBGOUT+=$ARGV:='.$ARGV."\n";
    print STDOUT 'DBGOUT+=$[:='.$[."\n";
    print STDOUT 'DBGOUT+=$^A:='.$^A."\n";
    print STDOUT 'DBGOUT+=$^C:='.$^C."\n";
    print STDOUT 'DBGOUT+=$^D:='.$^D."\n";
    print STDOUT 'DBGOUT+=$^E:='.$^E."\n";
    print STDOUT 'DBGOUT+=$^F:='.$^F."\n";
    print STDOUT 'DBGOUT+=$^H:='.$^H."\n";
    print STDOUT 'DBGOUT+=$^I:='.$^I."\n";
    print STDOUT 'DBGOUT+=$^L:='.unpack('U*',$^L)."\n";
    print STDOUT 'DBGOUT+=$^M:='.$^M."\n";
    print STDOUT 'DBGOUT+=$^O:='.$^O."\n";
    print STDOUT 'DBGOUT+=$^P:='.$^P."\n";
    print STDOUT 'DBGOUT+=$^R:='.$^R."\n";
    print STDOUT 'DBGOUT+=$^S:='.$^S."\n";
    print STDOUT 'DBGOUT+=$^T:='.$^T."\n";
    print STDOUT 'DBGOUT+=$^W:='.$^W."\n";
    print STDOUT 'DBGOUT+=$^X:='.$^X."\n";
    print STDOUT 'DBGOUT+=$_:='.$_."\n";
    print STDOUT 'DBGOUT+=${^WIDE_SYSTEM_CALLS}:='.${^WIDE_SYSTEM_CALL
+S}."\n";

    # %!
    if (scalar keys %{!}) {
        foreach my $szKey (keys %{!}) {
            print STDOUT 'DBGOUT+=%!('.$szKey.'):='.$!{$szKey}."\n";
        }
    }
    else {
        print STDOUT 'DBGOUT+=%!:='.'undef'."\n";
    }

    # %ENV
    if (scalar keys %ENV) {
        foreach my $szKey (keys %ENV) {
            print STDOUT 'DBGOUT+=%ENV('.$szKey.'):='.$ENV{$szKey}."\n
+";
        }
    }
    else {
        print STDOUT 'DBGOUT+=%ENV:='.'undef'."\n";
    }

    # %INC
    if (scalar keys %INC) {
        foreach my $szKey (keys %INC) {
            print STDOUT 'DBGOUT+=%INC('.$szKey.'):='.$INC{$szKey}."\n
+";
        }
    }
    else {
        print STDOUT 'DBGOUT+=%INC:='.'undef'."\n";
    }

    # %SIG
    if (scalar keys %SIG) {
        foreach my $szKey (keys %SIG) {
            print STDOUT 'DBGOUT+=%SIG('.$szKey.'):='.$SIG{$szKey}."\n
+";
        }
    }
    else {
        print STDOUT 'DBGOUT+=%SIG:='.'undef'."\n";
    }

    # %^H
    if (scalar keys %{^H}) {
        foreach my $szKey (keys %{^H}) {
            print STDOUT 'DBGOUT+=%^H('.$szKey.'):='.$^H{$szKey}."\n";
        }
    }
    else {
        print STDOUT 'DBGOUT+=%^H:='.'undef'."\n";
    }

    my $i;
    for($i=0;$i<@ARGV;$i++) {
        print STDOUT 'DBGOUT+=@ARGV['.$i.']:='.$ARGV[$i]."\n";
    }
    unless ($i) {
        print STDOUT 'DBGOUT+=@ARGV:='.'undef'."\n";
    }

    for($i=0;$i<@F;$i++) {
        print STDOUT 'DBGOUT+=@F['.$i.']:='.$F[$i]."\n";
    }
    unless ($i) {
        print STDOUT 'DBGOUT+=@F:='.'undef'."\n";
    }

    for($i=0;$i<@INC;$i++) {
        print STDOUT 'DBGOUT+=@INC['.$i.']:='.$INC[$i]."\n";
    }
    unless ($i) {
        print STDOUT 'DBGOUT+=@INC:='.'undef'."\n";
    }

    for($i=0;$i<@DB::Underscore;$i++) {
        print STDOUT 'DBGOUT+=@_['.$i.']:='.$DB::Underscore[$i]."\n";
    }
    unless ($i) {
        print STDOUT 'DBGOUT+=@_:='.'undef'."\n";
    }





    # Package specific
    my $szPackage = $DB::package;
    print STDOUT "DBGOUT+=:=PACKAGE_VARIABLES_START\n";
    print STDOUT 'DBGOUT+=$VERSION:='.${$szPackage.'::VERSION'}."\n";
    print STDOUT 'DBGOUT+=$a:='.${$szPackage.'::a'}."\n";
    print STDOUT 'DBGOUT+=$b:='.${$szPackage.'::b'}."\n";

    # %EXPORT_TAGS
    if (scalar keys %{$szPackage.'::EXPORT_TAGS'}) {
        foreach my $szKey (keys %{$szPackage.'::EXPORT_TAGS'}) {
            print STDOUT 'DBGOUT+=%EXPORT_TAGS('.$szKey.'):='.${$szPac
+kage.'::EXPORT_TAGS'}{szKey}."\n";
        }
    }
    else {
        print STDOUT 'DBGOUT+=%EXPORT_TAGS:='.'undef'."\n";
    }

    # %FIELDS
    if (scalar keys %{$szPackage.'::FIELDS'}) {
        foreach my $szKey (keys %{$szPackage.'::FIELDS'}) {
            print STDOUT 'DBGOUT+=%FIELDS('.$szKey.'):='.${$szPackage.
+'::FIELDS'}{$szKey}."\n";
        }
    }
    else {
        print STDOUT 'DBGOUT+=%FIELDS:='.'undef'."\n";
    }

    # %OVERLOAD
    if (scalar keys %{$szPackage.'::OVERLOAD'}) {
        foreach my $szKey (keys %{$szPackage.'::OVERLOAD'}) {
            print STDOUT 'DBGOUT+=%OVERLOAD('.$szKey.'):='.${$szPackag
+e.'::OVERLOAD'}{$szKey}."\n";
        }
    }
    else {
        print STDOUT 'DBGOUT+=%OVERLOAD:='.'undef'."\n";
    }


    for($i=0;$i<@{$szPackage.'::EXPORT'};$i++) {
        print STDOUT 'DBGOUT+=@EXPORT['.$i.']:='.${$szPackage.'::EXPOR
+T'}[$i]."\n";
    }
    unless ($i) {
        print STDOUT 'DBGOUT+=@EXPORT:='.'undef'."\n";
    }

    for($i=0;$i<@{$szPackage.'::EXPORT_OK'};$i++) {
        print STDOUT 'DBGOUT+=@EXPORT_OK['.$i.']:='.${$szPackage.'::EX
+PORT_OK'}[$i]."\n";
    }
    unless ($i) {
        print STDOUT 'DBGOUT+=@EXPORT_OK:='.'undef'."\n";
    }

    for($i=0;$i<@{$szPackage.'::ISA'};$i++) {
        print STDOUT 'DBGOUT+=@ISA['.$i.']:='.${$szPackage.'::ISA'}[$i
+]."\n";
    }
    unless ($i) {
        print STDOUT 'DBGOUT+=@ISA:='.'undef'."\n";
    }
    # Last Regexp
    print STDOUT "DBGOUT+=REGEXP_VARIABLES_START\n";
    print STDOUT 'DBGOUT+=$&:='.$&."\n";
    print STDOUT 'DBGOUT+=$*:='.$*."\n";
    print STDOUT 'DBGOUT+=$+:='.$+."\n";
    print STDOUT 'DBGOUT+=$^R:='.$^R."\n";
    print STDOUT 'DBGOUT+=$`:='.$`."\n";

    for($i=0;$i<@+;$i++) {
        print STDOUT 'DBGOUT+=@+['.$i.']:='.$+[$i]."\n";
    }
    unless ($i) {
        print STDOUT 'DBGOUT+=@+:='.'undef'."\n";
    }

    for($i=0;$i<@-;$i++) {
        print STDOUT 'DBGOUT+=@-['.$i.']:='.$-[$i]."\n";
    }
    unless ($i) {
        print STDOUT 'DBGOUT+=@-:='.'undef'."\n";
    }

    for($i=0;$i<@digits;$i++) {
        print STDOUT 'DBGOUT+=@digits['.$i.']:='.$digits[$i]."\n";
    }
    unless ($i) {
        print STDOUT 'DBGOUT+=@digits:='.'undef'."\n";
    }
    

    # File Handle
    my $hCurrentHandle = select $DB::hOrgFileHandle;
    my @hFileHandle = ($%,$-,$=,$^,$|,$~);
    select $hCurrentHandle;

    print STDOUT "DBGOUT+=FILE_HANDLES_START\n";
    print STDOUT 'DBGOUT+=$%:='.$hFileHandle[0]."\n";
    print STDOUT 'DBGOUT+=$-:='.$hFileHandle[1]."\n";
    print STDOUT 'DBGOUT+=$=:='.$hFileHandle[2]."\n";
    print STDOUT 'DBGOUT+=$^:='.$hFileHandle[3]."\n";
    print STDOUT 'DBGOUT+=$|:='.$hFileHandle[4]."\n";
    print STDOUT 'DBGOUT+=$~:='.$hFileHandle[5]."\n";

}
[download]

The only thing that seems to be wrong are the Regexp Vars. The others seems to work fine. The Output is (reformatted) :

Global : $! : No such file or directory
Global : $" :  
Global : $# : 
Global : $$ : 1500
Global : $( : 0
Global : $) : 0
Global : $. : 9
Global : $/ : 10
Global : $0 : E:/ESC/GUI/Plugin/IDE/Projects/MyProject/main.pl
Global : $: : 32
Global : $; : 28
Global : $< : 0
Global : $> : 0
Global : $? : 0
Global : $@ : 
Global : $ARGV : 
Global : $[ : 0
Global : $^A : 
Global : $^C : 0
Global : $^D : 0
Global : $^E : Das System kann die angegebene Datei nicht finden
Global : $^F : 2
Global : $^H : 256
Global : $^I : 
Global : $^L : 12
Global : $^M : 
Global : $^O : MSWin32
Global : $^P : 831
Global : $^R : 
Global : $^S : 0
Global : $^T : 1133266342
Global : $^W : 0
Global : $^X : C:\Perl\5.6.1\bin\MSWin32-x86-multi-thread\perl.exe
Global : $_ : 
Global : ${^WIDE_SYSTEM_CALLS} : 0
Global : %! : Hash : 39 Keys
Global : %ENV : Hash : 35 Keys
Global : %INC : Hash : 46 Keys
Global : %SIG : Hash : 28 Keys
Global : %^H : Hash : 0 Keys
Global : @ARGV : Array : 0 Elements
Global : @F : Array : 0 Elements
Global : @INC : Array : 10 Elements
Global : @_ : Array : 1 Elements
Package : $VERSION : 
Package : $a : 
Package : $b : 
Package : %EXPORT_TAGS : Hash : 0 Keys
Package : %FIELDS : Hash : 0 Keys
Package : %OVERLOAD : Hash : 0 Keys
Package : @EXPORT : Array : 0 Elements
Package : @EXPORT_OK : Array : 0 Elements
Package : @ISA : Array : 1 Elements
File Handle : $% : 0
File Handle : $- : 0
File Handle : $= : 60
File Handle : $^ : STDOUT_TOP
File Handle : $| : 1
File Handle : $~ : STDOUT
Regular Expression : $& : 
Regular Expression : $* : 
Regular Expression : $+ : 
Regular Expression : $^R : 
Regular Expression : $` : 
Regular Expression : @+ : Array : 0 Elements
Regular Expression : @- : Array : 0 Elements
Regular Expression : @digits : Array : 0 Elements

So how can I get the Regexp Vars? I didnt understand what you mean in your last sentence!

Comment on Re^4: Getting Special Perl Variables for last Regexp from Debugger Download Code

Replies are listed 'Best First'.
Re^5: Getting Special Perl Variables for last Regexp from Debugger by Moron (Curate) on Nov 29, 2005 at 13:19 UTC
Think of it like this. When running a debugger, your debugger is running but the input program isn't running. Your debugger has to transfer all those variables by interpreting the source code (or evaluating it or whatever) to either your own symbol table or, it seems from your code, to the debugging program's own symbol table. Let us suppose it does so by evaluating the code with eval. It just so happens that if you take my test code and put an eval around the pattern matching, it reproduces the problem you have exactly, i.e. those special variables stay unaffected by the code. If eval is at the core of your debugger then this needs to be enhanced so that each line of code is extended before being eval'd to specifically capture the values of those variables within the source symbol space and putting them somewhere the debugging program get at them afterwards, e.g. using IPC::Shareable or IPC::ShareLite - update: although it might slow your debugger down to have too much overhead per line of source - the only way to get better performance and be in full control of the debugger would be to parse instead of eval-ing the source code. . -M Free your mind	[reply]
Re^6: Getting Special Perl Variables for last Regexp from Debugger by Outaspace (Scribe) on Nov 29, 2005 at 15:47 UTC
Thanks for the Help so far, but now I detected my real problem, because if I debug your script it works fine! My problem now is that the Regexp Vars I am looking for are lexicaly in a sub (or any other kind of block), as if they where declared with my (or local). If I qualify them with the package name and look in the symbol table, there they are, the only think left to do, is to look in the lexical scope of a block. Btw. I am using the "original" perl debugging mechanism, means my script is included in the executing script at line 0 in a BEGIN Block. Then I only need to use the internal debugging functions from Perl (DB and sub). I thought this was the "Perl" way of doing this.	[reply]