view release on metacpan or  search on metacpan

lib/JSprite.pm  view on Meta::CPAN

			#$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}$//;
	}

	if ($self->{CBC} && $self->{sprite_Crypt} <= 2)  #ADDED: 20020109
	{
		print FILE $self->{CBC}->encrypt($fields).$/;
	}
	else
	{
		print FILE "$fields$/";
	}
	my $rsinit = ($self->{_write} =~ /^xml/io) ? "  <row>\n" : '';
	my $rsend = $rsinit ? "  </row>\n" : '';

	for ($loop=0; $loop < $reccnt; $loop++) {
		#++$loop1;
	    $record = $self->{records}->[$loop];

	    next unless (defined $record);

		$record_string = $rsinit;
		#$record_string =~ s/\?/$loop1/;

 	    foreach $column (@{ $self->{order} })
 	    {
			#if (${$self->{types}}{$column} eq 'CHAR') #CHGD. TO NEXT 20030812.
			if (${$self->{types}}{$column} eq 'CHAR' && length($record->{$column}) > 0)
			{
				$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/gso;   #PROTECT EMBEDDED RECORD SEPARATORS.
			$value =~ s/$self->{_write}/\x02\^1jSpR1tE\x02/gso;   #PROTECT EMBEDDED RECORD SEPARATORS.
			$record_string .= $rsinit ? (&xmlescape($column,$value)."\n") 
					: "$self->{_write}$value";
	    }

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

		if ($self->{CBC} && $self->{sprite_Crypt} <= 2)  #ADDED: 20020109
		{
			print FILE $self->{CBC}->encrypt($record_string).$/;
		}
		else
		{
		    print FILE "$record_string$/";
		}
	}
	if ($rsend)
	{
		$rsend = " </select>\n</database>\n";
		if ($self->{CBC} && $self->{sprite_Crypt} <= 2)  #ADDED: 20020109
		{
			print FILE $self->{CBC}->encrypt($rsend).$/;
		}
		else
		{
		    print FILE "$rsend$/";
		}
	}
	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;
}

{
	my %xmleschash = (
		'<' => '&lt;',
		'>' => '&gt;',
		'"' => '&quot;',
		'--' => '&#45;&#45;',
	);
	sub xmlescape
	{
		my $res;

		$_[1] =~ s/\&/\&amp;/gs;
		eval "\$_[1] =~ s/(".join('|', keys(%xmleschash)).")/\$xmleschash{\$1}/gs;";
		#$_[1] =~ s/([\x01-\x1b\x7f-\xff])/"\&\#".ord($1).';'/egs;
		if ($_[1] =~ /[\x00-\x08\x0A-\x0C\x0E-\x19\x7f-\xff]/o)
		{
			return "   <$_[0] xml:encoding=\"base64\">" 
					. MIME::Base64::encode_base64($_[1]) . "</$_[0]>";
		}

lib/JSprite.pm  view on Meta::CPAN

		($header)  = /^ *(.*?) *$/o;
		#####################$header =~ tr/a-z/A-Z/;   #JWT  20000316
	    #@fields    = split (/$self->{_read}/o, $header);  #CHGD TO NEXT LINE 20021216.
		@fields    = split (/\Q$self->{_read}\E/, $header);
		$no_fields = $#fields;

		undef %{ $self->{types} };
		undef %{ $self->{lengths} };
		undef %{ $self->{scales} };   #ADDED 20000306.

		my $ln;
		foreach $i (0..$#fields)
		{
			$dflt = undef;
			($fields[$i],$tp,$dflt) = split(/\=/o ,$fields[$i]);
			$fields[$i] =~ tr/a-z/A-Z/  unless ($self->{sprite_CaseFieldNames});
			$tp = 'VARCHAR(40)'  unless($tp);
			$tp =~ tr/a-z/A-Z/;
			$self->{key_fields} .= $fields[$i] . ',' 
					if ($tp =~ s/^\*//o);   #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
		}

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

			next unless ($_);

			#@record = split (/$self->{_read}/s, $_);   #CHGD. TO NEXT LINE 20021216
			@record = split (/\Q$self->{_read}\E/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);
	}

	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/,/\|/go;

	map    { $self->{fields}->{$_} = 1 } @fields;

    return (1);
}

sub load_columninfo
{
	my ($self) = shift;
	my ($sep) = shift;

	my $colmlist;

	if ($#{$self->{order}} >= 0)
	{
		$colmlist = join($sep, @{$self->{order}});
	}
	else
	{
		local (*FILE);
		local ($_);
		local ($/) = $self->{_record};    #JWT:SUPPORT ANY RECORD-SEPARATOR!
	
		open(FILE, $self->{file}) || return -501;
		binmode FILE;         #20000404
		if ($self->{_read} =~ /^xml/io)
		{
			return -531  if ($self->{CBC} && $self->{sprite_Crypt} <= 2);
			return -532  unless ($XMLavailable);
	
			my $xs1 = XML::Simple->new();
			my $xmltext = '';
			my $xmldoc;
#			eval {$xmldoc = $xs1->XMLin($self->{file}, suppressempty => undef); };
			while (<FILE>)
			{
				last  if (/^\s*\<row.*\>\s*$/o);
				$xmltext .= $_;
			}
			$xmltext .= <<END_XML;  #MAKE IT WELL-FORMED!