From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

MJEVANS / DBD-ODBC-1.61 / examples / money_test.cgi 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108

              
#!c:/programme/perl/bin/perl.exe -w
# $Id$
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 "<Html><Head><Title>Title</Title></Head>\n";
        print "<BODY><CENTER><BR><BR>\n\n\n";
        print "<FORM NAME=A ACTION=money_test.cgi METHOD=POST><INPUT TYPE=HIDDEN NAME=ACTION VALUE=SAVE_PROV><TABLE BORDER=0 BGCOLOR=#DDDDDD>\n";
        print "<TR><TD><B>&nbsp;Text&nbsp;</B></TD><TD><B>&nbsp;Level1&nbsp;</B></TD><TD><B>&nbsp;Level2&nbsp;</B></TD><TD>&nbsp;</TD></TR>\n";
        # MsSQL
        my $sth0 = $dbh->prepare("
                                SELECT 
                                        ISNULL(TypeName,'') AS TypeName,
                                        ISNULL(ProvLevel1,0.00) AS ProvLevel1,
                                        ISNULL(ProvLevel2,0.00) AS ProvLevel2,
                                        ISNULL(Action,0) AS Action
                                FROM $dbtable with (NoLock) 
                                ORDER BY Action
                                ");
        my $rv0 = $sth0->execute();
        while (my $ref0 = $sth0->fetchrow_hashref()) {
                if ($ref0->{'Action'}==0) {
                        print "<TR><TD>&nbsp;$ref0->{'TypeName'}&nbsp;</TD><TD>&nbsp;<INPUT TYPE=TEXT SIZE=5 NAME='LEVEL1_$ref0->{'TypeName'}' VALUE='$ref0->{'ProvLevel1'}'>&nbsp;</TD><TD>&nbsp;<INPUT TYPE=TEXT SIZE=5 NAME='LEVEL2_$ref0->{'TypeName'}' VALUE='$ref0->{'ProvLevel2'}'>&nbsp;</TD><TD>&nbsp;</TD></TR>\n";
                } else {
                        print "<TR><TD>&nbsp;<b>V:</b> $ref0->{'TypeName'}&nbsp;</TD><TD>&nbsp;<INPUT TYPE=TEXT SIZE=5 NAME='LEVEL1_$ref0->{'TypeName'}' VALUE='$ref0->{'ProvLevel1'}'>&nbsp;</TD><TD>&nbsp;<INPUT TYPE=TEXT SIZE=5 NAME='LEVEL2_$ref0->{'TypeName'}' VALUE='$ref0->{'ProvLevel2'}'>&nbsp;</TD><TD>&nbsp;</TD></TR>\n";
                }
        }
        $sth0->finish();
        print "</TABLE><BR><BR><INPUT TYPE=SUBMIT VALUE='Save'></FORM>";
        print "</CENTER></BODY></HTML>";
}#///
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 "<HTML><HEAD><TITLE>Redirect</TITLE></HEAD><BODY>";
        print "If your browser does not support redirection, please click ";
        print "<A HREF=\"$location\">here</A>";
        print "</BODY></HTML>";
}#///
$dbh->disconnect();