kdoc - Perl

  • 作成日:2006-09-05 15:01:55
  • 修正日:2024-01-23 15:19:03

基本

↑ページトップへ

たまに整理するけど、基本的にでたらめなメモ。

クォート

# 'abc'
q{abc}
# "abc_$d"
qq{abc_$d}
# `uptime`
qx{uptime}
# (1, 2, 3)
qw{1 2 3}
# 正規表現
qr/PATTERN/option
# /PATTERN/
m{PATTERN}
# s/PATTERN//
s{PATTERN}{}
# tr///
tr{}{}

数値

# 整数部分
my $res = int(1.5); #--> 1
my $res = int(-1.5); #--> -1
# 四捨五入
my $res = int($num + 0.5);
# サイコロ
my $res = int(rand 6) + 1;
# 絶対値
my $res = abs($num);

2進数/8進数/16進数

# 2進数(先頭に0b)
my $num_bin = 0b1111;
# 8進数(先頭に0)
my $num_oct = 0777;
# 16進数(先頭に0x)
my $num_hex = 0xFFFF;
# 10進数→2進数
my $bin = sprintf "%b", 1000;
print $bin, "\n"; # 1111101000
# 16進数→10進数
my $dec = hex('fa7a');
my $dec = hex( 0x1AB );
# 10進数→16進数
my $hex = sprintf("%x", '367156');
# 文字→16進数
my $hex = unpack("H*", 'あ');
# 10進数→8進数
my $oct = sprintf("%o", 10);
# 8進数→10進数
my $dec = oct 10;
# asciiから
my $text = chr(29);
# asciiへ
my $ascii = ord('あ');

or, and, &&, ||

  • orとandはPerl5から導入で、こちらを推奨。
  • &&/||の方が、or/andより優先順位が高い(or/andはかなり低い)。

&&/||じゃないとだめな場合。

my $a = test() || test() ? 0 : 1;
# 上記をorでやりたいなら、
my $a = ( test() or test() ) ? 0 : 1;
sub aaa {
  my $aaa = shift || 1;
}
# 上記をorでやりたいなら、
sub aaa {
  my $aaa = (shift or 1);
}

上記は、undefも0(ゼロ)もnullもみんな同じ扱いになってしまいがち。
Perl 5.10からは…

my $aaa = $bbb // 1;
# 以下と同じ
my $aaa = defined $bbb ? $bbb : 1;

# 未定義な時のデフォルト値
my $value //= 'default';

5.10以前なら以下だけど、undefもゼロもみな同じ扱いになっちゃう。

# 未定義なら設定…のつもりだけどundefもゼロも空も反応しちゃう。
$q->{mode} ||= 'default';

ファイルテスト

operator description
:e Exists
:d Directory
:f File
:l Symbolic link
:r Readable
:w Writable
:x Executable
:s Size
:z Zero size
use v5.18;

my $exists = '.bash_profile';

if( -e $exists ){
  say 'Exists';
}
use v6;

my $exists = '.bash_profile';

if $exists.IO.e {
  say 'Exists';
}

printf/sprintf フォーマット

# 符号付き整数として解釈し、ゼロで埋めて8桁に
"%05d", 8 --> 00008
"%05d", -8 --> -0008
# 浮動小数点として解釈し、小数点以下2位まで(ほぼ四捨五入)
"%.2f", 5 --> 5.00
"%.2f", -5 --> -5.00
"%.2f", 10/3 --> 3.33
"%.2f", 0.724 --> 0.72
"%.2f", 0.725 --> 0.72
"%.2f", 0.726 --> 0.73
# 文字列として解釈し、右詰めにしてスペースで埋める
"%5s", 1 -->     1 # スペースを入れて5桁
# 文字列として解釈し、左詰めにしてスペースで埋める
"%-5s9"  -> 1    9
# 文字列として解釈し、右詰めにしてゼロで埋める
"%05s", 'a' --> 0000a

配列

my @list = (0 .. 9);
my @list = ('A' .. 'Z');
# 要素数
my $count = @list;
# ちゃんと書く
my $count = scalar @list;
# 最後の要素
my $last = $ary[-1];
# 末尾に追加
push @ary, $a;
# 先頭を削除
shift @ary;
# 末尾を削除
pop @ary;
# 先頭に追加
unshift @ary;
# 先頭を削除しつつ取得
my $first = shift @ary;
# 末尾を削除しつつ取得
my $last = pop @ary;
# スライス
my @res = @ary[3, 7];
my @res = @ary[0 .. 4];
# スライス(代入)
my @ary[2, 3] = ('b', 'c');
# splice(5要素目から3つ取得)
my @res = splice @ary, 4, 3;
# splice(5要素目に@addを追加)
my @res = splice @ary, 4, 0, @add;

ハッシュ

# KeyとValueを入れ替え
%hash = reverse %hash;
# Keyの数
my @ary = %hash;
my $count_pre = @ary;
my $count = $count_pre / 2;
-or-
my $count_pre = my @ary = %hash;
my $count = $count_pre / 2;
-or-
my $count = scalar keys %hash;
# 結合
my %ccc = (%aaa, %bbb);
# キーと値の削除
delete $hash{$key};
# キーの存在チェック
if(exists $hash{$key}){
}
# 値の定義チェック(0は「定義」、undefは「未定義」)
if(defined $hash{$key}){
}
# ループ
foreach my $key(keys %hash){
}
foreach my $value(value %hash){
}
while( my($key, $value) = each %hash){
}
# ソート
foreach my $key(sort keys %hash){
}
# ソートの別解
foreach my $key( sort {$hash{$b} <=> $hash{$a} } keys %hash ){
}
# ハッシュにハッシュを追加
my $aaa = {
  a => 1,
  b => 2,
};
%$aaa = (
  %$aaa,
  'c' => 3,
  'd' => 4
);

他プロセス/外部プログラムの実行

↑ページトップへ

