PrePAN

Sign in to PrePAN

Regex::Wrapper OO Perl Regex Wrapper

Author
shemp@github
Date
URL
Status
In Review
Good

Synopsis

package Wrapper;
$VERSION = 1.10;
use strict;
use warnings;
use Data::Dumper;
use Match;

sub new
{
	my ($class, $pattern) = @_;
	
	eval
		{	bless
				{
					_regex => qr/$pattern/,
					_pattern => $pattern
				} , ref($class) || $class;
		}
}

sub get_pattern{ return $_[0]->{_pattern} };
sub get_regex  { return $_[0]->{_regex} };

sub match
{
	my ($self, $str) = @_;
	my @subpatterns = ($self->get_pattern =~ /$str/) or return;
	# arguments 2 - 5 = 'pre', 'match', 'post', 'result'
	# (see Match->new() method)
	return Match->new(@subpatterns,$`,$&,$',$str);
}

sub substitute
{
	my ($self, $str, $subs) = @_;
	my $pattern = $self->get_pattern();
	$pattern =~ s/$str/$subs/ or return;
	# arguments 1 - 4 = 'pre', 'match', 'post', 'result'
	# (see Match->new() method)
	return Match->new($`,$&,$',$pattern);
}

sub substitute_all
{
	my ($self, $str, $subs) = @_;
	my $pattern = $self->get_pattern();
	$str =~ s/$pattern/$subs/g or return;
	# arguments 1 - 4 = 'pre', 'match', 'post', 'result'
	# (see Match->new() method)
	return Match->new($`,$&,$',$str);
}

package Match;
$VERSION = 1.10;
use strict;
use warnings;
use vars '$AUTOLOAD', '$DESTROY';

sub new {
	my $class = shift;
	my ($pre, $match, $post, $result) = splice @_, -4;
	bless {
			_pre			=> $pre,
			_match			=> $match,
			_post			=> $post,
			_result			=> $result,
			_subpatterns		=> [@_]
		  }, ref($class) || $class;
	sub _accessible() { exists $_[0]->{$1} }
}

sub AUTOLOAD
{
	no strict "refs";
	my ($self) = @_;

	#	was it a 'get()' call?	is the attribute accessible?
	if ($AUTOLOAD =~ /.*::get(_\w+)/ and $self->_accessible($1) )
	{
		# get locally scoped, scalar copy ($attr_name) of $1
		my $attr_name = $1;
		# can't use '$self' in 'sub' return call, since
		# it's outside the scope of subsequent 'get' calls;
		# the first 'get' call would work as expected, but
		# subsequent 'get' calls use the changed symbol table's
		# anonymous sub-routine
		#
		# cram the anonymous sub-routine into the symbol
		# table, use it after the first call to a 'get_xxx()' method
		*$AUTOLOAD = sub { return $_[0]->{$attr_name} };
		return $self->{$attr_name};
	} 
	return "Match::AUTOLOAD : Not a 'get' call or attribute doesn't exist.";
}

sub DESTROY {}

sub from
{
	my ($self) = @_;
	# example of Perl 'memoization'...
	# cramming a new value into $self,
	# on the fly and as it is requested.
	$self->{_from} = length($_[0]->{_pre})
		unless defined $self->{_from};
	return $self->{_from};
}

sub to
{
	my ($self) = @_;
	# example of Perl 'memoization'...
	# cramming a new value into $self,
	# on the fly and as it is requested.
	$self->{_to} = $self->from + length($self->{_match}) - 1
		unless defined $self->{_to};
	return $self->{_to};
}

sub subpatterns
{
	my ($self, $index) = @_;
	return $self->{_subpatterns}[$index] if defined $index;
	return @{$self->{_subpatterns}};
}

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

#!/usr/bin/perl
use strict;
use warnings;
use Wrapper;
use Data::Dumper;

my $original = "cie";
my $regex = Wrapper->new($original)
	or die("Error creating Wrapper object!");
print "'regex' object :\n";
print Dumper($regex);
print Dumper($regex->get_regex());
print "---------------------------\n";
print "regex->match (full):\n";
print Dumper($regex->match("cie")->get_match);
print "regex->match('cie')->from:\n";
print $regex->match("cie")->from()."\n";
print "regex->match('cie')->to:\n";
print $regex->match("cie")->to()."\n";
print "---------------------------\n";
print "regex->match (partial):\n";
print Dumper($regex->match("ci")->get_match);
print "---------------------------\n";
print "regex->match('ci')->from:\n";
print $regex->match("ci")->from()."\n";
print "regex->match('ci')->to:\n";
print $regex->match("ci")->to()."\n";
print "regex->match('ci')->subpatterns(): \n";
print Dumper($regex->match("ci")->subpatterns(0));
print "---------------------------\n";
print "regex->match (no match):\n";
defined ($regex->match("xyz")) ? () : goto SKIP;
print Dumper($regex->match("xyz")->get_match);
print "regex->match('xyz')->from:\n";
print $regex->match("xyz")->from()."\n";
print "regex->match('xyz')->to:\n";
print $regex->match("xyz")->to()."\n";
print "---------------------------\n";
SKIP:
print "no match\n";
print "---------------------------\n";
print "regex->substitute: (match)\n";
print "regex->substitute() result = ";
print $regex->substitute("ci","m")->get_result()."\n";
print "---------------------------\n";
print "regex->substitute (no match):\n";
defined ($regex->substitute("ty","w")) ? () : goto SKIPPED;
print "---------------------------\n";
SKIPPED:
print "no match for substitution\n";
print "---------------------------\n";
print "regex->substitute (match):\n";
print "regex->substitute() _result = ";
print $regex->substitute("ci","x")->get_result()."\n";
print "---------------------------\n";
print "new_regex->substitute_all():\n";
my $last = "I batted 4 for 4!";
my $new_regex = Wrapper->new("4")
	or die("Error creating Wrapper object!");
print "new_regex->substitute_all() _result = ";
print $new_regex->substitute_all($last,"four")->get_result()."\n";
print "---------------------------\n";
print "regex->substitute_all() (attribute doesn't exist):\n";
print "new_regex->substitute_all() _hemans = ";
print $new_regex->substitute_all($last,"four")->get_hemans()."\n";

Description

Just running this by everyone and wondering what is thought...

It's a small, 2-file collection OO wrapper providing Perl Regex functionality. Matching, substitution, to/from matching index info, etc. are available.

Regex::Wrapper and Regex::Wrapper::Match are the package names.

The code in the 'Synopsis' section closest to the bottom is some 'driver' code that exercises the packages.

Thanks to anyone who takes the time to check this out.

Comments

anonymouse
Anonymous
First off, not a good name: https://pause.perl.org/pause/query?ACTION=pause_namingmodules#Top_level_namespaces
Secondly, there are a TON of existing regex modules. It looks like yours might just be an OO wrapper to avoid dealing directly with regexes. Have you looked at any of the existing modules to see if something like this already exists?
Thanks for the information. I will check them out.
Name changed, and I see a couple of modules already on CPAN that sort of seem to do something similar (String::Gsub, Tapir::Validator::Regex), but nothing seems to be as generic as mine. I've found the use of Regex::Wrapper and Regex::Wrapper::Match makes development faster and code more readable.
Can someone *please* delete this? Had trouble with my github account, had to delete it and create a new one just to be able to log-in to PrePan. Have re-submitted this module under my new github ID, snovakov@github.

Please sign up to post a review.