view release on metacpan or  search on metacpan

lib/SQL/YASP.pm  view on Meta::CPAN

	# 
	$i = 0;
	$dtokens = $self->{'double_word_tokens'};
	
	while ($i < $#rv) {
		my $el = $rv[$i];
		
		# if this is a double_word token
		unless (ref $el) {
			if ($dtokens->{$el}) {
				if ( (! ref($rv[$i+1])) && exists $dtokens->{$el}->{$rv[$i+1]} )
					{$rv[$i] = $rv[$i] . ' ' . splice(@rv, $i+1, 1)}
			}
		}
		
		$i++;
	}
	# 
	# compact double word tokens
	#-------------------------------------------------
	
	
	# unquote if necessary
	#if ($opts{'unquote'}) {
	#	foreach my $el (@rv)
	#		{$el = unquote($el)}
	#}
	
	# remove empty elements
	@rv = grep {length($_)} @rv;
	
	
	return @rv;
}
# 
# sql_split
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# misc short subs
# 
sub joinfield {
	my($val) = join('', @_);
	$val =~ s|^\s+||s;
	$val =~ s|\s+$||s;
	return $val;
}

# this could probably be done a lot more efficiently
sub unquote {
	my ($rv) = @_;
	
	# remove outer quotes
	if ($rv =~ s|^'(.*)'$|$1|s)
		{$rv =~ s|''|'|sg}
	elsif ($rv =~ s|^"(.*)"$|$1|s)
		{$rv =~ s|""|"|sg}
	
	# escapes
	my @sets = split m|(\\.)|, $rv;
	
	grep {
		s|\\0|$nullchar|o;
		s|\\z|$wineof|o;
		s|\\t|\t|;
		s|\\r|\r|;
		s|\\n|\n|;
		s|\\b|\b|;
		s|\\(.)|$1|;
		} @sets;	
	
	return join('', @sets);
}

sub count_ops {
	return
		keys(%SQL::YASP::Expr::bin) + 
		keys(%SQL::YASP::Expr::functions);
}

sub default_ops {
	return [@SQL::YASP::Expr::dbin];
}

sub default_functions {
	return {%SQL::YASP::Expr::dfuncs};
}


# 
# misc short subs
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# arr_split
# 
# splits an array into an array of arrays
# 
sub arr_split {
	my ($del_arr, $outer, %opts) = @_;
	my (@current, @rv, %dels, $firstdone);
	ref($outer) or return $outer;
	$opts{'max'} and $opts{'max'}--;
	@dels{@$del_arr} = ();
	
	foreach my $el (@$outer) {

		if (  (! ref $el) && exists($dels{$el}) && ($opts{'max'} ? @rv<$opts{'max'} : 1)  ) {
			if ($opts{'keep_del_back'})
				{push @current, $el}
			
			if ($firstdone || @current)
				{push @rv, [@current]}
			$firstdone = 1;
			
			@current = ();
			
			if ($opts{'keep_del_front'})
				{push @current, $el}