view release on metacpan or  search on metacpan

lib/modules/WTJSprite.pm  view on Meta::CPAN

		$fields .= ${$self->{order}}[$i] . '=';
		for ($j=0;$j<=$#keyfields;$j++)  #JWT: MARK KEY FIELDS.
		{
			$fields .= '*'  if (${$self->{order}}[$i] eq $keyfields[$j])
		}
		#$fields .= ${$self->{types}}{${$self->{order}}[$i]} . '('   #CHGD. TO NEXT 20020110
		#		. ${$self->{lengths}}{${$self->{order}}[$i]};
		$fields .= ${$self->{types}}{${$self->{order}}[$i]};
		unless (${$self->{types}}{${$self->{order}}[$i]} =~ /$BLOBTYPES/)
		{
			$fields .= '(' . ${$self->{lengths}}{${$self->{order}}[$i]};
			if (${$self->{scales}}{${$self->{order}}[$i]} 
					&& ${$self->{types}}{${$self->{order}}[$i]} =~ /$NUMERICTYPES/)
			{
				$fields .= ',' . ${$self->{scales}}{${$self->{order}}[$i]}
			}
			#$fields .= ')' . $self->{_write};
			$fields .= ')';
		}
		$fields .= '='. ${$self->{defaults}}{${$self->{order}}[$i]}  
				if (length(${$self->{defaults}}{${$self->{order}}[$i]}));
		$fields .= $self->{_write};
	}
	$fields =~ s/$self->{_write}$//;

	#$fields =~ tr/a-z/A-Z/;   #JWT:MAKE SURE COLUMNS are UPPERCASE!
	if ($CBC && $self->{sprite_Crypt} <= 2)  #ADDED: 20020109
	{
		print FILE $CBC->encrypt($fields).$/;
	}
	else
	{
		print FILE "$fields$/";
	}

	for ($loop=0; $loop < scalar @{ $self->{records} }; $loop++) {
	    $record = $self->{records}->[$loop];

	    next unless (defined $record);

         $record_string = '';

 	    foreach $column (@{ $self->{order} })
 	    {
			if (${$self->{types}}{$column} eq 'CHAR') #20000224
			{
				$value = sprintf(
						'%-'.${$self->{lengths}}{$column}.'s',
						$record->{$column});
			}
			#elsif (${$self->{types}}{$column} =~ /$NUMERICTYPES/)
			#{
			#	$value = sprintf(('%.'.${$self->{scales}}{$column}.'f'), 
			#			$record->{$column});
			#}
			else
			{
				$value = $record->{$column};
			}

			#NEXT 2 ADDED 20020111 TO PERMIT EMBEDDED RECORD & FIELD SEPERATORS.
			$value =~ s/$self->{_record}/\x02\^0jSpR1tE\x02/gs;   #PROTECT EMBEDDED RECORD SEPARATORS.
			$value =~ s/$self->{_write}/\x02\^1jSpR1tE\x02/gs;   #PROTECT EMBEDDED RECORD SEPARATORS.
			$record_string .= "$self->{_write}$value";
	    }

	    #$record_string =~ s/^$self->{_write}//o;  #CHGD TO NEXT LINE 20010917.
	    $record_string =~ s/^$self->{_write}//s;

		if ($CBC && $self->{sprite_Crypt} <= 2)  #ADDED: 20020109
		{
			print FILE $CBC->encrypt($record_string).$/;
		}
		else
		{
		    print FILE "$record_string$/";
		}
	}

	close (FILE);

	my (@stats) = stat ($new_file);
	$self->{timestamp} = $stats[9];

        $self->unlock || $self->display_error (-516);
    } else {
		$status = ($status < 1) ? $status : -511;
    }
    return $status;
}

