File Coverage

blib/lib/Search/QueryBuilder.pm

Criterion	Covered	Total	%
statement	12	117	10.2
branch	0	44	0.0
condition	0	6	0.0
subroutine	4	15	26.6
pod	0	11	0.0
total	16	193	8.2

package Search::QueryBuilder;

use 5.008007;
use strict;
use warnings;
use Data::Dumper;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw( testme getTokenizedString tokenizeString

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.01';


# Preloaded methods go here.

sub new {
	my $package = shift;
 	my $self= {
           _booleantags=> undef,
                 };
	#return bless({}, $package);
	return bless ($self,$package);
}

sub tags{
       my ( $self, @tags) = @_;
	   my @defaulttags=("AND","OR","NOT");
       @{$self->{_booleantags}} = @tags if @tags ;
       if( defined(@{$self->{_booleantags}})) {
		   return @{$self->{_booleantags}};
	   } else {
		   return @defaulttags;
	   };
}


sub getTokenizedString {
	my ($self,$query)=@_;

	my @temp;
	my @temp2;
	my @temp3;
	my @tagbag=$self->tags;
	push(@temp2,tokenizeString($query,@temp));
	#temp2 currently represents a tokenized string

	my $previous="";
	# this cleans out most obvious mistakes

	# Uppercase the tagbag tags...
	for(my $i=0;$i<$#temp2;$i++){
		my $test=uc($temp2[$i]);
		if((grep /^$test$/,@tagbag)>0){
			$temp2[$i]=uc($temp2[$i]);

		}
	}
	foreach my $tempvar (@temp2){
		# get rid of duplicates
		if($previous eq $tempvar){

		# or multiple commands (ie AND AND or NOT AND)
		} elsif((grep /^$previous$/,@tagbag)>0 && (grep /^$tempvar$/,@tagbag)>0){

		}else {
			push(@temp3,$tempvar);
		}
		$previous=$tempvar;
	}

	# Look for and remove dangling AND OR and NOT
	my $poss=($temp3[$#temp3]);
	while((grep /^$poss$/, @tagbag) >0){
		# Remove ands ors and nots from the end, where they are a bit meaningless
		pop(@temp3);
		$poss=($temp3[$#temp3]);
	}

	return @temp3;
}

sub testme {
	#my $myfoo="    Bah     FOOOO GRAH BLITHER    ";
	#print ltrim($myfoo)."\n";
	#print rtrim($myfoo)."\n";
	#print atrim($myfoo)."\n";
	#print removeAll($myfoo, "A")."\n";
	#print findNearestPrevious("I am a quite long string",12,'q')."\n";
	#print tokenizeString("I am a \"fish\" and so are you")."\n";
	#print tokenizeString("I am a \"fish and so are you")."\n";
	#print tokenizeString("I am a -\"fish +\"and so\" are you")."\n";
	#print tokenizeString("I am a +\"fish +\"and so\" are you")."\n";
	#print tokenizeString("-I +am a fish and so are you too ")."\n";
	#print tokenizeString("I am a -\"fish\"and so\" are you")."\n";
	my @temp;
	my @temp2;
	push(@temp2,tokenizeString("  +\"I am\" a -\"fishy character\" and so\" is Bob",@temp));
	#print "Result: ".Data::Dumper->Dump([@temp2])."\n";
	print "Result: ".join(" ",@temp2)."\n";
}
sub atrim {
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}
# Left trim function to remove leading whitespace
sub ltrim {
	my $string = shift;
	$string =~ s/^\s+//;
	return $string;
}
# Right trim function to remove trailing whitespace
sub rtrim {
	my $string = shift;
	$string =~ s/\s+$//;
	return $string;
}

sub removeAll{
	my ($source,$replaceme)=@_;
	$source=~s/$replaceme//g;
	return $source;
}

sub findNearestPrevious {
	my ($string, $currentidx,$char)=@_;
	my $tmpvar=$currentidx;
	my @charsinstring=split(//,$string);
	while($tmpvar>-1){
		if($charsinstring[$tmpvar] eq $char){
			return $tmpvar;
		}
		$tmpvar--;
	}
	return $tmpvar;

}

sub tokenizeString {
	my ($query,@response)=@_;
	$query=removeAll($query,"\'");
	atrim($query);
	my @tempresponse;
	if($query eq ""){
		return @response;
	}
	if(index($query,"\"")<0){
		# Oh jolly good, no quotation marks
		my @splitterms=split(/ /,$query);

		foreach my $termlet (@splitterms){
			if(substr($termlet,0,1) eq '-'){
				push(@tempresponse,"NOT");
				push(@tempresponse,substr($termlet,1,length($termlet)));

			} elsif (substr($termlet,0,1) eq '+'){
				push(@tempresponse,"AND");
				push(@tempresponse,substr($termlet,1,length($termlet)));
			} else {
				push(@tempresponse,$termlet);
			}
			#print "Current contents: ".join(Data::Dumper->Dump([@response]),",");
			# print "Current contents: ".join(",",@response)."\n";
		}

	} else {
		# bugger. We have quotation marks - repeat, we have quotation marks
		my $firstIndex=index($query,"\"");
		my $secondIndex=index($query,"\"",$firstIndex+1);
		my $testVar=$secondIndex-$firstIndex;
		if($testVar>-1 && $testVar<2){ # empty quotes?! - sod it
	 	} elsif($testVar<0){ # ... lone lost little quote in middle of nowhere. Put it out of misery
			$query=removeAll($query,"\"");
			push(@tempresponse,tokenizeString($query,@response));
		} elsif ($firstIndex<1){ # first quote at beginning of string...
			push(@tempresponse, substr($query,$firstIndex+1,$testVar-1));
			if($secondIndex
				#push(@response,tokenizeString(substr($query,$secondIndex+1,length($query)-$secondIndex+1),@response));
				push(@tempresponse,tokenizeString(substr($query,$secondIndex+1,length($query)-$secondIndex+1),@response));
			}
		} else { # first quote not at beginning of string. First quote somewhere random
			my $firstminusone=$firstIndex-1;
			if(substr($query,$firstIndex-1,1)  eq " "){
					# this is fine for most instances, but sometimes there's a - or a + in the way
					# deal with the most instances first
				push(@tempresponse,tokenizeString(substr($query,0,$firstIndex)));
				push(@tempresponse,substr($query,$firstIndex+1,$testVar-1));
				if($secondIndex
					push(@tempresponse,tokenizeString(substr($query,$secondIndex+1,length($query)-$secondIndex)));
				}

			} else { # there' s a - or + before the "!! the (*&£$(*&!'s!
				my $thirdIndex=findNearestPrevious($query,$firstIndex," ");

				if($thirdIndex<0){ # no space start of query
					if(substr($query,0,1) eq "-"){
						push(@tempresponse,"NOT");
						push(@tempresponse,substr($query,2,$testVar-1));
					} elsif(substr($query,0,1) eq "+"){
						push(@tempresponse,"AND");
						push(@tempresponse,substr($query,2,$testVar-1));
					} else {
						push(@tempresponse,substr($query,0,$testVar-1));

					}


				} else { # there's a - or + before the ", and we are not at the start of the string...
					# push(@response,substr($query,0,$thirdIndex));
					push(@tempresponse,tokenizeString(substr($query,0,$thirdIndex),@response));
					if(substr($query,$thirdIndex+1,1) eq '-'){ # oh look, a -
						push(@tempresponse,"NOT");
						$thirdIndex++;
					}elsif(substr($query,$thirdIndex+1,1) eq '+'){
						push(@tempresponse,"AND");
						$thirdIndex++;
					}
					push(@tempresponse,substr($query,$thirdIndex+2,$secondIndex-$thirdIndex-2));


				}
				if($secondIndex
					# yet more to play with?
					push(@tempresponse,tokenizeString(substr($query,$secondIndex+2,length($query)-$secondIndex),@response));


				}
			}



		}


	}
	return @tempresponse;
}

sub build{
	my $self = shift;
	return;
}

1;
__END__