#!c:/programme/perl/bin/perl.exe -w
# $Id: money_test.cgi 11680 2008-08-28 08:23:27Z mjevans $
use strict; # activate for programming/debugging only
use warnings; # activate for programming/debugging only
use CGI::Carp qw(fatalsToBrowser); # activate for programming/debugging only
use CGI 'param','redirect';
use DBI;
# config variables
our $dsn='dsn'; # Database DSN
our $dbuser='user'; # Database User
our $dbpass='pass'; # Database Password
our $dbtable='test1'; # ProvTable
#################################################################################################
$|=1;
my $dbh = DBI->connect("DBI:ODBC:$dsn", $dbuser, $dbpass, { Taint =>1 }) || die "$DBI::errstr";
$dbh->{RaiseError} = 1; # activate for programming/debugging only
$dbh->{PrintError} = 1; # activate for programming/debugging only
$dbh -> {LongReadLen} = 100000;
$dbh -> {LongTruncOk} = 0;
#$dbh -> {odbc_default_bind_type} = 12; # SQL_VARCHAR
my $action=param('ACTION') || '';
if ($action=~/[^\w]/) { die "bad chars in parameter!" }
if ($action eq 'SAVE_PROV') {&save_prov;}
else {&prov;}
sub prov {
print "content-type: text/html\n\n";
print "Title\n";
print "
\n\n\n";
print "";
print "";
}#///
sub save_prov {
my $sth8 = $dbh->prepare("SELECT ISNULL(TypeName,'') AS TypeName FROM $dbtable with (NoLock)"); # MsSQL
my $rv8 = $sth8->execute();
while (my $ref8 = $sth8->fetchrow_hashref()) {
my $name=$ref8->{'TypeName'};
my $level1=param("LEVEL1_$name") || '0';
$level1=~s/\,/\./i;
$level1=~s/[^\d.]//i;
my $level2=param("LEVEL2_$name") || '0';
$level2=~s/\,/\./i;
$level2=~s/[^\d.]//i;
# MsSQL
my $sth9 = $dbh->prepare("
UPDATE
$dbtable
SET
ProvLevel1=CONVERT(money,?),
ProvLevel2=CONVERT(money,?)
WHERE TypeName=?
");
my $rv9=$sth9->execute($level1,$level2,$name);
#$sth9->bind_param(n,undef,SQL_VARCHAR); # tell DBD-ODBC this is a char
#$sth9->finish();
}
$sth8->finish();
my $location="./money_test.cgi";
print redirect(-uri=>$location);
print "Content-Type: text/html\n";
print "\n";
print "Redirect";
print "If your browser does not support redirection, please click ";
print "here";
print "";
}#///
$dbh->disconnect();