# バッククオート(以下2つは等価)…標準出力を受け取れる
my $stdout = `ls -a`;
my $stdout = qx{ls -a};

# system…子プロセスを生成。返り値はその実行コマンドの戻り値(以下の場合は通常は0)。
# コマンドの標準出力は標準出力へ。
my $return = system('ls -a');

# exec…Perlの実行プロセスを、execでのコマンドのプロセスに置き換え
# →Perlのプロセスに戻ることはない。
# execのコマンドの実行に失敗した場合のみ、Perlのプロセスに戻る。
# コマンドの標準出力は標準出力へ。
exec('ls -a');
print "command fail.\n"; # ←通常は実行されない
# STDOUTとSTDERRをまとめて変数に代入
my @returned_lines = `cmd 2>&1`;
# STDOUTを変数に代入し、STDERRを破棄
my @returned_lines = `cmd 2>/dev/null`;
# STDERRを変数に代入し、STDOUTを破棄
my @returned_lines = `cmd 2>&1 1>/dev/null`;
# STDOUTとSTDERRを入れ替える(STDERRを変数に代入し、STDOUTを元のSTDERRの代わりに出力)
my @returned_lines = `cmd 3>&1 1>&2 2>&3 3>&-`;

# ``とqx{}は同値
my @returned_lines = qx!cmd 2>&1!;

# 終了ステータス
my $status = $? >> 8;

サブルーチン

↑ページトップへ

プロトタイプ付きサブルーチン

sub func ( $@ ) {
  # ひとつ目はスカラ、ふたつ目は配列
}

sub func ( $;%& ) {
  # ひとつ目はスカラ、ふたつ目はハッシュ、みっつ目は無名サブルーチン
  # ひとつ目だけ必須(セミコロンより後ろは必須ではない)
}

ファイル情報 stat

↑ページトップへ

if( -f $path ){
  my $file_size = -s _; #「_」にキャッシュされてる(stat cache)
}
($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
  $atime, $mtime, $ctime, $blksize, $blocks) = stat($filename);
# statはsymblic linkを解決してリンク先ファイルの情報を取得。lstatはリンクそのものの情報を取得。
0 dev device number of filesystem ボリュームごとに固有に割り当てられるID
1 ino inode number そのボリューム内で固有に割り当てられるID
2 mode file mode (type and permissions) ファイルの種類とパーミッション
3 nlink number of (hard) links to the file そのノードにハードリンクがいくつあるか
4 uid numeric user ID of file's owner ファイルの所有者ID
5 gid numeric group ID of file's owner ファイルのグループID
6 rdev the device identifier (special files only) デバイス識別子(ほとんど使われない項目)
7 size total size of file, in bytes ファイルサイズ
8 atime last access time in seconds since the epoch 最後にアクセスされた(readされた)時間(エポック秒)
9 mtime last modify time in seconds since the epoch データ最終更新時間(エポック秒)
10 ctime inode change time in seconds since the epoch (*) メタデータも含めた最終更新時間(エポック秒)
11 blksize preferred block size for file system I/O このファイルシステムでの1ブロックのサイズ
12 blocks actual number of blocks allocated このファイルシステムでいくつのブロックを使用しているか

※ (getpwnam($uid))[2]でユーザ名、(getgrnam($gid))[2]でグループ名が取得可能。

OOを希望の場合は、Fili::stat を使用。

日付/時間

↑ページトップへ

モダンPerlなら、Time::Piece(5.10から標準モジュール)。
Time::Piece - 日付と時刻を扱う - サンプルコードによるPerl入門

use Time::Piece;
my $t = localtime;
print $t->ymd();

my $year   = $t->year;
my $month  = $t->mon;
my $mday   = $t->mday;

my $hour   = $t->hour;
my $minute = $t->minute;
my $second = $t->sec;

日時文字列

use POSIX qw/strftime/;
my $date_text = strftime('%Y%m%d_%H%M%S', localtime);

エポック秒へ。

use POSIX qw/mktime/;
sub time2epoch {
  my ($YYYY, $MM, $DD, $hh, $mm, $ss) = @_;
  return mktime($ss, $mm, $hh, $DD, $MM - 1, $YYYY - 1900);
}

open

↑ページトップへ

openプラグマ / IOレイヤ

# バイナリモード
:bytes
# テキストモード(CRLFを改行へ変換)
:crlf

# Unixのread(), write()等を使用。
# バッファリングなし。どのプラットフォームでも常にO_BINARY。
:unix

# Windowsネイティブのハンドルを使用。5.10.0でバグあり?
:win32

# 各レイヤの変換を無効にして、バイナリデータをそのまま扱う。
:raw
# 入出力の指定
use open IN => ':encoding(cp932)', OUT => ':utf8';
use open IO => ':encoding(euc-jp)';

# 以下は同じ
use open ':utf8';
use open IO => ':utf8';
use open IN => ':utf8', OUT => ':utf8';

# すでに開かれているファイルハンドルに対して
binmode STDOUT, ':utf8';
binmode IN, ':encoding(shiftjis)';

Encode::Supported

ascii
iso-8859-1 #latin1
utf8
UTF-16
UTF-16BE
UTF-16LE
UTF-32
UTF-32BE
UTF-32LE
euc-jp
shiftjis
cp932
macJapanese
7bit-jis
iso-2022-jp #RFC1468
iso-2022-jp-1 #RFC2237

パイプへ
第二引数に '|-'

open my $pipe, '|-', 'more';
print $pipe 'aaaa';
close $pipe;

パイプから
第二引数に '-|'

open my $pipe, '-|', 'dir';
while(my $line = <$pipe>){
  print $line;
}
close $pipe;

やり方

↑ページトップへ

ファイル読み込み

# 一括読み込み
my $path = '/path/to/file.txt';
open my $fh, '<:utf8', $path or die qq|open($path) failed: $!|;
my $data = do{ local $/; <$fh> };
close $fh;

パスワード作成

