view release on metacpan or  search on metacpan

lib/JSprite.pm  view on Meta::CPAN

				push (@descorder, $descorder);  #20020708
			}
			#$orderclause =~ s/,\s+/,/g;
			for $i (0..$#ordercols)
			{
				$ordercols[$i] =~ s/\s//go;
				$ordercols[$i] =~ s/[\(\)]+//go;
			}
		}
		#if ($extra =~ /^\s+where\s*(.+)$/i)  #20011129
		if ($extra =~ /^\s+where\s*(.+)$/iso)
		{
		    $condition = $self->parse_expression ($1);
		}
		if ($column_stuff =~ /\*/o)
		{
			@fields = @{ $self->{order} };
			$columns = join (',', @fields);
			if ($self->{sprite_CaseFieldNames})
			{
				for (my $i=0;$i<=$#fields;$i++)
				{
					$fields[$i] =~ s/([^\,]+)/\$\$\_\{$1\}/g;
				}
			}
			else
			{
				for (my $i=0;$i<=$#fields;$i++)
				{
					#$fields[$i] =~ s/([^\,]+)/\$\$\_\{\U$1\E\}/g;  #CHGD. TO NEXT 20030208 TO FIX WIERD BUG THAT $#?%ED UP NAMES SOMETIMES!
					$fields[$i] =~ s/([^\,]+)/\$\$\_\{$1\}/g;
					$fields[$i] =~ tr/a-z/A-Z/;
				}
			}
		}
		$columns =~ tr/a-z/A-Z/  unless ($self->{sprite_CaseFieldNames});
		$self->check_columns ($columns) || return (-502);
		#$self->{use_fields} = join (',', @{ $self->{order} }[0..$#fields] ) 
		if ($#fields >= 0)
		{
			my (@fieldnames) = @fields;
			for (my $i=0;$i<=$#fields;$i++)
			{
				$fieldnames[$i] =~ s/\(.*$//o;
				$fieldnames[$i] =~ s/\$\_//o;
				$fieldnames[$i] =~ s/[^\w\,]//go;
			}
			$self->{use_fields} = join(',', @fieldnames);
		}
		$values_or_error = $self->parse_columns ('select', $columns, 
				$condition, '', \@ordercols, \@descorder, \@fields, $distinct);    #JWT
		return $values_or_error;
    } 
    else     #INVALID SELECT STATEMENT!
    {
		$errdetails = $query;
		return (-503);
    }
}

sub update
{
    my ($self, $query) = @_;
    my ($i, $path, $regex, $table, $extra, $condition, $all_columns, 
	$columns, $status);
	my ($psuedocols) = "CURRVAL|NEXTVAL";

    ##++
    ##  Hack to allow parenthesis to be escaped!
    ##--

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

    if ($query =~ /^update\s+($path)\s+set\s+(.+)$/ios) {
	($table, $extra) = ($1, $2);
	return (-523)  if ($table =~ /^DUAL$/io);

	#ADDED IF-STMT 20010418 TO CATCH 
			#PARENTHESIZED SET-CLAUSES (ILLEGAL IN ORACLE & CAUSE WIERD PARSING ERRORS!)
	if ($extra =~ /^\(.+\)\s*where/so)
	{
		$errdetails = 'parenthesis around SET clause?';
		return (-504);
	}
	#$thefid = $table;
	#$self->check_for_reload ($table) || return (-501);  #CHGD. TO NEXT 20020110 TO BETTER CATCH ERRORS.
	my $cfr = $self->check_for_reload($table) || -501;
	return $cfr  if ($cfr < 0);

	return (-511)  unless (-w $self->{file});   #ADDED 19991207!

	$all_columns = {};
	$columns     = '';

	$extra =~ s/\\\\/\x02\^2jSpR1tE\x02/gso;         #PROTECT "\\"
	#$extra =~ s/\\\'|\'\'/\x02\^3jSpR1tE\x02/gs;    #PROTECT '', AND \'. #CHANGED 20000303 TO NEXT 2.
	#$extra =~ s/\'\'/\x02\^3jSpR1tE\x02\x02\^3jSpR1tE\x02/gs;    #CHGD. TO NEXT 20040121
	#$extra =~ s/\'\'/\x02\^3jSpR1tE\x02\x02\^8jSpR1tE\x02/gs;    #PROTECT '', AND \'.
	$extra =~ s/\'\'/\x02\^8jSpR1tE\x02/gso;    #PROTECT ''.
	$extra =~ s/\\\'/\x02\^3jSpR1tE\x02/gso;    #PROTECT \'.
	#$extra =~ s/\\\"|\"\"/\x02\^4jSpR1tE\x02/gs;   #REMOVED 20000303.

	#$extra =~ s/^[\s\(]+(.*)$/$1/;  #STRIP OFF SURROUNDING SPACES AND PARINS.
	#$extra =~ s/[\s\)]+$/$1/;
	#$extra =~ s/^[\s\(]+//;  #STRIP OFF SURROUNDING SPACES AND PARINS.
	#$extra =~ s/[\s\)]+$//;
	$extra =~ s/^\s+//so;  #STRIP OFF SURROUNDING SPACES.
	$extra =~ s/\s+$//so;
	#NOW TEMPORARILY PROTECT COMMAS WITHIN (), IE. FN(ARG1,ARG2).
	my $column = $self->{column};
	$extra =~ s/($column\s*\=\s*)\'(.*?)\'(,|$)/
		my ($one,$two,$three) = ($1,$2,$3);
		$two =~ s|\,|\x02\^5jSpR1tE\x02|go;
		$two =~ s|\(|\x02\^6jSpR1tE\x02|go;
		$two =~ s|\)|\x02\^7jSpR1tE\x02|go;
		$one."'".$two."'".$three;
	/egs;

	1 while ($extra =~ s/\(([^\(\)]*)\)/