Perlのリファレンス２ 〜無名ハッシュへのリファレンス〜

このあたりはC言語的な仕様です。

�@と�Aは同じことをしているのですが、"{}"と"()"で意味が異なるのです。
前者"{}"はハッシュのリファレンスと返し、
後者"()"はハッシュの実体を返します。

�@
$rhash = {
  a => 1,
  b => 2,
  c => 3,
  d => 4
};
print $$rhash{c}, "\n";

�A
%hash = (
  a => 1,
  b => 2,
  c => 3,
  d => 4
);
$rhash = \%hash ;

print $$rhash{c}, "\n";

Perlのリファレンス１

Perlのリファレンスというものを初めて知りました。

C言語のポインタ変数的なものですね。
スクリプト言語にこういう仕様があるのが意外でした。

my $str = 999;
# 変数"$str"のリファレンス（アドレス）を取得する。
my $pstr = \$str;

# リファレンス（アドレス）の示している内容を表示する。
print $$pstr, "\n";

print $str, "\n";

※C言語だとこんな感じ

int n = 999;
int* pn = &n;

printf("%d\n", *np);
printf("%d\n", n);

DBI - DBD::PgPPを使用してPostgreSQLへアクセスする（Windows）つづき１

昨日の続きですが、トランザクション制御方法のメモです。
Perlでも、eavl〜if($@)を使用して、気持ちTry〜catch的なことができるのですね。

use DBI;
use Encode;

# データベース接続情報を設定
$dbname = "maomao_db";
$host = "localhost";
$user = "maomao";
$password = "maomao";

# データベースへの接続。ここで、PgPP という名前の DBD を指定しています。
$conn = DBI->connect("dbi:PgPP:dbname=$dbname;host=$host", $user, $password) or die;

#オートコミットをオフにします。
$conn->{AutoCommit} = 0;
#エラーメッセージの自動表示を抑止します。
$conn->{PrintError} = 0;

$sql = "INSERT INTO department(id, name) VALUES (?, ?);";

# SQL の発行
$sth = $conn->prepare($sql);

#トランザクション制御のためevalでdieをトラップします。
eval {
#RaiseErrorに"1"を設定することで、エラー発生時に自動的にdieするようになります。
#→自動的に実行されるdieは次の通り　die("$class $method failed $DBI::errstr")
$sth->{RaiseError} = 1;
$sth->execute(7, "BBB");
$sth->execute(8, "AAA");
};

if ($@) {
#・rollbackをすると、"$@"の内容がクリアされてしまうので、順番に注意
#・DBのエンコーディングはUTF8のため（？）、エラーメッセージはUTF8になります。
#　ここでは、DOSプロンプトで実行しているためShift-JISに変換しています。
warn "Transaction aborted because". encode('shift-jis', decode('utf-8', $@ ."\n"));
$conn->rollback;
} else {
print "SUCCESS: insert.\n";
$conn->commit;
}

$sth->finish;
$conn->disconnect;

こちらにも書いています（Perlあれこれ）。

DBI - DBD::PgPPを使用してPostgreSQLへアクセスする（Windows）

PerlでPostgreSQLへアクセスをしようと思いまして、調べてみるとDBD::Pgというのが初め見つかったのですが、Windowsの場合はセットアップが面倒そう。また調べるとDBD::PgPPというのがありました。こちらの方が簡単そうなのでこちらを使うことにしました。ということでメモ。

Perl環境は、XAMPP(1.7.2)を使用します（デフォルトの場所=>c:\xamppにインストール）。

Windowsの環境変数PATHに、"C:\xampp\perl\bin"を追加しています。

DOSプロンプトから、ppmツールを使用してDBD::PgPPをインストールできます。

C:\>ppm
PPM interactive shell (2.1.6) - type 'help' for available commands.
PPM> install DBD::PgPP
Install package 'DBD-PgPP?' (y/N): y
Installing package 'DBD-PgPP'...
Bytes transferred: 22178
Installing C:\xampp\perl\html\site\lib\DBD\PgPP.html
Installing C:\xampp\perl\site\lib\DBD\PgPP.pm
PPM>

これで準備ＯＫです。データベースに以下のようなテーブルがあれば、

CREATE TABLE department
(
id integer NOT NULL,
"name" character varying(255) NOT NULL,
PRIMARY KEY (id)
);

こんな感じにアクセスできます。

use DBI;
use Encode;

# データベース接続情報を設定
$dbname = "maomao_db";
$host = "localhost";
$user = "maomao";
$password = "maomao";

# データベースへの接続。ここで、PgPP という名前の DBD を指定しています。
$conn = DBI->connect("dbi:PgPP:dbname=$dbname;host=$host", $user, $password ) or die;

$sql = "select * from department";

# SQL の発行
$sth = $conn->prepare($sql);
$sth->execute or die "Can not execute statement: ". $sth->errstr;

# レコード行をハッシュへのリファレンスとして取得します。
while ($href = $sth->fetchrow_hashref) {
print $href->{"id"} . "\n";
# UTF-8→shift-jisへ変換
print encode('shift-jis', decode('utf-8', $href->{"name"} ."\n"));
}

