File Coverage

blib/lib/SQL/AnchoredWildcards.pm

Criterion	Covered	Total	%
statement	20	20	100.0
branch	12	12	100.0
condition			n/a
subroutine	3	3	100.0
pod	0	1	0.0
total	35	36	97.2

# ------ Provide anchored SQL wildcards ('^', '$')
package SQL::AnchoredWildcards;



# ------ use/require pragmas
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;



# ------ define variables
@ISA = qw(Exporter);		# we are an Exporter
@EXPORT = 			# we export by default:
 qw(sql_anchor_wildcards);	# a function for anchoring SQL wildcards
@EXPORT_OK = ();		# we export nothing upon request
$VERSION = 1.0;




# Preloaded methods go here.


# ------ enhance SQL wildcard processing by simulating '^' and '$'
sub sql_anchor_wildcards {
	local $_ = shift;	# copy of unenhanced searchtext


	# ------ escape SQL '%' and convert to lower case
	s/%/\%/g;
	tr/A-Z/a-z/;


	# ------ search unanchored at start by user's choice
	if (m/^%/o) {
		;			# do nothing


	# ------ search anchored at start
	} elsif (m/^\^/o) {
		s/^\^//o;		# convert to anchored at start SQL


	# ------ search not anchored at start, but begins with escaped '^'
	} elsif (m/^\\\^/o) {
		s/^\\//o;		# allow escaped '^'
		$_ = "%" . $_;		# convert to unanchored SQL search


	# ------ search not anchored at start
	} else {
		$_ = "%" . $_;		# converted to unanchored SQL search
	}


	# ------ search unanchored at end
	if (m/%$/o) {
		;			# do nothing


	# ------ search not anchored at end, but ends with escaped '$'
	} elsif (m/\\\$$/o) {
		s/\\\$$/\$/o;		# allow escaped '$'
		$_ .= "%";		# convert to unanchored SQL search


	# ------ search anchored at end
	} elsif (m/\$$/o) {
		s/\$$//o;		# convert to anchored at end SQL search


	# ------ search not anchored at end
	} else {
		$_ .= "%";		# convert to unanchored SQL search
	}

	# return converted searchtext
	return $_;
}
1;



# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__