sub make_password{
  my $num = shift;
  my $pwd;
  $pwd .= ('a' .. 'z', 0 .. 9)[int(rand(36))] while $num -- > 0;
  return $pwd;
}

ヒアドキュメント内で

  • 2 * 3が計算されて6が表示される。
  • 「$text \n」が(展開されずに)そのまま表示される。
$out = <<HTML;
<html>
<head>
<title>@{[ title() ]}</title>
</head>
<body>
@{[ 2 * 3 ]}
@{[ '$text \n' ]}
</body>
</html>
HTML

sub title {
  return 'page title';
}

数字列とそれ以外の文字を"@"で分ける

my $text = 'あいうabcかきくdef';
$text =~ s/(\D*)(\d+)(\D*)/$1@$2@$3/g;

合計

$sum += $_ for @numbers;

位取りのカンマ

$num_text =~ s/(?<=\d)(?=(\d\d\d)+(?!\d))/,/g;

substr

# 先頭から2byte
my $res = substr($a, 0, 2);
# 末尾5文字
my $res = substr($a, -5);
# 末尾5文字を削除
substr($a, -5) = '';
# 末尾2byteを削除した残り
my $res = substr($a, 0, -2);
# 先頭3文字を削除した残り
my $res = substr($a, 3);
# 19730307の場合
my $YY = substr $date, 0, 4;
my $MM = substr $date, 4, 2;
my $DD = substr $date, 6, 2;

grep

my @results = grep $expression, @inputList;
my $count = grep $expression, @inputList;
my @results = grep $_ > 10, @in;
my @results = grep /^\d$/, @in;
my @results = grep test($_), @in;
sub test{
 …
 return 1;
}
my @results = grep {…} @in;
# @inの前のカンマなし。{…}ではreturnは書かない。
# 空要素削除
my @results = grep length $_, @in;
# 空白要素削除
my @results = grep {
  if(/^¥s+$/){
    $_ = undef;
  }
  $_;
} @in;

map

my @results = map function($_), @in;
my @results = map {...} @in;

ソート

↑ページトップへ

# ASCII
my @res = sort @list;
# 数値
my @res = sort {$a <=> $b} @list;
# 数値逆順
my @res = sort {$b <=> $a} @list;
# 文字列
my @res = sort {$a cmp $b} @list;
# 文字列逆順
my @res = sort {$b cmp $a} @list;
# インデックス値(ソート前の3番目はソート後には何番目?)
my @res = sort {$list[$a] <=> $list[$b]} 0 .. $#list;
# インデックス値(ソート前の3番目はソート後には何番目?)文字列
my @res = sort {$list[$a] cmp $list[$b]} 0 .. $#list;
# 複数項目で
my @res = sort { $b->{age} <=> $a->{age} or $a->{name} cmp $b->{name} } @list;

ファイルを更新日時順にソート

↑ページトップへ

古い順

my $dir = '/Users/officek/Desktop/test';
$dir =~ s/\/$//;
opendir DIR, $dir;
my @files =
    map { $_->[0] }
    sort { $b->[1] <=> $a->[1] }
    map { [ $_, -M "$dir/$_" ] }
    grep ( /^[^.]/, readdir DIR );
close DIR;

for my $file(@files){
    my ($ss, $mm, $hh, $DD, $MM, $YY, $wday, $yday, $isdst) = localtime( ( stat qq|$dir/$file| )[9] );
    $YY += 1900;
    $MM ++;
    printf "%s\t%d-%02d-%02d %02d:%02d:%02d\n", $file, $YY, $MM, $DD, $hh, $mm, $ss;
}

新しい順

    sort { $a->[1] <=> $b->[1] }

変数

↑ページトップへ

my, local, our

グローバルはour、レキシカル(局所的)はmy、あるスコープで一時的にはlocal。

