上記データベースに追加/修正/削除を行なうプログラム: input.pl

#! /usr/bin/perl -w
use CGI;
use Pg;
use CGI::Carp qw(fatalsToBrowser);
use CGI qw/:standard/;
use strict;

my $db = 'balance';
my $conn = Pg::connectdb("dbname = $db");
if ($conn->status ne PGRES_CONNECTION_OK) {
    print "Cannot connect to database $db: $conn->errorMessage";
    exit;
}

my ($res, $n, $qstr);

print header, start_html(-title=>'Input for Journal',
       -meta=>{'Content-Type'=>'text/html; charset=x-euc-jp'}
       ),"\n";
print h2('仕訳帳: 入力/修正/削除'),"\n";

# get key table from DB: titles
my ($key, $title, $type, $tbl);
my (%keys, %titles, @d_titles, @c_titles);
$tbl = 'titles';
$qstr = "select * from $tbl;";
&submit_sql;
for (my $i = 1; $i < $n; $i++) {
    $key = $res->getvalue($i, 0);
    $title = $res->getvalue($i, 1);
    $type = $res->getvalue($i, 2);
    $titles{$key} = $title;
    $keys{$title} = $key;
    if ($type =~ /^r/ || $type eq 'id') {
	@d_titles = (@d_titles, $title);
    }
    if ($type =~ /^r/ || $type eq 'ic') {
	@c_titles = (@c_titles, $title);
    }
}
my ($err_i, $err_u, $err_d);

# process after accepting param's
my ($op, $year);
my ($oid, $debit, $amount, $credit, $cash, $date, $remarks);
if (param('op')) {
    $op = param('op');
    $year = param('year');
    $tbl = 'f'.$year;

    # insert
    if ($op eq '追加') {
	$debit = $keys{param('d_title')};
	$amount = param('amount');
	$credit = $keys{param('c_title')};
	if ($debit =~ /^[12]/ || $credit =~ /^[12]/) {$cash = 'c';}
	else {$cash = 'n';}
	$date = param('date');
	$remarks = param('remarks');
	if ($date && $amount) {
	    $err_i = '';
	    $qstr = "insert into $tbl values('$debit','$amount','$credit','$cash','$date','$remarks');";
	    &submit_sql;
	} else {$err_i = '再入力';}
    }

    # update
    elsif ($op eq '変更') {
	$oid = param('oid');
	$debit = $keys{param('d_title')};
	$amount = param('amount');
	$credit = $keys{param('c_title')};
	if ($debit =~ /^[12]/ || $credit =~ /^[12]/) {$cash = 'c';}
	else {$cash = 'n';}
	$date = param('date');
	$remarks = param('remarks');
	$qstr = "select oid from $tbl where oid=$oid;";
	&submit_sql;
	if ($n > 0 && $date && $amount) {
	    $err_u = '';
	    $qstr = "update $tbl set debit='\$debit', amount='\$amount',credit='$credit',cash='$cash',date='$date',remarks='$remarks' where oid=$oid;";
	    &submit_sql;
	} else {$err_u = '再入力';}
    }

    # delete
    elsif ($op eq '削除') {
	$oid = param('oid');
	$qstr = "select oid from $tbl where oid=$oid;";
	&submit_sql;
	if ($res->ntuples > 0) {
	    $err_d = '';
	    $qstr = "delete from $tbl where oid=$oid;";
	    &submit_sql;
	} else {$err_d = '再入力';}
    }
}

# process making param's
my @years = ('1997','1998','2003');
print
    start_form(),
    p('年を選んでください',
      popup_menu(-name=>'year', -values=>\@years, -defaults=>$years[$#years])),
    hr, "\n",

    h4('新規データ (年月日, 金額は必須)'),"\n",
    p('年月日(例20030401) ',textfield(-name=>'date', -size=>8, -maxlength=>8),'　',
      '摘要 ',textfield('remarks')),"\n",
    p('左借方(To) ',popup_menu(-name=>'d_title', -values=>\@d_titles),'　',
      '右貸方(From) ',popup_menu(-name=>'c_title', -values=>\@c_titles),'　',
      '金額 ',textfield('amount')), "\n",
    p(submit(-name=>'op', -value=>'追加'), "　$err_i"),
    hr, "\n",

    h4('修正データ (No. は仕訳帳で確認. 年月日, 金額は必須)'), "\n",
    p('No. ',textfield(-name=>'oid', -size=>5),'　',
      '年月日(例20030401) ',textfield(-name=>'date', -size=>8, -maxlength=>8),'　',
      '摘要 ',textfield('remarks')), "\n",
    p('左借方(To) ',popup_menu(-name=>'d_title', -values=>\@d_titles),'　',
      '右貸方(From) ',popup_menu(-name=>'c_title', -values=>\@c_titles),'　',
      '金額 ',textfield('amount')), "\n",
    p(submit(-name=>'op', -value=>'変更'), "　$err_u"),
    hr, "\n",

    h4('削除データ (No. は仕訳帳で確認)'), "\n",
    p('No. ',textfield(-name=>'oid', -size=>5)), "\n",
    p(submit(-name=>'op', -value=>'削除'), "　$err_d"),
    hr, "\n",
    end_form, "\n",
    end_html, "\n";

sub submit_sql() {
    $res = $conn->exec($qstr);
    $n = $res->ntuples;
    print br(strong("実行されたコマンド [$qstr]　　対象レコード数 [$n]")), "\n";
}