Perl DBI 的 MySQL 介面一例

原始碼：#! /usr/bin/perl -w
# test.pl - Perl DBI test

use strict;
use DBI;

my $dsn = "DBI:mysql:db1:10.1.9.110"; # data source name
my $user_name = "user1"; # user name
my $password = "passwd1"; # password

# connect to database
my $dbh = DBI->connect ($dsn, $user_name, $password,{RaiseError => 1, PrintError => 0});

# issue query
my $sth = $dbh->prepare("select * from month.temp order by id asc");
my $sth_bal;
my $update_bal;
my $delete_subscription;

$sth->execute();

$dbh->do("set foreign_key_checks = 0");

# read resules of query, then clean up
while (my ($id,$SubscriptionID,$UserID,$ServiceID,$Price) = $sth->fetchrow_array())
{
    $sth_bal = $dbh->prepare("select c1 from db1.t1 where UserID=$UserID");
    $sth_bal->execute();
    my ($balance) = $sth_bal->fetchrow_array();

    if ($Price > $balance)
    {
        $delete_subscription = $dbh->do("delete from db1.t2 where c1 = $SubscriptionID");
        if (!$delete_subscription)
        {
            print "An error occurredn";
        }
        else
        {
            # print "SubscriptionID: $SubscriptionID";
            # print "n";
        }
        $dbh->do("insert into db2.Log (OptDate,Opt,TableName,SubscriptionID,UserID,OldBal,NewBal)
                values (curdate(),'delete','ServiceSubscription',$SubscriptionID,$UserID,null,null)");
    }
    else
    {
        $update_bal = $dbh->do("update db1.t1 set UserBal = UserBal - $Price where UserID=$UserID");
        if (!$update_bal)
        {
            print "An error occurredn";
        }
        else
        {
            # print "UserID: $UserID";
            # print "n";
        }
        $dbh->do("insert into db2.Log (OptDate,Opt,TableName,SubscriptionID,UserID,OldBal,NewBal)
                values (curdate(),'update','WebUser',$SubscriptionID,$UserID,$balance,$balance - $Price)");
    }
    $sth_bal->finish();
}

$sth->finish();

$dbh->do("set foreign_key_checks = 1");

$dbh->disconnect();
exit(0);