Ovid's recent question regarding Prematch, Postmatch, and Match special variables ($`, $', and $&), and their associated global performance hit reminded me that this was something I played with a few months ago. Once I found a solution I stopped looking.
Having just read merlyn's Alpaca book, and thus being in "Object Oriented" mode when I read Ovid's question, I started thinking of an OOP alternative to using $`, $', and $&.
In this solution I tie three scalars to behave just like the infamous special variables, but without the global performance hit. Unfortunately, the string being matched against must be passed by reference to the objects as the scalars are being tied. For that reason, this solution feels a little kludgy to me, but I thought it was interesting enough to post anyway.
I haven't made any attempt to guard against undefined @- and @+ in the case of unsuccessful matches, and it may go to hell in a handbasket for s/// where the string changes length. But it's still kinda fun to play with.
Enjoy!
Dave
package Match;
use strict;
use warnings;
sub TIESCALAR {
my ( $class, $r_string ) = @_;
my $self = {};
$self->{String_Ref} = $r_string;
$self->{Value} = undef;
bless $self, $class;
}
sub STORE {
my ( $self, $value ) = @_;
$self->{Value} = $value;
return $self->{Value};
}
sub FETCH {
my $self = shift;
$self->{Value} = substr( ${$self->{String_Ref}},
$-[0], $+[0] - $-[0] );
return $self->{Value};
}
sub DESTROY {
my $self = shift;
}
1;
package Prematch;
use base "Match";
sub FETCH {
my $self = shift;
$self->{Value} = substr( ${$self->{String_Ref}},
0, $-[0] );
return $self->{Value};
}
1;
package Postmatch;
use base "Match";
sub FETCH {
my $self = shift;
$self->{Value} = substr( ${$self->{String_Ref}}, $+[0] );
return $self->{Value};
}
1;
# ---------- Begin main ----------
package main;
use strict;
use warnings;
my ( $match, $pre, $post );
my $string = "This is a contrived test string...";
tie $match, "Match", \$string;
tie $pre, "Prematch", \$string;
tie $post, "Postmatch", \$string;
if ( $string =~ /contrived/) {
print $pre,"\n";
print $match, "\n";
print $post, "\n";
}
|
Re: Tied scalars to emulate $&, $' and $` without global performance hit
by Anonymous Monk on Dec 21, 2003 at 17:35 UTC
|
##### MatchVars.pm #####
package MatchVars;
use strict;
use warnings;
sub tie {
my %args = @_;
my $string = delete $args{string} || return;
while(my($k,$v) = each %args){
tie $$v, $k, $string
}
}
package match;
sub TIESCALAR {bless [$_[1]],$_[0]}
sub FETCH {substr(${$_[0][0]}, $-[0], $+[0] - $-[0] )}
package pre;
use base "match";
sub FETCH {substr(${$_[0][0]},0, $-[0] )}
package post;
use base "match";
sub FETCH {substr(${$_[0][0]}, $+[0] )}
1;
__END__
##### match_test.pl #####
#!/usr/bin/perl -w
use strict;
use warnings;
use MatchVars;
my ( $match, $pre, $post, $string );
MatchVars::tie( string => \$string,
pre => \$pre,
match => \$match,
post => \$post
) || die "Can't tie matchvars";
$string = "This is a contrived test string...";
if ( $string =~ /contrived/) {
print $pre,"\n";
print $match, "\n";
print $post, "\n";
}
$string = 'and something else entirely';
if ( $string =~ m/thing/ ) {
print $pre,"\n";
print $match, "\n";
print $post, "\n";
}
__END__
| [reply]
[d/l] |
Re: Tied scalars to emulate $&, $' and $` without global performance hit
by davido (Cardinal) on Dec 22, 2003 at 03:32 UTC
|
Followup to my own post:
I just wanted to mention a couple of things that others have asked me about regarding this snippet:
First, the issue of these classes not working properly for the substitution ( s/// ) operator. If the size of the string changes, you're out of luck, and the classes will go looking in the wrong place for the prematch, postmatch, and match strings.
This is because I pass the string being matched against by reference, rather than by copy. I chose this strategy for efficiency's sake. Passing by reference is faster than copying a whole string (if the string is large), and more memory efficient. I also chose this strategy because it means that you only have to tie the scalars once. If the string being matched against gets changed in some way, you don't have to go and re-tie everything.
But this strategy runs amock if the string changes before you access the tied scalars to retrieve the match substrings. And the substitution operator does just that; it changes the string. Perl's default solution (aka, the $`, $&, and $' operators) is to copy the string before it gets changed. And once used one time, Perl automatically performs a string copy every time the regex engine is invoked. My solution doesn't do any copying.
You can emulate Perl's means of copying the string being matched, so that the s/// operator will work with these classes. The way to do that is to modify my snippet so that instead of passing the string by reference, it gets passed directly (in other words, a copy gets made).
This will fix the s/// problem, but will create more work for the user. It will mean that any time the string being matched changes in any way, the scalars will have to be untied and retied. That's a big pain.
At any rate, this was just a "what if" type of snippet. It's really not all that useful, but just another fun gadget for the bag-of-tricks (aka, the toolbox).
Oh, and the other thing I wanted to mention... the snippet could easily be made more robust by checking, and returning undef if @+, @- are undefined, if length $string is less than $+[0], or if the string is undefined. A simple patch, but where this is just something to play with, thorough error checking is less important than a clear example of the principles at work.
Now back to our scheduled programming, currently in progress... ;)
| [reply] |
|
|