sub load_database 
{
    my ($self, $file) = @_;
    my ($i, $header, @fields, $no_fields, @record, $hash, $loop, $tp, $dflt);
    local (*FILE);
	local ($/);
	if ($CBC && $self->{sprite_Crypt} != 2)  #ADDED: 20020109
	{
		$/ = "\x03^0jSp".$self->{_record};    #JWT:SUPPORT ANY RECORD-SEPARATOR!
	}
	else
	{
		$/ = $self->{_record};    #JWT:SUPPORT ANY RECORD-SEPARATOR!
	}

	########$file =~ tr/A-Z/a-z/  unless ($self->{CaseTableNames});  #JWT:TABLE-NAMES ARE NOW CASE-INSENSITIVE!
	$thefid = $file;
    open (FILE, $file) || return (-501);
	binmode FILE;   #20000404

	if (($^O eq 'MSWin32') or ($^O =~ /cygwin/i))
	{
		$self->lock || $self->display_error (-515);
	}
	else    #GOOD, MUST BE A NON-M$ SYSTEM :-)
	{
		eval { flock (FILE, $WTJSprite::LOCK_EX) || die };

		if ($@)
		{
			$self->lock || $self->display_error (-515)  if ($@);
		}

lib/modules/WTJSprite.pm  view on Meta::CPAN

	foreach $i (0..$#fields)
	{
		$dflt = undef;
		($fields[$i],$tp,$dflt) = split(/=/,$fields[$i]);
		$fields[$i] =~ tr/a-z/A-Z/;
		$tp = 'VARCHAR(40)'  unless($tp);
		$tp =~ tr/a-z/A-Z/;
		$self->{key_fields} .= $fields[$i] . ',' 
				if ($tp =~ s/^\*//);   #JWT:  *TYPE means KEY FIELD!
		$ln = 40;
		$ln = 10  if ($tp =~ /NUM|INT|FLOAT|DOUBLE/);
		#$ln = 5000  if ($tp =~ /$BLOBTYPES/);   #CHGD. 20020110.
		$ln = $self->{LongReadLen} || 0  if ($tp =~ /$BLOBTYPES/);
		$ln = $2  if ($tp =~ s/(.*)\((.*)\)/$1/);
		${$self->{types}}{$fields[$i]} = $tp;
		${$self->{lengths}}{$fields[$i]} = $ln;
		${$self->{defaults}}{$fields[$i]} = undef;
		${$self->{defaults}}{$fields[$i]} = $dflt  if (defined $dflt);
		if (${$self->{lengths}}{$fields[$i]} =~ s/\,(\d+)//)
		{
			#NOTE:  ORACLE NEGATIVE SCALES NOT CURRENTLY SUPPORTED!
			
			${$self->{scales}}{$fields[$i]} = $1;
		}
		elsif (${$self->{types}}{$fields[$i]} eq 'FLOAT')
		{
			${$self->{scales}}{$fields[$i]} = ${$self->{lengths}}{$fields[$i]} - 3;
		}
		${$self->{scales}}{$fields[$i]} = '0'  unless (${$self->{scales}}{$fields[$i]});
	
		# (JWT 8/8/1998) $self->{use_fields} .= $column_string . ',';    #JWT
		$self->{use_fields} .= $fields[$i] . ',';    #JWT
	}
	chop ($self->{use_fields})  if ($self->{use_fields});  #REMOVE TRAILING ','.
	chop ($self->{key_fields})  if ($self->{key_fields});

    undef %{ $self->{fields} };
    undef @{ $self->{order}  };

    $self->{order} = [ @fields ];
	$self->{fieldregex} = $self->{use_fields};
	$self->{fieldregex} =~ s/,/\|/g;

    map    { $self->{fields}->{$_} = 1 } @fields;
    undef @{ $self->{records} } if (scalar @{ $self->{records} });

    while (<FILE>) {
	chomp;
	#chop;     #JWT:SUPPORT ANY RECORD-SEPARATOR!
	$t = $_;
	$_ = $CBC->decrypt($t)  if ($CBC && $self->{sprite_Crypt} != 2);  #ADDED: 20020109

	next unless ($_);

	#@record = split (/$self->{_read}/o, $_);  #CHGD TO NEXT LINE 20010917.
	@record = split (/$self->{_read}/s, $_);

	$hash = {};

	for ($loop=0; $loop <= $no_fields; $loop++) {
		#NEXT 2 ADDED 20020111 TO PERMIT EMBEDDED RECORD & FIELD SEPERATORS.
		$record[$loop] =~ s/\x02\^0jSpR1tE\x02/$self->{_record}/gs;   #RESTORE EMBEDDED RECORD SEPARATORS.
		$record[$loop] =~ s/\x02\^1jSpR1tE\x02/$self->{_read}/gs;   #RESTORE EMBEDDED RECORD SEPARATORS.
	    $hash->{ $fields[$loop] } = $record[$loop];
	}

	push @{ $self->{records} }, $hash;
    }
	
    close (FILE);

    $self->unlock || $self->display_error (-516);

    return (1);
}

sub pscolfn
{
	my ($self,$id) = @_;
	return $id  unless ($id =~ /CURVAL|NEXTVAL/);
	my ($value) = '';
	my ($seq_file,$col) = split(/\./,$id);
	$seq_file = $self->get_path_info($seq_file) . '.seq';
#	$seq_file =~ tr/A-Z/a-z/  unless ($self->{CaseTableNames});  #JWT:TABLE-NAMES ARE NOW CASE-INSENSITIVE! - REMOVED 20011218 (get_path_info HANDLES THIS RIGHT!)
	#open (FILE, "<$seq_file") || return (-511);
	unless (open (FILE, "<$seq_file"))
	{
		$errdetails = "$@/$? (file:$seq_file)";
		return (-511);
	}
	$x = <FILE>;
	#chomp($x);
	$x =~ s/\s+$//;   #20000113
	($incval, $startval) = split(/,/,$x);
	close (FILE);
	if ($id =~ /NEXTVAL/)
	{
		#open (FILE, ">$seq_file") || return (-511);
		unlink ($seq_file)  if ($self->{sprite_forcereplace} && -e $seq_file);  #ADDED 20010912.
		unless (open (FILE, ">$seq_file"))
		{
			$errdetails = "$@/$? (file:$seq_file)";
			return (-511);
		}
		$incval += ($startval || 1);
		print FILE "$incval,$startval\n";
		close (FILE);
	}
	$value = $incval;
	return $value;
}

##++
##  NOTE: Derived from lib/Text/ParseWords.pm. Thanks Hal!
##--

sub quotewords {   #SPLIT UP USER'S SEARCH-EXPRESSION INTO "WORDS" (TOKENISE)!

# THIS CODE WAS COPIED FROM THE PERL "TEXT" MODULE, (ParseWords.pm),
# written by:  Hal Pomeranz (pomeranz@netcom.com), 23 March 1994
# (Thanks, Hal!)
# MODIFIED BY JIM TURNER (6/97) TO ALLOW ESCAPED (REGULAR-EXPRESSION)
# CHARACTERS TO BE INCLUDED IN WORDS AND TO COMPRESS MULTIPLE OCCURRANCES