File Coverage

blib/lib/String/Gsub/Functions.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	7	8	87.5
condition			n/a
subroutine	10	10	100.0
pod	4	4	100.0
total	59	60	98.3

## ----------------------------------------------------------------------------
#  String::Gsub::Functions
# -----------------------------------------------------------------------------
# Mastering programmed by YAMASHINA Hio
#
# Copyright 2006 YAMASHINA Hio
# -----------------------------------------------------------------------------
# $Id$
# -----------------------------------------------------------------------------
package String::Gsub::Functions;
use warnings;
use strict;
use String::Gsub::Matcher;

use base qw(Exporter);
our @EXPORT_OK = qw(gsub gsubx subs subsx);

1;

# -----------------------------------------------------------------------------
# gsub($str, $regex, $replacement);
#   $regex is qr// or "string".
#   $replacement is sub{} or "string".
#   returns new value.
#
sub gsub($$$)
{
	splice(@_, 0, 1, $_[0]); # copy.
	&gsubx;
}

# -----------------------------------------------------------------------------
# gsubx($str, $regex, $replacement);
#   $regex is qr// or "string".
#   $replacement is sub{} or "string".
#   returns new value and $str is replaced with result too.
sub gsubx($$$)
{
	#my $str = $_[0];
	my $re  = $_[1];
	my $sub = $_[2];

	ref($re)  or $re  = qr/\Q$re\E/;
	ref($sub) or $sub = do{ my$tmpl=$sub; sub{ shift->expand($tmpl); }; };
	$_[0] =~ s{$re}
	{
		my $match = String::Gsub::Matcher->new($_[0]);
		$sub->($match);
	}ge;
	$_[0];
}

# -----------------------------------------------------------------------------
# subs($str, $regex, $replacement);
#   $regex is qr// or "string".
#   $replacement is sub{} or "string".
#   returns new value.
#
sub subs($$$)
{
	splice(@_, 0, 1, $_[0]); # copy.
	&subsx;
}

# -----------------------------------------------------------------------------
# subsx($str, $regex, $replacement);
#   $regex is qr// or "string".
#   $replacement is sub{} or "string".
#   returns new value and $str is replaced with result too.
sub subsx($$$)
{
	#my $str = $_[0];
	my $re  = $_[1];
	my $sub = $_[2];

	ref($re)  or $re  = qr/\Q$re\E/;
	ref($sub) or $sub = do{ my$tmpl=$sub; sub{ shift->expand($tmpl); }; };
	$_[0] =~ s{$re}
	{
		my $match = String::Gsub::Matcher->new($_[0]);
		$sub->($match);
	}e;
	$_[0];
}

__END__