view release on metacpan or  search on metacpan

lib/JLdap.pm  view on Meta::CPAN

				$QS[$qsindx] = $self->{ldap_nullsearchvalue}  unless (length($QS[$qsindx]));
			}
			$P[$indx] = "!($P[$indx])"  if ($regex == 2 || $opr eq '!=' || ($opr eq '=' && !length($QS[$qsindx])));  #INVERT EXPRESSION IF "NOT"!
			$P[$indx] =~ s!\!\=!\=!o;   #AFTER INVERSION, FIX "!=" (NOT VALID IN LDAP!)
			"\$P\[$indx]";
	/ei);    #CASE-INSENSITIVITY ADDED NEXT 2: 20050416 PER PATCH BY jmorano
	$self->{tindx} = 0;
	$s = &parseParins($self, $s);

	for (my $i=0;$i<=$#T;$i++)
	{
#		1 while ($T[$i] =~ s/(.+?)\s*\band\b\s*(.+)/\&\($1\)\($2\)/i);
		1 while ($T[$i] =~ s/([^\(\)]+)\s*\band\b\s*([^\(\)]+)(?:and|or)?/\&\($1\)\($2\)/i);
		1 while ($T[$i] =~ s/([^\(\)]+)\s*\bor\b\s*([^\(\)]+)(?:and|or)?/\|\($1\)\($2\)/i);
	}
	$s =~ s/AND/and/igo;
	$s =~ s/OR/or/igo;
#	1 while ($s =~ s/(.+?)\s*\band\b\s*(.+)/\(\&\($1\)\($2\)\)/i);   #CASE-INSENSITIVITY ADDED NEXT 2: 20050416 PER PATCH BY jmorano
	1 while ($s =~ s/([^\(\)]+)\s*\band\b\s*([^\(\)]+)(?:and|or)?/\&\($1\)\($2\)/i);   #CASE-INSENSITIVITY ADDED NEXT 2: 20050416 PER PATCH BY jmorano
	1 while ($s =~ s/([^\(\)]+)\s*\bor\b\s*([^\(\)]+)(?:and|or)?/\|\($1\)\($2\)/i);   #CASE-INSENSITIVITY ADDED NEXT 2: 20050416 PER PATCH BY jmorano
	1 while ($s =~ s/\bnot\b\s*([^\s\)]+)?/\!\($1\)/);
	1 while ($s =~ s/\$T\[(\d+)\]/$T[$1]/g);
	$s =~ s/(\w+)\s+is\s+not\s+null?/$1\=\*/gi;
	$s =~ s/(\w+)\s+is\s+null?/\!\($1\=\*\)/gi;

	#CONVERT SQL WILDCARDS TO PERL REGICES.

	1 while ($s =~ s/\$P\[(\d+)\]/$P[$1]/g);
	$s =~ s/ +//go;
	1 while ($s =~ s/\$QS\[(\d+)\]/$QS[$1]/g);
	$s =~ s/\x04/\'/go;    #UNPROTECT AND UNESCAPE QUOTES WITHIN QUOTES.
	$s = '(' . $s . ')'  unless ($s =~ /^\(/o);
	return $s;
}

sub parseParins
{
	my $self = shift;
	my $s = shift;

	$self->{tindx}++ while ($s =~ s/\(([^\(\)]+)\)/
			$T[$self->{tindx}] = &parseParins($self, $1); "\$T\[$self->{tindx}]"
	/e);
	return $s;
}

sub rollback
{
	my ($self) = @_;

	my ($status) = 1;
	my ($dbh) = $self->FETCH('ldap_dbh');
	my ($autocommit) = $dbh->FETCH('AutoCommit');

	$status = $dbh->rollback()  unless ($autocommit);

	$self->{dirty} = 0  if ($status > 0);
	return $status;
}

sub update
{
	my ($self, $csr, $query) = @_;
	my ($i, $path, $regex, $table, $extra, @attblist, $filter, $all_columns);
	my $status = 0;
	my ($psuedocols) = "CURVAL|NEXTVAL|ROWNUM";
#print STDERR "-update10 sql=$query=\n";
    ##++
    ##  Hack to allow parenthesis to be escaped!
    ##--

	$query =~ s/\\([()])/sprintf ("%%\0%d: ", ord ($1))/ge;
	$path  =  $self->{path};
	$regex =  $self->{column};

	if ($query =~ /^update\s+($path)\s+set\s+(.+)$/i)
	{
		($table, $extra) = ($1, $2);
#print STDERR "-update20: table=$table= extra=$extra=\n";
		#ADDED IF-STMT 20010418 TO CATCH 
		#PARENTHESIZED SET-CLAUSES (ILLEGAL IN ORACLE & CAUSE WIERD PARSING ERRORS!)

		if ($extra =~ /^\(.+\)\s*where/io)
		{
			$errdetails = 'parenthesis around SET clause?';
			return (-504);
		}
		$table =~ tr/A-Z/a-z/  unless ($self->{CaseTableNames});  #JWT:TABLE-NAMES ARE NOW CASE-INSENSITIVE!
		$self->{file} = $table;

		my ($dbh) = $csr->FETCH('ldap_dbh');
		my ($ldap) = $csr->FETCH('ldap_ldap');
		my ($tablehash) = $dbh->FETCH('ldap_tables');
		return (-524)  unless ($tablehash->{$table});
		my ($base, $objfilter, $dnattbs, $allattbs, $alwaysinsert) = split(/\:/,$tablehash->{$table});

		$all_columns = {};

		$extra =~ s/\\\\/\x02/go;         #PROTECT "\\"
		#1$extra =~ s/\'\'/\x03\x03/go;    #PROTECT '', AND \'.
		$extra =~ s/\\\'/\x03/go;    #PROTECT '', AND \'.

		$extra =~ s/^\s+//o;  #STRIP OFF SURROUNDING SPACES.
		$extra =~ s/\s+$//o;

		#NOW TEMPORARILY PROTECT COMMAS WITHIN (), IE. FN(ARG1,ARG2).

		$column = $self->{column};
		$extra =~ s/($column\s*\=\s*)\'(.*?)\'(,|$)/
				my ($one,$two,$three) = ($1,$2,$3);
				$two =~ s|\,|\x05|go;
				$two =~ s|\(|\x06|go;
				$two =~ s|\)|\x07|go;
				$one."'".$two."'".$three;
		/eg;

		1 while ($extra =~ s/\(([^\(\)]*)\)/
				my ($args) = $1;
				$args =~ s|\,|\x05|go;
				"\x06$args\x07";
		/eg);