PerlでSQL接続／操作を学ぶための自作ドリル

DBI経由でPostgreSQLに接続し、データの登録／参照を行う。

問題

CSVファイルの内容をDBに登録する

DBとテーブルはPgAdmin3で用意する。
CSVファイル(sample.csv)

name,email,address
"山田 太郎",taro.yamada@xxx.com,"東京"
"田中 次郎",jiro.tanaka@xxx.com,"大阪"
"阿部 三郎",saburo.abe@xxx.com,"名古屋"

実行結果

$ insert_sql.pl sample.csv

DB登録内容(テーブル)

name	email	address
山田 太郎	taro.yamada@xxx.com	東京
田中 次郎	jiro.tanaka@xxx.com	大阪
阿部 三郎	saburo.abe@xxx.com	名古屋

DBの内容をXMLファイルに書き出す

DB登録内容(テーブル)

name	email	address
山田 太郎	taro.yamada@xxx.com	東京
田中 次郎	jiro.tanaka@xxx.com	大阪
阿部 三郎	saburo.abe@xxx.com	名古屋

実行結果

$ select_sql.pl sample_out.xml

出力結果XMLファイル(sample_out.xml)

<?xml version="1.0" encoding="UTF-8"?>
<addressBook>
  <person>
    <name>山田 太郎</name>
    <email>taro.yamada@xxx.com</email>
    <address>東京</address>
  </person>
  <person>
    <name>田中 次郎</name>
    <email>jiro.tanaka@xxx.com</email>
    <address>大阪</address>
  </person>
  <person>
    <name>阿部 三郎</name>
    <email>saburo.abe@xxx.com</email>
    <address>名古屋</address>
  </person>
</addressBook>

解答例

CSVファイルの内容をDBに登録する

データベース設定

DB名	testdb
テーブル名	addr_book
ホスト名	localhost(デフォルト)
ポート番号	5432(デフォルト)
ユーザー名	postgres(デフォルト)
パスワード	postgres

テーブル設定

列名	データ型	制約
name	character varying	primary key, unique, not null
email	character varying	not null
address	character varying	not null

ソースコード

use strict;
use warnings;
use utf8;
use DBI;
use Text::CSV_XS;

binmode STDIN, ':utf8';
binmode STDOUT, ':utf8';
binmode STDERR, ':utf8';

# CSV Parser
my $csv = Text::CSV_XS->new({binary=>1});

# Input Check
if (@ARGV != 1) {
  print STDERR "Please input CSV file name.\n";
  exit 1;
}

# 読み込みファイル名
my $csvin_name = $ARGV[0];

# File Check
unless (-f $csvin_name) {
  print STDERR "$csvin_name is not found.\n";
  exit 1;
}

# Input CSV
open my $csvin, '<:utf8', $csvin_name;

my @table = ();
while (my $line = $csv->getline($csvin)) {
	push @table, $line;
}

close $csvin;

# DBI Connect
my $DB = DBI->connect("DBI:Pg:dbname=testdb;host=localhost;port=5432", 'postgres', 'postgres', {RaiseError => 1, AutoCommit => 1});

# Insert Datas
my @labels = @{(shift @table)};

foreach my $row (@table) {
  my $sqltext = sprintf('insert into addr_book (%s) values (%s);', join (',', @labels), '\'' . join ('\',\'', @$row) . '\'');
  my $st = $DB->prepare($sqltext) or die $DB->errStr;
  $st->execute();
}

$DB->disconnect();

exit 0;

DBの内容をXMLファイルに書き出す

use strict;
use warnings;
use utf8;
use DBI;
use XML::LibXML;

binmode STDIN, ':utf8';
binmode STDOUT, ':utf8';
binmode STDERR, ':utf8';

# 書き出し先ファイル名
my $xmlout_name = $ARGV[0] || 'output_' . time . '.xml';

# File Check
if (-e $xmlout_name) {
  print STDERR "$xmlout_name already exists.\n";
  exit 1;
}

# DBI Connect
my $DB = DBI->connect("DBI:Pg:dbname=testdb;host=localhost;port=5432", 'postgres', 'postgres', {RaiseError => 1, AutoCommit => 1});

# Select Datas
my $sqltext = 'select * from addr_book';
my $st = $DB->prepare($sqltext) or die $DB->errStr;

$st->execute();

my $labels = $st->{NAME};
my $table = $st->fetchall_arrayref;

$DB->disconnect();

# XML output
my $xml = XML::LibXML::Document->new('1.0', 'UTF-8');
my $adb = XML::LibXML::Element->new('addressBook');
$xml->addChild($adb);

foreach my $row (@$table) {
  my $node = XML::LibXML::Element->new('person');
  for (my $cnt = 0; $cnt < @$labels; $cnt++) {
    my $data = XML::LibXML::Element->new($labels->[$cnt]);
    $data->appendText($row->[$cnt]);
    $node->addChild($data);
  }
  $adb->addChild($node);
}

# File Double-check
if (-e $xmlout_name) {
  print STDERR "$xmlout_name already exists.\n";
  exit 1;
}

# XML Output
$xml->toFile($xmlout_name, 1);

exit 0;

追記

この問題は、DB接続処理よりも環境設定のほうに手間取る事が分かった。
DBD::Pgの導入に気を付ければ、後は比較的楽だろう。