view release on metacpan or  search on metacpan

lib/JSprite.pm  view on Meta::CPAN

		$column_string =~ tr/a-z/A-Z/;   #JWT
	}
	$self->{use_fields} = $column_string;    #JWT
    @columns = split (/\,/o, $column_string);

    foreach $column (@columns) {
	#$status = 0 unless ($self->{fields}->{$column});  #20000114
		unless ($self->{fields}->{$column})
		{
			$errdetails = $column;
			$status = 0;
		}
	}

    return $status;
}

sub parse_columns
{
	my ($self, $command, $column_string, $condition, $values, 
			$ordercols, $descorder, $fields, $distinct) = @_;
	my ($i, $j, $k, $rowcnt, $status, @columns, $single, $loop, $code, $column);
	my (%colorder, $rawvalue);
	my (@result_index);   #ADDED 20020709 TO SUPPORT SORTING ON COLUMNS NOT IN RESULT-SET.

	my ($psuedocols) = "CURRVAL|NEXTVAL";   #ADDED 20011019.
	local $results = undef;
	my (@keyfields) = split(',', $self->{key_fields});  #JWT: PREVENT DUP. KEYS.
	my (%valuenames);  #ADDED 20001218 TO ALLOW FIELD-NAMES AS RIGHT-VALUES.
	foreach $i (keys %$values)
	{
#		$valuenames{$i} = $values->{$i};   #MOVED TO BOTTOM OF LOOP 20020522 TO FIX SINGLE-QUOTE-IN-VALUE (-517) BUG!
		$values->{$i} =~ s/^\'(.*)\'$/my ($stuff) = $1; 
		$stuff =~ s|\'|\\\'|gso;
		$stuff =~ s|\\\'\\\'|\\\'|gso;
		"'" . $stuff . "'"/es;
		$values->{$i} =~ s/^\'$//so;      #HANDLE NULL VALUES.
		#$values->{$i} =~ s/\n//gs;       #REMOVE LFS ADDED BY NETSCAPE TEXTAREAS! #REMOVED 20011107 - ALLOW \n IN DATA!
		#$values->{$i} =~ s/\r /\r/gs;    #20000108: FIX LFS PREV. CONVERTED TO SPACES! #REMOVED 20011107 (SHOULDN'T NEED ANYMORE).
		$values->{$i} = "''"  unless ($values->{$i} =~ /\S/o);
		$valuenames{$i} = $values->{$i};
	}
	local $SIG{'__WARN__'} = sub { $status = -510; $errdetails = "$_[0] at ".__LINE__ };
	local $^W = 0;
	local ($_);
	$status  = 1;
	$results = [];
	@columns = split (/,/o, $column_string);

	if ($command eq 'update')  #ADDED NEXT 11 LINES 20011029 TO PROTECT AUTOSEQUENCE FIELDS FROM UPDATES.
	{
		foreach my $i (@columns)
		{
			if (${$self->{types}}{$i} =~ /AUTO/o)
			{
				$errdetails = $i;
				return (-525);
			}
		}
	}
	#$single  = ($#columns) ? $columns[$[] : $column_string;
	$single  = ($#columns) ? $columns[$#columns] : $column_string;
	$rowcnt = 0;

	my (@these_results);
	my ($skipreformat) = 0;
	my ($colskipreformat) = 0;
	my (@types);
	my (@coltypes);
	@coltypes = ();
	for (my $i=0;$i<=$#columns;$i++)
	{
		push (@coltypes, (${$self->{types}}{$columns[$i]} =~ /$REFTYPES/o));
	}
	if ($fields)
	{
		@types = ();
		for (my $i=0;$i<=$#{$fields};$i++)
		{
			#$_ = (${$self->{types}}{$columns[$i]} =~ /$REFTYPES/o);
			push (@types, ((${$self->{types}}{$columns[$i]} =~ /$REFTYPES/o)||0));
		}
	}
	else
	{
		push (@$results, [ @$_{@columns} ]);
		for (my $i=0;$i<=@{$_{@columns}};$i++)
		{
			#$_ = (${$self->{types}}{$i} =~ /$REFTYPES/o);
			push (@types, ((${$self->{types}}{$i} =~ /$REFTYPES/o)||0));
		}
	}
	my $blobfid;
	my $jj;
	$self->{sprite_reclimit} ||= $self->{sprite_sizelimit};  #ADDED 20020530 FOR SQL-PERL PLUS!
	for ($loop=0; $loop < scalar @{ $self->{records} }; $loop++)
	{
		next unless (defined $self->{records}->[$loop]);    #JWT: DON'T RETURN BLANK DELETED RECORDS.
		$_ = $self->{records}->[$loop];
		$@ = '';
#####print "<<<<<<< JSPRITE EVAL CONDITION=$condition=\n";
		if ( !$condition || (eval $condition) )
		{
			if ($command eq 'select')
			{
				last  if ($self->{sprite_reclimit} && $loop >= $self->{sprite_reclimit});  #ADDED 20020123 TO SPEED UP INFO-ONLY. FETCHES.
				if ($fields)
				{
					@these_results = ();
					for (my $i=0;$i<=$#{$fields};$i++)
					{
						$fields->[$i] =~ s/($self->{column}\.(?:$psuedocols))\b/&pscolfn($self,$1)/eg;  #ADDED 20011019
						$rawvalue = eval $fields->[$i];
						if ($types[$i] && $rawvalue =~ /^\d+$/o)    #A LONG (REFERENCED) TYPE
						{
							$blobfid = $self->{directory}
									.$self->{separator}->{ $self->{platform} }
									.$self->{table}."_${rawvalue}_$$.tmp";
							if (open(FILE, "<$blobfid"))
							{
								binmode FILE;