Perl実用プログラムサンプル

2012/05/23

Perl - 全角カナ⇔半角カナ 変換のサンプル

テストデータは、プログラムの後につけているので kana.txt ファイルとして利用できる。

#------------------------------------------------
# 全角カナ⇔半角カナ 変換のサンプル
#------------------------------------------------

use strict;          # 不適切な構文の使用を制限するプラグマ
use warnings;        # 不適切な構文を警告するプラグマ

use Encode;
use Encode::JP::H2Z;

require("lib_file.pl");  # ライブラリファイル取り込み

#------------------------
# サブルーチン宣言
#------------------------
sub test_kana();
sub kana_z2h($);
sub kana_h2z($);

# 全角カナ⇔半角カナのテストサンプル実行
test_kana();

#-----------------------------
# 全角カナ⇔半角カナのテストサンプル
#-----------------------------
sub test_kana()
{
    my $in_file;
    my $out_z2h;
    my $out_h2z;
    my $in_fh;
    my $z2h_fh;
    my $h2z_fh;
    my $read_data;
    my $kana_data;

    $in_file = 'kana.txt';         # 全半角カナ混在テキスト
    $out_z2h = 'kana_z2h.txt';     # 半角カナ変換後出力ファイル
    $out_h2z = 'kana_h2z.txt';     # 全角カナ変換後出力ファイル

    # 全半角カナ混在テキストオープン
    if( !open($in_fh, '<', $in_file))
    {
        logout("perl_log", qq/Can't open file "$in_file": $!/);
        exit(-1);
    }

    # 半角カナ変換後出力ファイルオープン
    if( !open($z2h_fh, '>', $out_z2h))
    {
        logout("perl_log", qq/Can't open file "$out_z2h": $!/);
        exit(-1);
    }

    # 全角カナ変換後出力ファイルオープン
    if( !open($h2z_fh, '>', $out_h2z))
    {
        logout("perl_log", qq/Can't open file "$out_h2z": $!/);
        exit(-1);
    }

    # 全半角カナ混在テキストを読出し半角/全角カナ変換後
    # 出力ファイルを作成する
    while( $read_data = <$in_fh> )
    {
        chomp($read_data);             # 末尾の改行削除

        # 全角カナ → 半角カナ変換
        $kana_data = kana_z2h($read_data);

        # 半角カナ変換後出力ファイルへ出力
        print($z2h_fh $kana_data, "\n");

        # 半角カナ → 全角カナ変換
        $kana_data = kana_h2z($read_data);

        # 全角カナ変換後出力ファイルへ出力
        print($h2z_fh $kana_data, "\n");
    }

    # オープンしたファイルをクローズ
    close($in_fh);
    close($z2h_fh);
    close($h2z_fh);
}

#------------------------------------------------
# 全角カナ → 半角カナ変換
#------------------------------------------------
sub kana_z2h($)
{
    my $str;

    $str = shift;

    Encode::from_to($str, "utf8", "euc-jp");
    Encode::JP::H2Z::z2h(\$str);
    Encode::from_to($str, "euc-jp", "utf8");

    return($str);
}

#------------------------------------------------
# 半角カナ → 全角カナ変換
#------------------------------------------------
sub kana_h2z($)
{
    my $str;

    $str = shift;

    Encode::from_to($str, "utf8", "euc-jp");
    Encode::JP::H2Z::h2z(\$str);
    Encode::from_to($str, "euc-jp", "utf8");

    return($str);
}

#------------------------------------------------
# END
#------------------------------------------------

#------------------------------------------------
# 全角カナ⇔半角カナ TEST DATA

#------------------------------------------------

■全角カナ一覧
ァアィイゥウェエォオカガキギクグケゲコゴサザシジスズセゼソゾ
タダチヂッツヅテデトドナニヌネノハバパヒビピフブプヘベペホボポ
マミムメモャヤュユョヨラリルレロヮワヰヱヲンヴヵヶ

■半角カナ一覧
アイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワヲンァィゥェォャュョッー゙゚。「」、・

●半角英数/記号
!"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]
^_`abcdefghijklmnopqrstuvwxyz{|}~

●全角ひらがな
ぁあぃいぅうぇえぉおかがきぎくぐけげこごさざしじすずせぜそぞ
ただちぢっつづてでとどなにぬねのはばぱひびぴふぶぷへべぺほぼぽ
まみむめもゃやゅゆょよらりるれろゎわゐゑをん

●全角英数
ABCDEFGHIJKLMNOPQRSTUVWXYZ
abcdefghijklmnopqrstuvwxyz
0123456789

#------------------------------------------------
# TEST DATA END
#------------------------------------------------

2012/05/22

Perl - base64形式(エンコード/デコード)のサンプル

ファイル処理でエラーが出た場合、ログ出力するようにしている。
ログ出力は、先ほどの「Perl - ログファイル出力のサンプル」を利用しているので、ライブラリファイルにログ出力のサブルーチンを追加しておく。
エンコードまたはデコードのテストサンプルで、エンコード時の出力ファイル(デコード時は入力ファイル)で改行の有無を設定できる。
#------------------------------------------------
# base64形式(エンコード/デコード)のサンプル
#------------------------------------------------

use strict;              # 不適切な構文の使用を制限するプラグマ
use warnings;            # 不適切な構文を警告するプラグマ

use MIME::Base64 qw(encode_base64 decode_base64);

require("lib_file.pl");  # ライブラリファイル取り込み

#------------------------
# サブルーチン宣言
#------------------------
sub test_encode();
sub test_decode();
sub base64_encode($);
sub base64_decode($);

# テスト実行
test_encode();
test_decode();

#-----------------------------
# エンコードのテストサンプル(MIME)
# プレーンテキスト -> base64
#-----------------------------
sub test_encode()
{
    my $in_file;
    my $out_file;
    my $in_fh;
    my $out_fh;
    my $read_data;
    my $encode_data;

    $in_file  = 'data.txt';         # プレーンテキスト
    $out_file = 'data_encode.txt';  # エンコード後出力ファイル

    # プレーンテキストオープン
    if( !open($in_fh, '<', $in_file))
    {
        logout("perl_log", qq/Can't open file "$in_file": $!/);
        exit(-1);
    }

    # エンコード後出力ファイルオープン
    if( !open($out_fh, '>', $out_file))
    {
        logout("perl_log", qq/Can't open file "$out_file": $!/);
        exit(-1);
    }

    # プレーンテキストを57バイトづつ読出しエンコード出力する
    while( read($in_fh, $read_data, 57) )
    {
        # base64形式にエンコード
        $encode_data = base64_encode($read_data);

        # エンコード後出力ファイルに出力する
        print($out_fh $encode_data, "\n");   # (1)改行コード有
#       print($out_fh $encode_data);         # (2)改行コードなし

    }

    # オープンしたファイルをクローズ
    close($in_fh);
    close($out_fh);
}

#-----------------------------
# デコードのテストサンプル(MIME)
# base64 -> プレーンテキスト
#-----------------------------
sub test_decode()
{
    my $in_file;
    my $out_file;
    my $in_fh;
    my $out_fh;
    my $read_data;
    my $decode_data;

    $in_file  = 'data_encode.txt';  # デコード(base64)入力ファイル
    $out_file = 'data_decode.txt';  # デコード後出力ファイル

    # デコード(base64)入力ファイルオープン
    if( !open($in_fh, '<', $in_file))
    {
        logout("perl_log", qq/Can't open file "$in_file": $!/);
        exit(-1);
    }

    # デコード後出力ファイルオープン
    if( !open($out_fh, '>', $out_file))
    {
        logout("perl_log", qq/Can't open file "$out_file": $!/);
        exit(-1);
    }

    while( $read_data = <$in_fh> )          # (1)改行コード有
#   while( read($in_fh, $read_data, 76) )   # (2)改行コードなし

    {
        # base64形式のデータをデコード
        $decode_data = base64_decode($read_data);

        # デコード後出力ファイルに出力する
        print($out_fh $decode_data);
    }

    # オープンしたファイルをクローズ
    close($in_fh);
    close($out_fh);
}

#------------------------------------------------
# base64形式にエンコード
#------------------------------------------------
sub base64_encode($)
{
    my $indata;
    my $b64_data;

    # エンコードするデータを取得
    $indata = shift;

    # base64にエンコードする
    # エンコード後に付加される改行は削除する(呼出元で改行処理する)
    $b64_data = encode_base64($indata, '');

        # 第2引数を指定しない場合改行が付加される
        # 第2引数省略時のデフォルトは改行である

    # エンコードしたデータを返却
    return($b64_data);
}

#------------------------------------------------
# base64形式のデータをデコード
#------------------------------------------------
sub base64_decode($)
{
    my $indata;
    my $data;

    # デコードするデータを取得
    $indata = shift;

    # base64からデコードする
    $data = decode_base64($indata);

    # デコードしたデータを返却
    return($data);
}

#------------------------------------------------
# END
#------------------------------------------------

Perl - ログファイル出力のサンプル

プログラムを実行していて実行結果やエラーをファイルに出力し残したい場合、次のプログラムが参考になる。
ログに結果を残す場合、いつのログか判るように日時情報が必要になる。ここでは、先ほど作成したライブラリファイルを利用している。
ログファイル名には、年月日を設定することで日単位にログを残すことができる。

#------------------------------------------------
# Logファイル出力のサンプル
#------------------------------------------------

use strict;              # 不適切な構文の使用を制限するプラグマ
use warnings;            # 不適切な構文を警告するプラグマ

require("lib_file.pl");  # ライブラリファイル取り込み

#------------------------
# サブルーチン宣言
#------------------------
sub logout(@);

# ログ出力テスト
logout("log", "ログファイル出力開始!!");

#------------------------------------------------
# ログのファイル出力
#   引数1:ログファイル名
#   引数2:出力するログメッセージ
#------------------------------------------------
sub logout(@)
{
    my $lognam;
    my $logmsg;
    my $logfile;
    my $fh_log;
    my $ymd;
    my $hms;

    ($lognam, $logmsg) = @_;        # 引数取得

    # ログファイル名が省略時は"perl_log"を設定
    if ( length($lognam) == 0 )
    {
        $lognam = "perl_log";
    }

    $ymd = get_date("LFM");         # 日付取得
    $hms = get_time("LFM");         # 時間取得

    #---------------------------------
    # ログファイル名作成
    #   ログファイル名 + 日付.log
    #---------------------------------
    $logfile = sprintf("%s%s.log", $lognam, $ymd);

    #---------------------------------
    # ログファイル追加モードでオープン
    #---------------------------------
    open($fh_log, '>>', $logfile)
        or die(qq/Can't open file "$logfile": $!/);

    #---------------------------------
    # ログ書き込み
    #   日付 時間 : ログメッセージ(改行)
    #---------------------------------
    printf($fh_log "%s %s : %s\n", $ymd, $hms, $logmsg);

    #---------------------------------
    # ログファイルクローズ
    #---------------------------------
    close($fh_log)
        or die(qq/Can't close file "$logfile": $!/);
}

#------------------------------------------------
# END
#------------------------------------------------

Perl - ライブラリファイル

サブルーチンの中でグローバル変数を使用しないようにすると、サブルーチンの再利用性を高めることができる。汎用性のあるサブルーチンはライブラリファイルとしてスクリプトに組み込むことでができる。

■ライブラリファイルの作成方法
  以下のような形式で作成する。ライブラリの場合スクリプトの最後に 1; を付けることに注意する。
  ファイル名は任意であるが、拡張子に .pl を使うのが一般的である。

#---------------------------------------------------
# サブルーチン定義
sub xxxx_1()
{
    処理_1;
}

sub xxxx_2()
{
    処理_2;
}

# 戻り値
1;

#---------------------------------------------------

■ライブラリの呼出方
  require関数を使う。ファイル名にディレクトリを含めることができる。

require("lib_file.pl");

■具体的なライブラリファイルの作成例
  「Perl - 日付、時刻の取得のサンプル」で紹介した日付取得と時刻取得をライブラリフ
ァイルにする場合以下のようになる。(ほとんど単純にコピペでできる)
  これを、ファイル名(ここでは)"lib_file.pl"として作成すればよい。

#------------------------------------------------
# ライブラリファイル
#------------------------------------------------

#------------------------------
# 日付取得 sample
#   引数:DFM:表示フォーマット(ex. 2012年05月14日 (月))
#         LFM:ログフォーマット(ex. 20120514)
#------------------------------
sub get_date($)
{
    my $mode;
    my $Str_date;
    my $mday;
    my $mon;
    my $year;
    my $wday;
    my @youbi = qw(日 月 火 水 木 金 土);

    $mode = shift;
    ($mday, $mon, $year, $wday) = (localtime(time))[3..6];
                                  # 日、月、年、週のみ取得
    $year += 1900;
    $mon += 1;

    if ( $mode eq "DFM" )
    {
        $Str_date = sprintf("%04s/%02s/%02s (%s)", $year, $mon, $mday, $youbi[$wday]);
    }
    else
    {
        $Str_date = sprintf("%04s%02s%02s", $year, $mon, $mday);
    }

    return($Str_date);
}

#------------------------------
# 時刻取得 sample
#   引数:DFM:表示フォーマット(ex. 14:15:16)
#         LFM:ログフォーマット(ex. 141516)
#------------------------------
sub get_time($)
{
    my $mode;
    my $Str_time;
    my $sec;
    my $min;
    my $hour;

    $mode = shift;
    ($sec, $min, $hour) = (localtime(time))[0..2];
                                  # 秒、分、時のみ取得
    if ( $mode eq "DFM" )
    {
        $Str_time = sprintf("%02s:%02s:%02s", $hour, $min, $sec);
    }
    else
    {
        $Str_time = sprintf("%02s%02s%02s", $hour, $min, $sec);
    }

    return($Str_time);
}

# 戻り値
1;

#------------------------------------------------
# LIB END
#------------------------------------------------

2012/05/21

Perl - 乱数生成のサンプル

#------------------------------------------------
# 乱数生成のサンプル
#------------------------------------------------

use strict;          # 不適切な構文の使用を制限するプラグマ
use warnings;        # 不適切な構文を警告するプラグマ

#------------------------
# サブルーチン宣言
#------------------------
sub test_main();
sub randam($);

# テスト実行
test_main();

sub test_main()
{
    my $i;
    my $j;

    # 0 ~ 99 までの乱数を 10 × 10 マスで出力表示
    for( $i = 0; $i < 10; $i++ )
    {
        for( $j = 0; $j < 10; $j++ )
        {
            printf("%2s ", randam(100));
        }
        print("\n");
    }

    exit(0);
}

#------------------------------------------------
# 0~(n-1)の乱数を生成
#------------------------------------------------
sub randam($)
{
    my $n = (@_)[0];         # 引数の取得
#    my $n = shift;          # 引数1個の場合、この記述でもOK
    my $rnd_value;

    $rnd_value = int(rand($n));       # 0~(n-1)の乱数
    return($rnd_value);               # 生成した乱数を返却
}

#------------------------------------------------
# END
#------------------------------------------------

Perl - 日本語の文字化け対策

基本というかトラブルを未然に防ぐためにも、プログラムコード、入出力ファイルは全て「UTF-8」の Unicode で統一しておくのがベストである。

とは言いつつも入力ファイルは、別なシステムで作成されたりした場合「UTF-8」でない事も少なくない。(sjis や euc-jp その他)

そのような場合は、nkf コマンド等で「UTF-8」に変換して対応するのがよいかと思う。

それでも??と言う場合は、以下の方法を試してみてはどうか。

■方法1 - プログラムを「シフトJIS」コードで書く場合
use encoding "cp932";
$/ = "\r\n";

プログラムの先頭に上記2行を記述する。
1行目は「シフトJIS」コードを「Unicode」に変換して読み込んで処理してくれる。
2行目はキーボードやファイルの改行コードが Windows 標準の「CR+LF」であることを指定している。

■方法2 - プログラムを「UTF-8」の Unicode で書く場合
use utf8;
binmode STDIN,  ":encoding(cp932)";
binmode STDOUT, ":encoding(cp932)";

プログラムの先頭に上記3行を記述する。
1行目は 「UTF-8」コードを使用することを宣言している。
2,3行目はキーボード入力やディスプレー出力を「シフトJIS」コードに変換するよう宣言している。

Perl - 日付、時刻の取得のサンプル

#------------------------------------------------
# 日付、時刻の取得のサンプル
#------------------------------------------------

use strict;            # 不適切な構文の使用を制限するプラグマ
use warnings;          # 不適切な構文を警告するプラグマ

#------------------------
# サブルーチン宣言
#------------------------
sub get_date($);
sub get_time($);

#------------------------------
# 処理結果確認
#   DFM:表示フォーマット(ex. 2012年05月14日 (月) or 14:15:16)
#   LFM:ログフォーマット(ex. 20120514  or 141516)
#------------------------------
print("表示フォーマットで確認 ...\n");
print(get_date("DFM"), "\n");
print(get_time("DFM"), "\n");
print(get_date("DFM"), " ", get_time("DFM"), "\n");

print("ログフォーマットで確認 ...\n");
print(get_date("LFM"), "-", get_time("LFM"), "\n");

exit(0);

#------------------------------
# 日付取得 sample
#   引数:DFM:表示フォーマット(ex. 2012年05月14日 (月))
#         LFM:ログフォーマット(ex. 20120514)
#------------------------------
sub get_date($)
{
    my $mode;
    my $Str_date;
    my $mday;
    my $mon;
    my $year;
    my $wday;
    my @youbi = qw(日 月 火 水 木 金 土);

    $mode = shift;
    ($mday, $mon, $year, $wday) = (localtime(time))[3..6];
                                  # 日、月、年、週のみ取得
    $year += 1900;
    $mon += 1;

    if ( $mode eq "DFM" )
    {
        $Str_date = sprintf("%04s/%02s/%02s (%s)", $year, $mon, $mday, $youbi[$wday]);
    }
    else
    {
        $Str_date = sprintf("%04s%02s%02s", $year, $mon, $mday);
    }

    return($Str_date);
}

#------------------------------
# 時刻取得 sample
#   引数:DFM:表示フォーマット(ex. 14:15:16)
#         LFM:ログフォーマット(ex. 141516)
#------------------------------
sub get_time($)
{
    my $mode;
    my $Str_time;
    my $sec;
    my $min;
    my $hour;

    $mode = shift;
    ($sec, $min, $hour) = (localtime(time))[0..2];
                                  # 秒、分、時のみ取得
    if ( $mode eq "DFM" )
    {
        $Str_time = sprintf("%02s:%02s:%02s", $hour, $min, $sec);
    }
    else
    {
        $Str_time = sprintf("%02s%02s%02s", $hour, $min, $sec);
    }

    return($Str_time);
}

#------------------------------------------------
# END
#------------------------------------------------

2012/05/20

Perl - 配列のサンプル

#------------------------------------------------
# 配列のサンプル
#------------------------------------------------

use strict;          # 不適切な構文の使用を制限するプラグマ
use warnings;        # 不適切な構文を警告するプラグマ

#------------------------
# サブルーチン宣言
#------------------------
sub test_main();
sub input_key();
sub input_ck($);
sub dsp_num($);
sub dsp_week($);
sub dsp_month($);

# テスト実施
test_main();

#------------------------
# test_main処理
#------------------------
sub test_main()
{
    my $Num;

    $Num = input_key();

    # 入力数字を表示(半角/全角)
    if ( $Num >= 0 && $Num <= 9 )
    {
        dsp_num($Num);
    }

    # 週を表示
    # 0~6 => 日(Sunday)~土(Saturday)
    if ( $Num >= 0 && $Num <= 6 )
    {
        printf("週:%s\n", dsp_week($Num));
    }

    # 月を表示
    # 0~11 => 1月(January)~12月(December)
    if ( $Num >= 0 && $Num <= 11 )
    {
        printf("月:%s\n", dsp_month($Num));
    }

    exit(0);
}

#----------------------
# Key入力
#----------------------
sub input_key()
{
    my $Num;

    print("数字を入力 = ");
    $Num = <STDIN>;
    chomp($Num);             # 末尾の改行削除

    if (input_ck($Num) == 0 )
    {
        return($Num);
    }
    else
    {
        print("異常終了\n");
        exit(-1);
    }
}

#----------------------
# 入力値の判定
#----------------------
sub input_ck($)
{
    my $Num;

    $Num = shift;

    if ($Num =~ /^\d+$/)
    {
        print("入力は数字です\n");
        return(0);
    }
    else
    {
        print("入力は数字以外です\n");
        return(-1);
    }
}

#------------------------------
# 配列定義のサンプル
#------------------------------
sub dsp_num($)
{
    my @HNum = (0 .. 9);
               # 一つずつ増加する要素の場合、範囲演算子(..)を使えば
               # 間の値を補完できる
    my @ZNum = qw(0 1 2 3 4 5 6 7 8 9);
               # qw演算子では、要素の""を省略できる
    my $Num = shift;

    print(@HNum, "\n");
    print(@ZNum, "\n");
    print("半角:", $HNum[$Num], " / ", "全角:", $ZNum[$Num], "\n");
    print("\n");
}

#------------------------------
# 週名の取得
#------------------------------
sub dsp_week($)
{
    my @Week;
    my $Num;
    my $ret_week;

    # 引数取得
    $Num = shift;

    # 配列(週)定義
    @Week = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);

    # 配列(週)から週名取得
    $ret_week = $Week[$Num];

#-- DEBUG START -------------------------
# デバック -- 配列(週)の内容表示
#----------------------------------------
my $i;
my $Str_i;
$i = 0;
foreach $Str_i (@Week)
{
    printf("len(%02d) %-10s : %d\n", length($Str_i), $Str_i, $i);
    $i++;
}
print("\n");
#-- DEBUG END ---------------------------

    # 結果返却
    return($ret_week);
}

#------------------------------
# 月名の取得
#------------------------------
sub dsp_month($)
{
    my @Month;
    my $Num;
    my $ret_month;

    # 引数取得
    $Num = shift;

    # 配列(月)定義
    @Month = qw(January February March April May June July August
                September October November December);

    # 配列(月)から月名取得
    $ret_month = $Month[$Num];

    # 結果返却
    return($ret_month);
}

#------------------------------------------------
# END
#------------------------------------------------

その他のカテゴリー