$sth->finish;
$conn->disconnect;

こちらにも書いています（Perlあれこれ）。

正規表現で数値を３桁毎のカンマ区切り形式に変換（Perl編）

my $str;
$str = "12345678901234567";
$str =~ s/(\d)(?=(\d{3})+(?!\d))/$1,/g;
print $str;
//↓
//12,345,678,901,234,567
//になります。

渡された文字列に半角カタカナがあるか？のチェック(Perl編）

#文字列に半角カタカナが存在するか？
#Perlの正規表現を使用して、渡された文字列に半角カタカナがあるかチェックします。(UTF-8向け) 
#Perl 正規表現 半角カタカナ UTF8
$str = "aaaaｱあああああ";
if ( $str =~ /(?:\xEF\xBD[\xA1-\xBF]|\xEF\xBE[\x80-\x9F])/ ) {
    print encode('shift-jis', decode('utf-8', "文字列に半角カタカナが存在する\n"));
} else {
    print encode('shift-jis', decode('utf-8', "文字列に半角カタカナが存在しない\n"));
}
#↓
#"文字列に半角カタカナが存在する"

渡された文字列に非半角数字があるか？のチェック(Perl編）

#渡された文字列に非半角数字があるか？
#Perlの正規表現を使用して、渡された文字列に非半角数字があるかチェックします。
#Perl 正規表現 非半角数字
$str = "0123456789a";
if ( $str =~ /[^0-9]/ ) {
    print encode('shift-jis', decode('utf-8', "文字列に半角数字でない文字が存在する\n"));
} else {
    print encode('shift-jis', decode('utf-8', "文字列に半角数字でない文字が存在しない\n"));
}
#↓
#"文字列に半角数字でない文字が存在しない"

渡された文字列に非半角英字があるか？のチェック(Perl編）

#渡された文字列に非半角英字があるか？
#Perlの正規表現を使用して、渡された文字列に非半角英字があるかチェックします。(UTF-8向け) 
#Perl 正規表現 非半角英字 UTF8
$str = "abcdefghijklmnopqrstuvwxyz";
if ( $str =~ /[^A-Za-z]/ ) {
    print encode('shift-jis', decode('utf-8', "文字列に半角英字でない文字が存在する\n"));
} else {
    print encode('shift-jis', decode('utf-8', "文字列に半角英字でない文字が存在しない\n"));
}
#↓
#"文字列に半角英字でない文字が存在しない"

渡された文字列に非ASCII文字があるか？（Perl編）

#渡された文字列に非ASCII文字があるか？
#Perlの正規表現を使用して、渡された文字列に非ASCII文字があるかチェックします。(UTF-8向け) 
#Perl 正規表現 非ASCII文字 UTF8
$str = " abcdefghijklmnopqrstuvwxyz!#$&'()[]@";
if ( $str =~ /[^\x20-\x7E]/ ) {
    print encode('shift-jis', decode('utf-8', "文字列にASCII文字でない文字が存在する\n"));
} else {
    print encode('shift-jis', decode('utf-8', "文字列にASCII文字でない文字が存在しない\n"));
}
#↓
#"文字列にASCII文字でない文字が存在しない"

正規表現で、文字列は全て全角文字か？のチェック（Perl編）

#全て全角文字か？
#Perlの正規表現で、渡された文字列が全て全角文字かチェックします。(UTF-8向け) 
#Perl 正規表現 全角文字 UTF8
$str = "ＡＢＣＤＥＦＸＹＺあいうえおカキクケコ＠！＋＊＿";
if ( $str !~ /(?:\xEF\xBD[\xA1-\xBF]|\xEF\xBE[\x80-\x9F])|[\x20-\x7E]/ ) {
    print encode('shift-jis', decode('utf-8', "すべてが全角である\n"));
} else {
    print encode('shift-jis', decode('utf-8', "すべてが全角ではない\n"));
}
#↓
#"すべて全角である"

正規表現で、文字列は全て半角英数字か？のチェック（Perl編）

#全て半角英数字か？
#Perlの正規表現で、渡された文字列が全て半角英数字かチェックします。(UTF-8向け) 
#Perl 正規表現 半角英数字 UTF8
$str = "abcdefghijklmnopqrstuvwxyz0123456789";
if ( $str =~ /^[0-9A-Za-z]+$/ ) {
    print encode('shift-jis', decode('utf-8', "すべてが半角英数字である\n"));
} else {
    print encode('shift-jis', decode('utf-8', "すべてが半角英数字ではない\n"));
}
#↓
#"すべて半角英数字である"

※標準出力をUTF8→SJISに変換しているのは、開発環境がWindows+Eclipseの都合です。Windows+Eclipseのコンソールは、SJISエンコーディングオンリーなので。

正規表現で、文字列は全て全角ASCIIか？のチェック（Perl編）

#全て全角ASCIIか？
#Perlの正規表現で、渡された文字列が全て全角ASCIIかチェックします。(UTF-8向け) 
#Perl 正規表現 全角ASCII UTF8
$str = "ＡＢＣＤＥＦＧＨＩＪＫ１２３４５６７８９０！＃＄";
if ( $str =~ /^(?:\xEF\xBC[\x81-\xBF]|\xEF\xBD[\x80-\xA0])+$/ ) {
    print encode('shift-jis', decode('utf-8', "すべてが全角ASCIIである\n"));
} else {
    print encode('shift-jis', decode('utf-8', "すべてが全角ASCIIではない\n"));
}
#↓
#"すべて全角ASCIIである"

正規表現で、文字列は全て半角カタカナか？のチェック（Perl編）

UTF-8対応です。

#全て半角カタカナか？
#Perlの正規表現で、渡された文字列が全て半角カタカナかチェックします。(UTF-8向け) 
#Perl 正規表現 半角カタカナ UTF8
$str = "｡ｱｲｳｴｵｶｷｸｹｺｻｼｽｾｿﾀﾁﾂﾃﾄﾅﾆﾇﾈﾉﾊｲﾌﾍﾎﾏﾐﾑﾒﾓﾗﾘﾙﾚﾛﾔﾕﾖﾜﾝﾟ";
if ( $str =~ /^(?:\xEF\xBD[\xA1-\xBF]|\xEF\xBE[\x80-\x9F])+$/ ) {
    print encode('shift-jis', decode('utf-8', "すべてが半角カタカナである\n"));
} else {
    print encode('shift-jis', decode('utf-8', "すべてが半角カタカナではない\n"));
}
#↓
#"すべて半角カタカナである"

※標準出力をutf8→SJISに変換しているのは、開発環境がWindows+Eclipseの都合です。Windows+Eclipseのコンソールは、SJISエンコーディングオンリーなので。

正規表現で、文字列は全て全角カタカナか？のチェック（Perl編）

★★★
正規表現で、文字列は全て全角カタカナか？のチェック（Perl編）

UTF-8対応です。

$str = "アイウエオワイウエオン";
if ( $str =~ /^(?:\xE3\x82[\xA1-\xBF]|\xE3\x83[\x80-\xB6])+$/ ) {
    print encode('shift-jis', decode('utf-8', "すべてが全角カタカナである\n"));
} else {
    print encode('shift-jis', decode('utf-8', "全角カタカナでない文字がある\n"));
}

標準出力をUTF8→SJISに変換しているものは、開発環境がWindows+Eclipseの都合です。Windows+Eclipseのコンソールは、SJISエンコーディングオンリーなので。

正規表現で、文字列は全て平仮名か？のチェック（Perl編）

文字エンコーディング：UTF8対応です。

$str = "あいうえおわいうえおん";
if ( $str =~ /^(?:\xE3\x81[\x81-\xBF]|\xE3\x82[\x80-\x93])+$/ ) {
    print encode('shift-jis', decode('utf-8', "すべてが全角ひらがなである\n"));
} else {
    print encode('shift-jis', decode('utf-8', "すべてが全角ひらがなではない\n"));
}
#↓
#"すべて全角ひらがなである"

※標準出力をutf8→SJISに変換しているのは、開発環境がWindows+Eclipseの都合です。Windows+Eclipseのコンソールは、SJISエンコーディングオンリーなので。

正規表現で、文字列は全てASCII文字か？のチェック（Perl編）

$str = " abcdefghijklmnopqrstuvwxyz!#$&'()[]@";

if ( $str =~ /^[\x20-\x7E]+$/ ) {
  print encode('shift-jis', decode('utf-8', "すべてがASCIIである\n"));
}else{
  print encode('shift-jis', decode('utf-8', "すべてがASCIIでない\n"));
}

※標準出力の文字エンコーディングをUTF8→SJISに変換しています（Eclipseで動作確認している都合です。コンソールがSJISのみ対応なので）

CSVファイル読み込み処理

PerlでCSVファイル読み込み処理

use strict;
use Text::CSV_XS;
use IO::File;

my $csv = Text::CSV_XS->new({binary => 1});
my $fh = IO::File->new("c:\\okinawa.csv", 'r') or die;

my $i=1;
while (not $fh->eof) {
    my $row = $csv->getline($fh);

    print "Row : $i \n";
    my @fields = @$row;
    foreach my $field (@fields) {
        print "$field\n";
    }
    $i++;
}

良かったらクリックお願いします→

ファイルダウンロード処理(Perl)

Perlでファイルダウンロードを行います。

#!"C:\xampp\perl\bin\perl.exe"
use strict;
use File::Basename;

my $filepath = "c:\\okinawa.csv";
my $file = basename($filepath);
my $filesize = -s $filepath;

open(F,$filepath) || die "Can't open $filepath";

print "Content-type: application/octet-stream; name=\"$file\"\n";
print "Content-Length: $filesize\n";
print "Expires: 0\n";
print "Cache-Control: must-revalidate, post-check=0,pre-check=0\n";
print "Pragma: private\n";
print "Content-Disposition: attachment; filename=\"$file\"\n";
print "\n";

binmode(F);
binmode(STDOUT);
while(<F>) {print;}
close(F);
exit;

良かったらクリックお願いします→