# Perlのバージョン(バージョン+パッチレベル/100)
# use Englishした場合は、$PERL_VERSIONでアクセス可能。
$]
# マッチング
$`(前)←$&(そのもの)→$'(後)
# 実行中のファイル名
$0
# 現在の行番号
$.

特殊変数

$^O … OS名 プラットフォーム Windowsの場合"MSWin32"
$0 … プログラム名
$$ … プロセスID
$^T … プロセスの開始時刻(エポック秒)
$^V … Perlのバージョン
$,  … print 時の出力フィールドの区切り文字
$. … ファイルハンドルの現在の行番号
$/ … 入力コードのセパレータ
$\ … 出力コードのセパレータ

文字変換 正規表現 マッチング

↑ページトップへ

拡張構文

拡張構文では\1や\2あるいは$1, $2のようにあとから参照できない。

# 【?#コメント】正規表現内にコメント
(?# commnet)
# 【?=式】前方一致
# 後ろにタブのある単語にマッチ($&にタブは含まれない。マッチした語は\w+)
/\w+(?=\t)/
# 「東京」のあとに「都庁」が続いている「東京」にマッチ(「東京都庁」の「東京」にマッチ)
/東京(?=都庁)/
# 【?!式】前方一致の否定形
# 後ろにbarがないfooにマッチ
/foo(?!bar)/
# 「東京」の後ろに「議会」が続いていない「東京」にマッチ
/東京(?!議会)/
# 【?<=式】後方一致 先行する文字列が式に一致すればマッチ
# 「東京」のあとに「都庁」でマッチ(つまり「東京都庁」)
/(?<=東京)都庁/
# 【?<!式】後方一致の否定形 先行する文字列が式に一致「しなければ」マッチ
# 「東京」でない文字の後ろに「都庁」でマッチ(たとえば「とうきょう都庁」)
/(?<!東京)都庁/
# 【?i】【?s】【?m】【?x】部分的にパターンマッチ修飾子を埋め込む
# Oに続くneの大文字/小文字を区別しない
/O(?i)ne/
# 【?i-】【?s】【?m】【?x】部分的にパターンマッチ修飾子を無効にする
# Oに続くneの大文字/小文字を区別する
/O(?i-)ne/i
# グループ化(後方参照用に記憶される)
/Windows (Me|Xp)/
# 後方参照を行なわないグループ化
/Windows (?:Me|Xp)/

もろもろ

# ワード境界の\bは、スペース、行頭、行末、/、@、%等のほぼ?すべての記号にマッチする。
$text =~ /\byugo\b/;

# 「漢字yugo」の場合はマッチしない。
#すべて小文字へ
$string =~ tr/A-Z/a-z/;
#a-z以外の文字を削除
$string =~ tr/a-z//cd;
# UTF-8環境にて
ascii / -~/ space入れないなら /!-~/
半角カナ /。-゚/
my ($year, $month, $day) = (/^(\d\d\d\d)(\d\d)(\d\d)$/);
# マッチしたものが配列に入る
my @match = ($text =~ /^(\d+)\-(\d+)\-(\d+)$/);
my ($year, $month, $day) = ($text =~ /^(\d+)\-(\d+)\-(\d+)$/);
# 元の変数はそのままで置換後を別の変数へ
(my $after = $original) =~ s/aaa//g;
# 下記よりも
/a|b|c/
# 下記の方が高速
/[abc]/
# マッチした個数(例: タブの個数)
my $count = ($text =~ tr/\t/\t/);
# マッチングに使用するためにメタ文字をエスケープ
my $regex = quotemeta('.txt');
# 正規表現のリファレンス(変数に入れて利用)
my $regex = qr/(\d+)/sm;
if ($num =~ /$regex/) {}

情報

↑ページトップへ

# バージョン/パッチ情報等
$ perl -v
# モジュール検索
find `perl -e 'print "@INC"'` -name '*.pm' -print
find `perl -e 'print "@INC"'` -name 'Jcode.pm' -print

#簡単なのは…(何もメッセージが出なければインストール済み)
perl -Mモジュール名 -e ''

# 簡単にモジュールのバージョン(ver.9999がないというアラートと共に今のバージョンが表示される)
perl -e "use AAA::Bbb 9999"

# モジュールの場所
perldoc -l AAA::Bbb
# コアモジュールかどうか(ただし使えるのは、5.8.9 から)
$ corelist FindBin
FindBin was first released with perl 5.00307

モジュール一覧

use ExtUtils::Installed; # perl 5.005からOK

my $ei = ExtUtils::Installed->new;
for my $module($ei->modules){
  printf "%s   %s\n", $module, $ei->version($module);
}

読み込まれたモジュール一覧

%INC

特殊リテラル

↑ページトップへ

# プログラムの論理的な終わり(この文字列以降は解釈されない)
__END__
# 現在のファイル名
__FILE__
# 現在の行番号
__LINE__
# 現在のパッケージ名
__PACKAGE__

__END__以降の行(あるいは__DATA__以降の行)は<DATA>で読み込むことができる(__END__と__DATA__でパッケージ範囲で違いあり)。

リファレンス

↑ページトップへ

調べる

# ref関数
ref $aaa;
# 返り値→() / () / / CODE(サブルーチン)
リファレンス ref
スカラー SCALAR
配列 ARRAY
ハッシュ HASH
サブルーチン CODE
型グロブ GLOB
オブジェクト オブジェクトが所属するクラス名

スカラーのリファレンス/デリファレンス

# $scalar
my $ref = \$scalar;
# \$scalarのデリファレンス
${$ref}; $$ref;

配列のリファレンス/デリファレンス

# @aryのリファレンス
my $ref = \@ary;
# \@aryのデリファレンス
@{$ref}; @$ref;
# 配列の要素へアクセス
${$ref}[1]; $$item[1]; $ref->[1];
# 2次元、3次元なら
$ref->[1]->[3]->[0];

ハッシュのリファレンス/デリファレンス

「+{}」みたいなのは、「{}」だけではマズそうな場合に、「これはハッシュリファレンスですよ」と明示的に表しているもの。

# %hashのリファレンス
my $ref = \%hash;
# デリファレンス
my $name = ${$ref}{'name'}; $$ref{'name'}; $ref->{'name'};
# ハッシュ全体
my @key = keys %{$ref}; %$ref;

サブルーチンのリファレンス/デリファレンス

# のリファレンス
$ref = \
# デリファレンス
&{$ref}('yugo');
&$ref('yugo');
$ref->('yugo');

無名配列

my $fruits = ['pineapple', 'papaya', 'mango'];
# 下記と同義
my $fruits;
{
 my @secret_variable = ('pineapple', 'papaya', 'mango');
 $fruits = \@secret_variable;
}

無名ハッシュ

my $ref_to_yugo_info = {
 name => 'yugo',
 hat => 'White',
 shirt => 'Red',
};
# 下記と同義
my $ref_to_yugo_info;
{
 my %yugo_info = (
 name => 'yugo',
 hat => 'White',
 shirt => 'Red',
 );
 $ref_to_yugo_info = \%yugo_info;
}

無名サブルーチン

my $ref_sum = sub{
  my $total;
  for my $num(@_){
    $total += $num
  }
  return $total;
}
# 使う
my $total = $ref_sum->( 1, 2, 3 );

Data::Dumper

use Data::Dumper;
print Dumper($ref);

# use utf8; 下では特定文字のユニコードポイントを知るのにも使える
my $str = 'あ';
print Dumper $str; --> $VAR1 = "\x{3042}";

# utf8文字を文字として出力
use Data::Dumper;
{ no warnings; package Data::Dumper; sub qquote { return shift; } }
$Data::Dumper::Useperl = 1;
print Dumper $k;

# その他の指定
$Data::Dumper::Useperl = 1;
$Data::Dumper::Sortkeys = 1; # ハッシュキーのソート
$Data::Dumper::Indent = 1; # インデント縮める
$Data::Dumper::Terse = 1; # $VAR数字不要

複数行コメントアウト

=for comment
コメントアウトされる
=cut

=pod
これでもいいのだけど
=cut
=begin comment
この書き方がいちばん正しいかも
なぜなら
  perldoc aaa.pl
した時に現れなくなるから
=end commnet

=cut

継承

use base qw/Yugo::Common Yugo::Html/;

メソッドのオーバーライド

sub speak{
    my $class = shift;
    $class->SUPER::speak(@_);
}

定数 constant

↑ページトップへ

use constant AAA => 'aaa';
use constant BBB => 100;
use constant CCC => 24 * 60 * 60;
use constant YYY => [100, 200, 300];
use constant ZZZ => {a => 'A', b => 'B'};

print AAA, "\n";
print BBB * 10, "\n";
print CCC, "\n";
print YYY->[1], "\n";
for my $yyy ( @{YYY()} ) {
}
print ZZZ->{a}, "\n";
for my $zzz ( keys %{ZZZ()} ) {
}

# まとめて設定
use constant {
    AAA => 'aaa',
    BBB => 100,
    CCC => 24 * 60 * 60,
    YYY => [100, 200, 300],
    ZZZ => {a => 'A', b => 'B'},
};
use constant LIB_DIR => '/home/yugo/lib';
use lib LIB_DIR;

デバッグ

↑ページトップへ

# 起動
perl -d test.pl
# ブレークポイント
$DB::single = 1;
# 条件付ブレークポイント
if ($num == 2) { $DB::single = 1 }
# 警告をキャッチしてブレークポイントしかける
$SIG{__WARN__} = sub {
    $DB::single = 1;
};
  • q : 終了
  • n: 次の行実行
  • s: 次のステップ実行(サブルーチンの中も)
  • c: ブレークポイントまで実行
  • c 5: 5行目の直前まで実行
  • p $num: 変数の中身を表示
  • x \%hash: 変数の中身を表示(リファレンス渡し)
  • v: 周辺の行を表示
  • .: 現在の行を表示
  • (任意の文を実行させることも可能)

ホスト名の取得

↑ページトップへ

use Sys::Hostname qw/hostname/;

my $host = hostname();

関数の展開

↑ページトップへ

ヒアドキュメントでは使用不可。

print "あいうえお.$Class->aaa.かきくけこ。";

数値か文字列か

↑ページトップへ

perl 内部的に数値か文字かを判別する

sub num_or_str{
  my $v = shift;
  if( ($v ^ $v) eq '0' ){
    return '数値';
  }
  else{
    return '文字列';
  }
}

sub is_num{
  my $v = shift;
  if( ($v ^ $v) eq '0' ){
    return 1;
  }
  return 0;
}

パス/ファイル名/ディレクトリ

↑ページトップへ

use File::Basename;
my($base_name, $dir_name) = fileparse($path);
my $base_name = basename($path);
my $dir_name = dirname($path);

文字コード/文字セット関係

↑ページトップへ

utf8対応

use strict;
use warnings;
# ソースがutf8
use utf8;
use Encode;
# IN/OUTをutf8
use open IO => ":utf8";
# 標準出力をutf8
binmode STDOUT, ":utf8";

use utf8; について

  • substrやlength関数で、バイト単位じゃなくユニコード文字単位で処理してね、と教える指示。

基本

入ったきたものをdecodeして(UTF-8フラグON)、外へ出す時にencode(UTF-8フラグOFF)する。

全てUTF-8な環境で揃っているなら以下。

use utf8;
use Encode qw/encode_utf8 decode_utf8/;

# decode('utf8', $text) より decode_utf8($text) の方が速い
my $data = decode_utf8($ARGV[0]);
$data =~ s/あいう/かきく/g;
# encode('utf8', $text) より encode_utf8($text) の方が速い
print encode_utf8($data), "\n";

モジュール等からの返り値などで、UTF-8フラグが付いた文字列なのかバイト列なのか分からない場合もdecode_utf8が良い。
decode_utf8は「すでに UTF-8 flag がついた文字列はそのままコピーする」、そうでなければdecodeする。

$text = decode_utf8($byte_or_utf8);

ただし、これはEncode-2.13以降の話。
Encode2.12以前なら、以下(Perl5.8.8はEncode2.12)。
Encode::decode_utf8()であってもis_utf8()を使うべき理由 - Dマイナー志向

$text = Encode::is_utf8($byte_or_utf8) ? $byte_or_utf8: decode_utf8($byte_or_utf8);

UTF-8で書かれたTextをEUC-JPに変換し、変換しきれないものは実体参照に

404 Blog Not Found:perl - Encode 中級

use Encode;
while(<>){
  my $utf8 = decode_utf8($_);
  print encode('eucjp', $utf8, Encode::FB_HTMLCREF);
}
# Encode::FB_HTMLCREF だと10進数、Encode::FB_XMLCREF にすると16進数
# Encode::FB_PERLQQ にすると、\x{XXXX} 表記へ

※Encode 2.13(2006-01-14リリース) 以上では「FB_」不要

encodeを高速に

# 通常
my $str = Encode::encode('Shift_JIS', $str);
# 上記だと「Shift_JIS」あるいは「shiftjis」「sjis」等を同じものとして扱うために名前解決をしている。
# しなくていいようにするには以下。
my $enc = find_encoding('Shift_JIS');
my $str = $enc->encode($str);
# find_encoding で返ってくるのはオブジェクト(正規化された名前ではなく)

MIMEエンコード

# Perl 5.8.6以降?
use Encode;
my $subject = 'さぶじぇくと';
my $encoded = encode('MIME-Header-ISO_2022_JP', $subject);

UTF-8環境からShift_JIS/ISO-2022-JP/EUC-JPへ出力するときに文字化けしないように整える

cp932(Windows)環境由来のff5e, 2225, ff0d, ffe0, ffe1, ffe2が混入していると、(cp932以外の)Shift_JIS/ISO-2022-JP/EUC-JPへ変換する際に「マッピングできない」と言われるので、それぞれ変換できるものに置換して整えておく。

$text =~ tr/[\x{ff5e}\x{2225}\x{ff0d}\x{ffe0}\x{ffe1}\x{ffe2}]/[\x{301c}\x{2016}\x{2212}\x{00a2}\x{00a3}\x{00ac}]/;

逆に、整えてあるテキストをcp932へ変換する際には、301c, 2016, 2212をff5e, 2225, ff0dへ戻しておく(00a2, 00a3, 00acはcp932への変換で変換される)。

(my $for_cp932 = $text) =~ tr/[\x{301c}\x{2016}\x{2212}]/[\x{ff5e}\x{2225}\x{ff0d}]/;

cp932なテキストをUTF-8にしたいだけなら変換するだけでいい。
いくつかの文字を揃えておきたいなら、

(my $fixed = $cp932) =~ tr/[\x{ff5e}\x{2225}\x{ff0d}]/[\x{301c}\x{2016}\x{2212}]/;

これをcp932へ戻す必要があるなら、

(my $for_cp932 = $text) =~ tr/[\x{301c}\x{2016}\x{2212}]/[\x{ff5e}\x{2225}\x{ff0d}]/;
$text =~ s/\x{2014}/\x{2015}/g;
Shift_JIS 全角チルダ群 波ダッシュ群
8160 FF5e FULL WIDTH TILDE 301C WAVE DASH
816B 2225 PARALLEL TO 2016 DOUBLE VERTICAL LINE
817C FF0d FULLWIDTH HYPHEN-MINUS 2212 MINUS SIGN
8191 FFE0 FULLWIDTH CENT SIGN 00A2 ¢ CENT SIGN
8192 FFE1 FULLWIDTH POUND SIGN 00A3 £ POUND SIGN
81CA FFE2 FULLWIDTH NOT SIGN 00AC ¬ NOT SIGN
815C 2015 HORIZONTAL BAR 2014 EM DASH
横棒関係

どれかに揃えるなら、半角系(?)はHYPHEN-MINUS、全角系(?)はEM DASH。

002D - HYPHEN-MINUS 英数モードで入力するとこれ。
02D7 ˗ MODIFIER LETTER MINUS SIGN  
207B SUPERSCRIPT MINUS  
208B SUBSCRIPT MINUS  
2010 HYPHEN  
2011 NON-BREAKING HYPHEN  
2012 FIGURE DASH  
2013 EN DASH  
2014 EM DASH Macことえりで「ダッシュ(全角)」だとこれ。
2015 HORIZONTAL BAR Google 日本語入力で「[全]ダッシュ」だとこれ。
2212 MINUS SIGN Macことえりでマイナスを変換して「全角英字」にするとこれ。
FE63 SMALL HYPHEN-MINUS  
FF0D FULLWIDTH HYPHEN-MINUS  

PerlのバージョンとEncodeのバージョン

perl-5.8.1 Encode-1.9801
perl-5.8.2 Encode-1.9801
perl-5.8.3 Encode-1.99
perl-5.8.4 Encode-1.99_01
perl-5.8.5 Encode-2.01
perl-5.8.6 Encode-2.08
perl-5.8.7 Encode-2.10
perl-5.8.8 Encode-2.12

半角カナ→全角

use Lingua::JA::Regular::Unicode qw/katakana_h2z/;

$v = katakana_h2z($v);

ローマ字

いろいろな文字

U+FFFD REPLACEMENT CHARACTER 不明な入力文字や変換不能文字があった場合にこれを使う。れっきとしたユニコード文字なので、このままで使用可能(多くの環境でこのまま、その環境での表現で表示可能)。Perl5.8以降のEncode.pmではdecodeできなかった文字をデフォルトでこの文字へ置き換える。
U+3013 GETA MARK  
U+21B5 DOWNWARDS ARROW WITH CORNER LEFTWARDS 改行っぽい文字
U+23CE RETURN SYMBOL 改行

文字コード変換

Shift_JIS 0x5c

Shift_JISにて2byte目に0x5c(¥)がくる文字一覧。

― ソ Ы Ⅸ 噂 浬 欺 圭 構 蚕 十 申 曾 箪 貼 能 表 暴 予 禄 兔 喀 媾 彌 拿 杤 歃 濬 畚 秉 綵 臀 藹 觸 軆 鐔 饅 鷭 偆 砡 纊 犾

Perl with Macintiosh メモ

↑ページトップへ

Macのファイル名/パスの「UTF-8-MAC」を「UTF-8」へ

Mac OSのファイル/フォルダ名は、UTFのほぼNFDだけど、一部分だけ少し違う特殊なもの(=UTF-8-MAC)。

  • U+2000 - U+2FFF
  • U+F900 - U+FAFF
  • U+2F800 - U+2FAFF
use Text::Iconv;

my $mac_path = shift @ARGV'; #通常はディレクトリを開いたりして取得
my $normal_utf8_text = Text::Iconv->new('UTF-8-MAC', 'UTF-8')->convert($mac_path);

# 冗長に書くと以下

# 特殊なNFDなUTFから通常のUTF-8へ
my $mac_path = shift @ARGV'; #通常はディレクトリを開いたりして取得
my $path_nfc = Text::Iconv->new('UTF-8-MAC', 'UTF-8')->convert($mac_path);
# UTF-8フラグが落ちてしまったので、再度たてる
my $path_nfc_flagged = Encode::decode('UTF-8', $path_nfc);

あるいは、Encode::UTF8Mac - tomi-ruメモから Encode::UTF8Mac を利用。

use Encode;
use Encode::UTF8Mac;

my $path = Encode::decode('utf-8-mac', $path);

# encodeは、utf8(NFC)のままでも、システムが自動変換してくれるので、
# Encode::encode('utf-8-mac', $path) はしなくていい(してもいいけど)。

Windows ActivePerl メモ

↑ページトップへ

ファイルの入出力は、UTF-8/LFにしたい。
ソースファイルは当然UTF-8にしたい。
コマンドプロンプトへの出力はWindows環境な文字コード(cp932)に。

use strict;
use utf8;
use open IO => ":unix:utf8"; #:unixでLFに、:utf8でUTF-8に。
binmode STDIN,  ":crlf:encoding(cp932)";
binmode STDOUT, ":crlf:encoding(cp932)";
binmode STDERR, ":crlf:encoding(cp932)";

binmodeの指定は以下のようにしても。

map { binmode($_, ":crlf:encoding(cp932)") } qw/STDIN STDOUT STDERR/;

use Carp

↑ページトップへ

パッケージの中で例外を発生させる場合は、dieではなくcroak(呼び出し元の行番号を例外メッセージの中に含めてくれる)。

use Carp qw[croak];

croak 'Error!';
  • die() → croak()
  • warn() → carp()

※ちなみにdieやwarnはメッセージに\nを含むと「どこで(warn|die)したか」という情報はなくなる。

いろいろ

↑ページトップへ

#ひらがな
my @hiragana = map { chr } (ord('ぁ') .. ord('ん'));
# 漢字、ひらがな、カタカナにマッチング
$text =~ /[\p{Han}\p{Hiragana}\p{Katakana}]/;

処理時間

use Time::HiRes;
my $start_time = Time::HiRes::time;

# (計測したい処理)

printf "%0.3f", Time::HiRes::time - $start_time;

改行コードの統一

$v =~ s/\x0D\x0A|\x0D|\x0A/\n/g;

#以下の2行でやった方が圧倒的に速い
$v =~ s/\x0D\x0A/\n/g;
$v =~ tr/\x0D\x0A/\n\n/;

スクリプトのある場所

単純に実行ファイルと同ディレクトリのlib/を参照したいなら

Mojoliciousとかはこの記述。

use FindBin;
use lib "$FindBin::Bin/lib";

実際に移動しちゃう版

./libとか../logとか相対パスで書いてあるスクリプトをcronで動かしたりする時用に仕込んでおく。

use strict;
use warnings;

BEGIN {
  use FindBin '$Bin';
  chdir $Bin;
};

use lib './lib';
use Sakai;

my $log_dir = '../log';

/path/to/test.cgi の場合

use FindBin '$Bin';
print $Bin, qq"\n"; # --> /path/to

# スクリプトのある場所へ移動
chdir $Bin;

# 一緒だけど…
use FindBin;
print $FindBin::Bin, qq"\n"; # --> /path/to
# (ちなみにスクリプトファイル名は…)
print $FindBin::Script, qq"\n"; # --> sample.pl

# スクリプトのある場所へ移動
chdir $FindBin::Bin;

あるいは、

use Cwd; # Current Working Directory
my $cwd = Cwd::getcwd;
print $cwd, qq|\n|; # --> /path/to

# 以下でも
use Cwd;
print Cwd::getcwd, qq|\n|; # --> /path/to

別ディレクトリから呼び出した場合

# /another/path/call.cgi にて
my $reply = `/path/to/test.cgi`;

と、呼び出した場合、

# /path/to/test.cgi
use Cwd;
use FindBin qw/$Bin/;

print 'cwd: ', Cwd::getcwd, qq|\n|;
print 'Bin: ', $Bin, qq|\n|;

--> cwd: /another/path
--> Bin: /path/to
# 実体参照(すでに処理されたものは&を二重に処理しない)
$in =~ s/&(?!#?[xX]?(?:[0-9a-fA-F]+|\w{1,8});)/&amp;/g;
$in =~ s/"/&quot;/g;
$in =~ s/</&lt;/g;
$in =~ s/>/&gt;/g;
$in =~ s/'/&apos;/g;

caller

↑ページトップへ

# 引数なし
sub my_func {
  my ( $package_name, $filename, $line_no ) = caller;
}
# 引数(呼び出し深さ)あり→返り値が多くなる
sub my_func {
  my ( $package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask ) = caller 0;
}
# サブルーチン名だけ
sub my_func {
  my $subroutine_name = ( caller 0 )[3];
}
# 呼び出し元(これが呼び出される1つ手前)のサブルーチン名
sub my_func {
  my $subroutine_name = ( caller 1 )[3];
}

設定ファイル

↑ページトップへ

外部にPerl形式で設定ファイルを置いた場合。

# conf.pl
{
  name => 'tel',
  value => '03-1234-5678',
  options => [qw/0 1 2 3/],
}
# perl.pl
my $param = do './conf.pl' or die "$!$@";

※doはファイルをPerlのソースコードとして読み込む関数。

あるいは、

# conf.pl
{
  name => 'tel',
  value => '03-1234-5678',
  options => [qw/0 1 2 3/],
};

と末尾にセミコロンを付けて、

# perl.pl
my $param = require './conf.pl';

とか。

デフォルト値

↑ページトップへ

404 Blog Not Found:perl - デフォルト値のperlらしい指定法より。

sub test {
  my $text = shift || 'default';
}
# ゼロや空があるなら
sub test {
  my $text = shift;
  $text = '' if not defined $text;
}
# Perl 5.10以降なら
sub test {
  my $text = shift // 'default';
}

# hashの場合
sub new {
  my $class = shift;
  bless {
    dir => '/path/to',
    @_
  }, ref $class || $class;
}

CGI関係

↑ページトップへ

use CGI;
my $cgi = CGI->new;
my $value = $cgi->param(key);
my @keys = $cgi->param();
use CGI;
my $cgi = CGI->new;
my %param = $cgi->Vars;
# 同名パラメータは\0でjoinされてくる
use CGI::Carp qw/fatalsToBrowser warningsToBrowser/;
# fatalsToBrowser 致命的エラー
# warningsToBrowser 警告メッセージ

content-type

Content-Type: text/html\n\n
Content-Type: text/html; charset=UTF-8\n\n
Content-Type: text/html; charset=Shift_JIS\n\n
ファイル種類 拡張子 MIME-Type
テキスト .txt text/plain
CSV .csv text/csv
TSV .tsv text/tab-separated-values
Excel .xls application/vnd.ms-excel
PDF .pdf application/pdf
CSS .css text/css
JavaScript .js text/javascript
MP3 .mp3 audio/mpeg
MP4 .m4a audio/mp4
WAV .wav audio/x-wav

shebang(シバン/シェバン)行 #! 1行目

↑ページトップへ

#!/usr/local/bin/perl
#!/usr/bin/perl

envを用いたトリック。ENV{PATH}から探す。普通は引数が渡せない。万能ではないのでクリティカルな要件では注意。

#!/usr/bin/env perl

どこのPerlが使われているか。

#!/usr/bin/perl
die "my perl is $^X";

print

↑ページトップへ

ファイルハンドルを変数に入れてなんか複雑になってたりする場合は、ブロックにする必要あり。

print $fh "out\n";
print { $self->{fh} } "out\n";
print { $files[$i] } "out\n";

# こんなことも
print { $OK ? STDOUT : STDERR } "out\n";

STDIN 対話 キーボード入力

↑ページトップへ

# ver. 1
my $stdin = <STDIN>;
chomp $stdin;

# ver. 2
chomp( my $stdin = <STDIN> );

# ver. 3
my $age;
print 'AGE=';
while (chomp(my $stdin = <STDIN>) ) {
    if ($stdin =~ /^\d+$/) {
        $age = $stdin;
        last;
    }
    print "-> Please input 0-9.\n";
    print 'AGE=';
}
print qq|AGE: "$age"\n|;

セッションID生成

↑ページトップへ

例えば。

use Time::HiRes;
use Digest::MD5 qw/md5_hex/;

sub session_key {
  # 32桁の文字列が返る。
  return md5_hex( join('',
    ($ENV{SERVER_ADDR} ? $ENV{SERVER_ADDR} : '0:0:0:0'),
    sprintf("%10d", $$),
    sprintf("%10d", int(rand(999999999))),
    Time::HiRes::time
  ) );
}

useとrequire

↑ページトップへ

use MODULE qw/method1 method2/; は以下と同義。

BEGIN {
    require MODULE;
    MODULE->import(qw/method1 method2/);
}

ちなみに、

if($needs == 1){
  require "Hoge.pm"; # $needsが1だった場合にメモリにロードされる。
  use Hoge;          # $needsの値に関係なく、コンパイル時にメモリにロードされる(なのでここに書く意味ない)。
}

Model Loader 最低限のモデルローダ

↑ページトップへ

use Model;
my $yugo = Model->new->instance('Yugo');

とすることで、Yugo.pmをロードして、インスタンスを返す。
use Module::Load;は、Perl5.10以降で標準モジュール(ただしCentOSではコアモジュールにも関わらず省かれているかも)。

package Model;
use strict;
use warnings;
use Module::Load;

sub new {
  my $self = shift;
  return bless {}, $self;
}

my $cache = {};

sub instance {
  my $self = shift;
  my $module = shift;

  if (!$cache->{$module}) {
    load $module;
    $cache->{$module} = $module->new;
  }
  return $cache->{$module};
}

1;

__DATA__

↑ページトップへ

while (my $line = <DATA>) {
  chomp $line;
  my @cells = split /\s+/, $line;
}

_DATA_
111  aaa
222  bbb
333 ccc

タイムアウト

↑ページトップへ

my $second = 5;
local $@;
eval {
  local $SIG{ALRM} = sub { die "timeout\n"; };
  alarm $second;
  long_process();
  alarm 0;
};
print "exception: $@\n";

sub long_process {
  for my $i (map { sprintf "%02d", $_ } 1..99) {
    system "ssh hostname$i command";
  }
}

テスト

↑ページトップへ

動的ロード

↑ページトップへ

use UNIVERSAL::require;
my $class = "MyApp::Test";
$class->require or "can't load module $class ", $@;

use UNIVERSAL::require; を使わないと。

my $class = "MyApp::Test";
eval{ require $class };
die "can't load module $class ", $@ if ( $@ );

定番/これをするなら

↑ページトップへ

設定

  • toml-lang/toml · GitHub(githubの中の人提案)
  • YAML(仕様書80ページ=正しく使うの意外と大変)
  • JSON(カッコやクオート多い/コメント使えない)

定数

  • Readonly(5.10標準モジュール/Perlベストプラクティス推奨/遅め/上書き実行時検出)
  • constant(5.8標準モジュール/上書きコンパイル時検出/単なる関数)
  • Attribute::Constant(or Data::Lock)(Dan Kogai/速い)

日時

  • Time::Piece
  • Time::Piece::MySQL

配列

  • List::Util(max/sum…)
  • List::MoreUtils(any/uniq…)

パス

  • Path::Class
  • Path::Tiny

モデル

  • Mouse(Mooseより軽量なオブジェクトシステム)
    • 他にはClass::Accessor(::Lite)

データベース O/Rマッパ

  • Teng
  • SQL::Maker
  • DBIx::QueryLog

エンコード

  • Lingua::JA::Regular::Unicode(ひらがな/カタカナ/全角/半角…)

メール

  • Email::Sender

テスト

  • Test::More

デバッグ

  • Devel::KYTProf

認証

  • OAuth::Lite2(boketeで使用/作者が日本人)

  • Data::Validator(バリデーション/サブルーチン引数チェック)
  • Try::Tiny(try/catchなエラーハンドリング)
  • FormValidator::Lite(ウェブフォームバリデーション)
  • HTML::FillInForm::Lite(フォーム入力で戻った時、再度埋める)
  • HTML::Scrubber(許可タグ/NGタグを指定してNGタグを除去)
  • Woothee(UA判定)
  • WWW::Mechanize::Sleepy(WWW::Mechanize+sleep)
  • Web::Scraper
  • URI::Find(テキストないのURLをリンクに)
  • HTML::Scrubber(タグ除去)
  • String::Random(ランダム文字列→パスワード生成)

↑ページトップへ

Perlにおける静的解析