Trapping re 'debug'

[diotalevi]

Hi there, I'm thinking about how to capture perl's parse tree for regular expressions without using Rx (mostly because I don't want to have to use pre-alpha perl + custom patches, partly because it's just an interesting question).

The simplest test for this is closing the STDERR filehandle. This almost works except some text is still printed. The odd bit is if I try try tie STDERR then the tied methods are never even called (except CLOSE AND TIEHANDLE). So what gives? Amy I just totally out of luck here?

Default output:

$ perl -Mre=debug '1 =~ `'
Freeing REx: `,'
Compiling REx `1'
size 3 first at 1
   1: EXACT <1>(3)
   3: END(0)
anchored `1' at 0 (checking anchored isall) minlen 1
Guessing start of match, REx `1' against `1'...
Found anchored substr `1' at offset 0...
Guessed: match at offset 0
Freeing REx: `1'

After closing STDERR

$ perl -Mre=debug -e 'BEGIN { close STDERR } 1 =~ 1'
Freeing REx: `1'

A tied trap fails to do anything useful

re.pl:
package TrapRe;
sub TIEHANDLE {
    my $class = shift;
    my $fh = \do { local *HANDLE };
    bless $fh, $class;
}
sub CLOSE { close $_[0] }
sub READ {}
sub READLINE {}
sub GETC {}
sub WRITE {}
sub PRINT {}
sub PRINTF {}
sub BINMODE {}
sub EOF {}
sub FILENO {}
sub SEEK {}
sub TELL {}
sub OPEN {}
sub DESTROY {}
sub UNTIE {}

package main;
use re 'debug';
BEGIN { tie *STDERR, TrapRe; }
1 =~ 1;

$ perl re.pl
Compiling REx `1'
size 3 first at 1
   1: EXACT <1>(3)
   3: END(0)
anchored `1' at 0 (checking anchored isall) minlen 1
Guessing start of match, REx `1' against `1'...
Found anchored substr `1' at offset 0...
Guessed: match at offset 0
Freeing REx: `1'

[PodMaster]

you have to close STDERR before you use re, like

perl -e" BEGIN{close STDERR};use re qw[debug]; 1 =~ 1 "

MJD says you can't just make shit up and expect the computer to know what you mean, retardo! ** The Third rule of perl club is a statement of fact: pod is sexy.

[diotalevi]

Ok, so I tried that and got marginally closer. At least the "Freeing" line isn't visible anymore. So why isn't PRINT, PRINTF, or WRITE being called with the data? That's really the final bit that would have to work for it to even have a point. The following code outputs nothing except "DESTROY\n".

package TrapRe;
sub TIEHANDLE {
    my $class = shift;
    my $fh = \do { local *HANDLE };
    bless $fh, $class;
}
sub CLOSE { close $_[0] }
eval qq[sub $_ { print "$_\n" };]
    for qw/READ READLINE GETC WRITE PRINT PRINTF
           BINMODE EOF FILENO SEEK TELL OPEN
           DESTROY UNTIE/;

package main;
BEGIN {
    close STDERR;
    tie *STDERR, TrapRe;
}
use re 'debug';
1 =~ 1;

---

Seeking Green geeks in Minnesota

[Anonymous Monk]

The reason you only see the DESTROY in your class is because you closed STDERR, then tied it to your class, but in your class you do nothing with it. So then when re 'debug' attempts to print STDERR, perl find that the handle is closed and reopens it before it can output to it. This process of reopening destroys your handle. You get the DESTROY call.

[John M. Dlugosz]

How about piping STDERR to another script which strips out just the interesting part?

—John

[diotalevi]

Yeah, I guess. That wasn't quite what I was looking for but it'd work. Any ideas on how to fiddle with the handle issue I raised?

---

Seeking Green geeks in Minnesota

[John M. Dlugosz]

Well, if tying or otherwise redirecting the handle from within the script doesn't work, the next logical step is to redirect the file on the OS level and before the script starts. That is, do it in the shell when perl is launched.