[Perl]cloc ソースコードカウント

ダウンロード
cloc
実行例

$ perl cloc-1.60.pl ./hello/
      32 text files.
      30 unique files.
      18 files ignored.

http://cloc.sourceforge.net v 1.60  T=1.00 s (15.0 files/s, 9409.0 lines/s)
-------------------------------------------------------------------------------
Language                     files          blank        comment           code
-------------------------------------------------------------------------------
Bourne Shell                     5            774            915           5784
make                             4            110             41            849
m4                               2             96             14            781
C                                2              4              1             16
C/C++ Header                     2              7              9              8
-------------------------------------------------------------------------------
SUM:                            15            991            980           7438
-------------------------------------------------------------------------------

Makefile等を除く

$ perl cloc-1.60.pl --exclude-lang=make,m4,"Bourne Shell" ./hello/
      32 text files.
      30 unique files.
      29 files ignored.

http://cloc.sourceforge.net v 1.60  T=0.50 s (8.0 files/s, 90.0 lines/s)
-------------------------------------------------------------------------------
Language                     files          blank        comment           code
-------------------------------------------------------------------------------
C                                2              4              1             16
C/C++ Header                     2              7              9              8
-------------------------------------------------------------------------------
SUM:                             4             11             10             24

[Perl]csvファイルの行列を入れ替え

# -*- coding: utf-8 -*-
use strict;
use utf8;

# csv ファイルの行列を入れ替える
my $inputFileName = 'input.csv';
my $outputFileName = 'output.csv';

open(IN, $inputFileName);
open(OUT, '> ' . $outputFileName);

my %b;
my $i = 0;
while () {
    chomp;
    my @r = split(/,/, $_);
    $i = 0;
    foreach $a (@r) {
        $b{$i} .= ($a . ",");
        $i++;
    }
}
for (my $j = 0; $j < $i; $j++) {
    # 末尾の , は削除する
    $b{$j} = substr($b{$j}, 0, -1);
    print(OUT $b{$j} . "\n");
}
close(IN);
close(OUT);

input.csv

2013-1-1,6.5
2013-1-2,10.0
2013-1-3,5.6
2013-1-4,3.2
2012-1-5,2.8

実行結果
output.csv

2013-1-1,2013-1-2,2013-1-3,2013-1-4,2012-1-5
6.5,10.0,5.6,3.2,2.8

[Perl]Gnuplot

Chart::Graph で Gnuplot を操作
Chart::Graph モジュールをインストール

ppm> install Chart-Graph

Windows で実行すると temporary directory `/tmp/Graph_Gnuplot_xxxx' を作成できないとエラー表示されるので、環境変数に TMPDIR を設定すればよいと考えたのだが、

> set TMPDIR=%USERPROFILE%\Local Settings\Temp

このようにすると出力先指定でディレクトリ記号が

set output "C:\Documents and Settings\xxxxxxx\Local Settings\
            Temp/Graph_Gnuplot_7672/plot.2.png"

\ (円マーク)と / (スラッシュ) の混在となってしまう。これでは gnuplot が解釈できないのでスクリプト内で

$ENV{TMPDIR}=".";

と指定して出力先を current directory 以下にしてもらう。

set output "./Graph_Gnuplot_7980/plot.2.png"

スクリプトから gnuplot を実行しようとするところで

program not found in search path: gnuplot

とエラー表示される。これは Chart::Graph::Utils 内で使用される _get_path が Linux 形式の PATH しか対応していないためである。

sub _get_path {
    my ($exe) = @_;
    my @path = split (/:/, $ENV{PATH});
    my $program;

    foreach my $i(@path){
   $program = "$i/$exe";
   if (-x $program) {
  return $program;
   }
    }

    carp "program not found in search path: $exe";
    return 0;
}

また gnuplot というコマンドを実行しようとするので Perl/site/lib/Chart/Graph/Gnuplot.pm にある gnuplot コマンドを設定する _set_gnupaths を見てみると

sub _set_gnupaths {

    if (not defined($gnuplot)) {
 if (not $gnuplot = _get_path("gnuplot")) {
     return 0;
 }
    }

    if (not defined($ppmtogif)) {
 if (not $ppmtogif = _get_path("ppmtogif")) {
     return 0;
 }
    }
    return 1;
}

となっているので $gnuplot に直接実行プログラムを記述してやればこの問題は回避できる。
使い方
Windows 用 Gnuplot では pgnuplot.exe なので下記のように指定する。

$Chart::Graph::Gnuplot::gnuplot = "c:/usr/gnuplot/bin/pgnuplot.exe";

Example: テストスクリプト

use utf8;
use Chart::Graph::Gnuplot qw(gnuplot);
$Chart::Graph::save_tmpfiles = 0;
$Chart::Graph::Gnuplot::gnuplot = "c:/usr/gnuplot/bin/pgnuplot.exe";

$ENV{TMPDIR}=".";

gnuplot({'title' => 'Test graph',
   'xrange' => '[0:3]',
   'yrange' => '[0:50]',
   'output type' => 'png',
   'output file' => 'test.png',
   'size' => [0.625, 0.625],
   'extra_opts' => join("\n", 'set grid'),
},
  [{'title' => 'data1',
    'type' => 'matrix'}, [[0,5],
        [1,10],
        [2,20],
        [3,30]]],
  [{'title' => 'data2',
    'style' => 'lines',
    'type' => 'matrix'}, [[0,20],
        [1,5],
        [2,15],
        [3,12]]],
  [{'title' => 'y=10x+10',
    'style' => 'lines',
    'type' => 'function'}, '10+10*x'],
 );

size を指定しているのは、出力データの画像サイズを調整するため。デフォルト (size 指定なし) では 640x480 pixel となるので 400x300 pixel を作りたければ縦横 0.625 倍と指定すればよい。
出力結果

[Perl]Test

Test::Simple
Test::Simple モジュールを使って Perl のテストを書いてみる

use Test::Simple tests => 2; # テスト数の設定 (計画しているテスト数を記述)

ok(1+1==2);                  # テスト No.1 (OK)
ok(1+1==0);                  # テスト No.2 (NG)

実行結果は以下のようになる。

>perl test-simple.pl
1..2
ok 1
not ok 2
#     Failed test (test-simple.pl at line 4)
# Looks like you failed 1 tests of 2.

上記のテスト用 perl ソースで 1 行目の想定テスト数を実際のテスト数と異なる数にしておくと

use Test::Simple tests => 3; # テスト数の設定 (計画しているテスト数を記述)

ok(1+1==2);                  # テスト No.1 (OK)
ok(1+1==0);                  # テスト No.2 (NG)

実行結果

>perl test-simple.pl
1..3
ok 1
not ok 2
#     Failed test (test-simple.pl at line 4)
# Looks like you planned 3 tests but only ran 2.

計画していたテスト数と実施されたテスト数が異なると注意が出る
Test::More
Test::More モジュールを使用すると Test::Simple よりも幅広いテストができる

use Test::More tests => 7; # テスト数の設定

ok(1+1==2);                  # Test No.1 (OK)
ok(1+1==0);                  # Test No.2 (NG)

# 等差チェック (is)
is(1+1, 2);                   # Test No.3 (OK) (等しいか？)

# 正規表現チェック (like)
like("abcde", qr/^a/);       # Test No.4 (OK) (正規表現にマッチしているか？)
like("abcde", qr/^b/);       # Test No.5 (NG)

# 比較 (cmp_ok)
cmp_ok(1+1, '<', 3); # Test No.6 (OK)
cmp_ok(1+1, '=', 2); # Test No.7 (OK)

実行結果は以下のようになる

>perl test-more.pl
1..7
ok 1
not ok 2
#     Failed test (test-more.pl at line 4)
ok 3
ok 4
not ok 5
#     Failed test (test-more.pl at line 11)
#                   'abcde'
#     doesn't match '(?-xism:^b)'
ok 6
ok 7
# Looks like you failed 2 tests of 7.

Test::Base
Test::Base モジュールはテストデータとテスト手段を分けて記述することができる

use Test::Base;

plan tests => 1 * blocks;

filters {
    input    => [qw/chomp/],
    expected => [qw/chomp/],
};

run {
    my $block = shift;
    is(increment($block->input), $block->expected);
};


# テスト対象関数
sub increment {
    my ($arg1) = @_;
    my $ret;

    $ret = $arg1 + 1;

    return $ret;
}

__END__

# 以下がテスト対象と期待される結果を記述するブロック
=== test 1 (OK)
--- input
1
--- expected
2

=== test 2 (NG)
--- input
1
--- expected
0

実行結果は以下のようになる

> perl test-base.pl
1..2
ok 1
not ok 2
#     Failed test (test-base.pl at line 12)
#          got: '2'
#     expected: '0'
# Looks like you failed 1 tests of 2.

[Perl]ImageMagick

インストール

1. ImageMagick の Windows binary ファイルダウンロード へ行き、ImageMagick の DLL 版 (ImageMagick-6.8.5-9-Q16-x86-dll.exe) をダウンロードする
2. インストール時に PerlMagick for ActiveState Perl を選択する
   

画像ファイルの長辺・短辺を判断
フォルダ内の全画像ファイルに対して、画像の縦横長を調べる

use Image::Magick;
use strict;
use utf8;

# ディレクトリ内のファイルを探索
my $dir = "."; # カレントディレクトリ
my @fileList;
my $file;
opendir(DH, $dir) or die "$dir:$!";
while ($file = readdir DH) {
 next if $file =~ /^\.{1,2}$/; # ., .. を除く
 if ($file =~ /\.jpg$/) {
  # 末尾が jpg のファイルのみ選択する
  print "$file\n";
  push(@fileList, $file);
 }
}
print "\n". "@fileList" . "\n";

my $width, my $height;
foreach $file (@fileList) {
 # インスタンス作成
 my $imgMagick = Image::Magick->new;

 # 画像読み込み
 $imgMagick->Read($file);

 # 縦横幅取得
 ($width, $height) = $imgMagick->Get("width", "height");
 print "$file - Width: $width, Height: $height\n";
}

実行結果

> perl image.pl
a.jpg
b.jpg

a.jpg b.jpg
a.jpg - Width: 2592, Height: 3872
b.jpg - Width: 3872, Height: 2592

画像の長辺を固定幅にそろえる
Perl の Image::Magick モジュールを使ってフォルダ内にある全画像の長辺をすべて 1024 に統一する。

use Image::Magick;
use strict;
use utf8;

# ディレクトリ内のファイルを探索
my $dir = "."; # カレントディレクトリ
my @fileList;
my $file;
opendir(DH, $dir) or die "$dir:$!";
while ($file = readdir DH) {
 next if $file =~ /^\.{1,2}$/; # ., .. を除く
 if ($file =~ /\.jpg$/) {
  # 末尾が jpg のファイルのみ選択する
  print "$file\n";
  push(@fileList, $file);
 }
}
print "\n". "@fileList" . "\n";

my $width, my $height;
foreach $file (@fileList) {
 # インスタンス作成
 my $imgMagick = Image::Magick->new;

 # 画像読み込み
 $imgMagick->Read($file);

 # 縦横幅取得
 ($width, $height) = $imgMagick->Get("width", "height");
 print "$file - Width: $width, Height: $height\n";

 if ($width > $height) {
  $imgMagick->Resize(geometry=>"1024x");
 }
 else {
  $imgMagick->Resize(geometry=>"x1024");
 }
 $imgMagick->Write("f" . $file);
}

実行結果

> perl image.pl
a.jpg
b.jpg

a.jpg b.jpg
a.jpg - Width: 2592, Height: 3872
b.jpg - Width: 3872, Height: 2592

実行後、fa.jpg, fb.jpg というファイルが生成され、それぞれ以下のファイルサイズに変換されている

fa.jpg - Width: 685, Height: 1024
fb.jpg - Width: 1024, Height: 685

[Perl]メール

POP3Client
インストール

ppm> install Mail-POP3Client

使い方

use strict;
use utf8;
use Mail::POP3Client;

# pop3
my $server = 'localhost';
my $username = 'user';
my $password = 'pass';

my $pop = new Mail::POP3Client(USER => $username,
                               PASSWORD => $password,
                               HOST => $server,
                               DEBUG => 0);
print "Success to connect $server.\n";

if ($pop->Count() < 1) {
 print "No message\n";
 $pop->Close();
 exit;
}
print $pop->Count() . " messages\n";

my ($head, $body, $subject, $i);
for ($i = 1; $i <= $pop->Count(); $i++) {
 foreach $head ($pop->Head($i)) {
  print $head . "\n";
 }
 foreach $body ($pop->Body($i)) {
  print $body . "\n";
 }

 # 受信メールをサーバから削除
 $pop->Delete($i);
}

# log off
$pop->Close();

MIME::Entity
インストール

ppm> install MIME-Entity

Net::SMTP
使い方

use strict;
use utf8;
use Net::SMTP;
use MIME::Entity;

my ($smtp, $mime, $subject, $body, $from, $to);
$from = 'csrcdev0';
$to = 'csrcdev0';
$subject = "Test mail";
$body = "Hello, This is test mail.";

$smtp = Net::SMTP->new('localhost');
$smtp->mail($from);
$smtp->to($to);

$smtp->data();
$mime = MIME::Entity->build(From     => $from,
                            To       => $to,
                            Subject  => $subject,
                            Type     => 'text/plain; charset="utf-8"',
                            Data     => $body,
                            Encoding => '7bit');
$smtp->datasend($mime->stringify);
$smtp->dataend();

$smtp->quit;

# 事前に作成したメールファイルを送信する
my ($text);
$smtp = Net::SMTP->new('localhost');
$smtp->mail($from);
$smtp->to($to);

open(FILE, "test.mail");
$smtp->data();
foreach $text () {
 $smtp->datasend($text);
# print $text;
}
$smtp->dataend();
$smtp->quit;
close(FILE);

Gmail からメールを受信する
Mail::POP3Client の SSL モードを使用して受信する

use strict;
use Mail::POP3Client;
 
# pop3s
my $server = 'pop.gmail.com';
my $username = 'your account';
my $password = 'your password';
my $port = '995';
 
my $pops = new Mail::POP3Client( USER => $username,
                              PASSWORD => $password,
                              HOST => $server,
                              PORT => $port,
                              USESSL => 'true',
         DEBUG => 0);
print "Success to connect $server.\n";
 
if ($pops->Count() < 1) {
 print "No message\n";
 $pops->Close();
 exit;
}
 
print $pops->Count(), " messages\n";
 
# log off
$pops->Close();

受信したメールを MIME decode して表示する
Encode モジュールでメールヘッダ部は decode('MIME-Header', ...) を使用し、メール本文は decode('iso-2022-jp', ...) を使うことで decode できる。

use utf8;
use Encode;
binmode STDOUT, ":encoding(shift-jis)";
 
my $head, my $body, my $subject;
for (my $i = 1; $i <= $pops->Count(); $i++) {
    foreach $head ($pops->Head($i)) {
 if ($head =~ /^(Subject):\s/) {
     $subject = $head;
     $subject = decode('MIME-Header', $subject);
     print $subject . "\n";
 }
 print "[$i]" . $head . "\n";
    }
    print "----------------------------\n";
 
    foreach $body ($pops->Body($i)) {
 $body = decode('iso-2022-jp', $body);
 print $body . "\n";
    }
    print "============================\n";
}

受信メールをファイルに保存する
Mail::POP3Client のファイル書き出し機能を使用して受信メールをローカルファイルに保存する。

use Mail::POP3Client;

my $filename = $ARGV[0];
for (my $i = 1; $i <= $pops->Count(); $i++) {
    my $fh = IO::File->new();
    $fh->open("$filename", "w");
    $pops->HeadAndBodyToFile($fh, $i);
    $fh->close();
}

メールフォーマットの日時表記を変換する
DateTime::Format::Mail モジュールを使用してメールヘッダの日時フォーマットを好みの形に変換する。

use strict;
use DateTime::Format::Mail;

my $datetime = DateTime::Format::Mail->parse_datetime("Sun, 29 Mar 2009 13:08:44 +0900");
print $datetime->ymd('.') . "\n";
print $datetime->ymd('') . '-' . $datetime->hms('') . "\n";

[Perl]Win32::GUI

インストール
ppm で Win32-GUI をインストールする

ppm> install Win32-GUI

Hello, world
まずは基本の Hello, world から。

use strict;
use utf8;
use Win32::GUI;

my $main = Win32::GUI::Window->new(-name => 'Main',
  -width => 100,
  -height => 100);
$main->AddLabel(-text => "Hello, world");
$main->Show();
Win32::GUI::Dialog();
sub Main_Terminate {
  -1;
}

Button
Window を閉じるボタンを付ける。

use strict;
use utf8;
use Win32::GUI;

my $main = Win32::GUI::Window->new(-name => 'Main',
  -title => "Main Window",
  -width => 200,
  -height => 100);
$main->AddLabel(-text => "Hello, world");
$main->AddButton(-name => "Button1",
  -text => "Close this window",
  -pos => [50, 30]);
$main->Show();
Win32::GUI::Dialog();
sub Main_Terminate {
  -1;
}
sub Button1_Click {
  &Main_Terminate();
}

[Perl]Win32::OLE

Access DB にアクセスする
Win32::OLE (Object Linking and Embedding) を利用することで Access で作成した DB の操作ができるようになる。
下記のソースでは test.mdb という DB の test テーブルにアクセスし、id と name フィールドの値を読み出している。

use strict;
use Win32::OLE;
use utf8;

my $conn = "Provider=Microsoft.Jet.OLEDB.4.0;";
$conn .= "Data Source=test.mdb;";
my $db = Win32::OLE->new("ADODB.Connection") or die "CreateObject: $!";
$db->Open($conn);
my $query = "SELECT * FROM test;";
my $result = $db->Execute($query)
  or die join ' ', map { $db->Errors->Item($_)->Description } (0 .. $db->Errors->Count - 1);
while (!$result->EOF) {
  print $result->Fields('id')->Value . " " . $result->Fields('name')->Value . "\n";
  $result->MoveNext;
}
$result->Close();
$db->Close();

パスワード付きの DB の場合は Open 時に渡す文字列にパスワードを指定する。パスワードが hogehoge の場合は下記のようになる。

my $conn = "Provider=Microsoft.Jet.OLEDB.4.0;";
$conn .= "Data Source=test_pwd.mdb;";
$conn .= "Jet OLEDB:Database Password=hogehoge;";
my $db = Win32::OLE->new("ADODB.Connection") or die "CreateObject: $!";
$db->Open($conn);

[Perl]Net::Amazon

Cache を使う
Cache::File と共に使用することで何度も同じデータを取得するようなことがある場合には処理速度を向上させられる。

my $cache = Cache::File->new(
  cache_root => 'd:/home/cache',
  lock_level => Cache::File::LOCK_LOCAL(),
  default_expire => '24 hours',
);
my $ua = Net::Amazon->new(
  token => '000000000000',
  locale => 'jp',
  cache => $cache,
);

[Perl]フォルダ内のファイル一覧を取得

# フォルダ内のファイル一覧を取得する
use strict;
use utf8;
my $dir = "."; # カレントディレクトリ
my $file;
my @fileList;
opendir(DH, $dir) or die "$dir:$!";
while ($file = readdir DH) {
  print "$file\n";
  push(@fileList, $file);
}
print "\n" . "@fileList" . "\n";

実行結果

> perl dirfiles.pl
.
..
a.txt
b.txt
c.txt
dirfiles.pl
. .. a.txt b.txt c.txt dirfiles.pl

カレントディレクトリ (.), 上位ディレクトリ (..) を除く場合は正規表現の if 文で外す

opendir(DH, $dir) or die "$dir:$!";
while ($file = readdir DH) {
  next if ($file =~ /^\.{1,2}$/);
  print "$file\n";
  push(@fileList, $file);
}

[Perl]WebDAV

HTTP-DAV を ppm でインストール

ppm> install HTTP-DAV

use utf8;
use strict;
use HTTP::DAV;

my ($dav, $url, $user, $password, $filename);
$dav = new HTTP::DAV;
$url = "http://localhost/webdav/";
$user = "username";
$password = "password";
$filename = "hogehoge.txt";
$dav->credentials(-user=>$user, -pass=>$password, -url=>$url);
$dav->open(-url=>$url) or die "Cannot open $url: " . $dav->message . "\n";

# Get file
$dav->get(-local=>"./", -url=>$url.$filename)
  or die "Get failed: " . $dav->message . "\n";

# Put file
$dav->put(-local=>"./" . "test.txt", -url=>$url)
  or die "Put failed: " . $dav->message . "\n";

ディレクトリ内の全ファイルを取得する場合は callback 関数を準備する必要がある。引数も -local ではなく -to を使用する。

# Get all files
$dav->get(-to=>".", -url=>$url."test/", -callback=>\&getCallback)
  or die "Get failed: " . $dav->message . "\n";

########################################################################
# @brief Directory 内のファイル Get に対する Callback
sub getCallback {
  my ($status, $msg, $url, $so_far, $length, $data) = @_;
  # print "status=$status, msg=$msg, url=$url\n";
  # print "so_far=$so_far, length=$length\n";
}

[Perl]Base64 Encode/Decode

use utf8;
use strict;
use MIME::Base64;

# 文字列の encode/decode
my $encoded = encode_base64("Hello, world");
my $decoded = decode_base64($encoded);
print "Encoded: $encoded\n";
print "Decoded: $decoded\n";

# file からの encode/decode
open(INFILE, "test.txt") or die "$!";
open(ENCFILE, "+> test.enc") or die "$!"; # Read/Write で開く
open(DECFILE, "> test.dec") or die "$!";
binmode INFILE;
binmode ENCFILE;
binmode DECFILE;

my ($buf, $encbuf, $decbuf);
while (read(INFILE, $buf, 60*57)) {
  $encbuf = encode_base64($buf);
  print "$buf -> $encbuf\n";
  print(ENCFILE $encbuf);
}

seek(ENCFILE, 0, 0); # ファイルの先頭に戻る
while (read(ENCFILE, $buf, 60*57)) {
  $decbuf = decode_base64($buf);
  print "$buf -> $decbuf\n";
  print(DECFILE $decbuf);
}
close(INFILE);
close(ENCFILE);
close(DECFILE);

実行結果

Encoded: SGVsbG8sIHdvcmxk
Decoded: Hello, world
aaaaabbbbbcccccdddddeeeee
-> YWFhYWFiYmJiYmNjY2NjZGRkZGRlZWVlZQ0K
YWFhYWFiYmJiYmNjY2NjZGRkZGRlZWVlZQ0K
-> aaaaabbbbbcccccdddddeeeee

[Perl]PAR

PAR で Perl スクリプトを実行ファイルにする
Example: テストス クリプト

print "Hello, world\n";
print "hogehoge\n";

pp コマンド (PAR Packager) で exe ファイルを作成する

> pp -o test.exe test.pl

実行結果

> perl test.pl
Hello, world
hogehoge
> test.exe
Hello, world
hogehoge

[Perl]キーボードからの入力を待つ

Term::ReadKey をインストールする

ppm> install Term-ReadKey

Example: サンプル

use strict;
use utf8;
use Term::ReadKey;
ReadMode 'cbreak';
print "Hit any key\n";
ReadKey(0);

[Perl]CPAN インストール

Perl-CPAN をインストール

# yum install perl-CPAN

CPAN 起動

# perl -MCPAN -e shell
cpan> install Test::More

[Perl]モジュール インストール

simple-hatena.el を利用するのに LWP::UserAgent, Crypt::SSLeay が必要なので yum でインストールする。

# yum install perl-LWP-Online
# yum install perl-Crypt-SSLeay

[Perl]日付操作

Date::Simple, Date::Range パッケージを使用して日付の取得・比較を行う。

use strict;
use utf8;
use Date::Simple;
use Date::Range;

# Date::Simple で同じことを実現
#my $today = today();
my $today = Date::Simple::today();
print "Today: " . $today . "\n";

# 指定日の Date::Simple オブジェクトを生成する
my $some_day = Date::Simple::date('2009-01-01');
print $some_day . "\n";

# 1 ヶ月の日数を表示する
print "Days in month: " . Date::Simple::days_in_month($today->year, $today->month) . "\n";

# 当月の初日・末尾を取得
my $first = Date::Simple::date($today->format("%Y-%m-01"));
my $last = Date::Simple::date($today->format("%Y-%m-" . Date::Simple::days_in_month($today->year, $today->month)));
print "First: " . $first . "\n";
print "Last : " . $last . "\n";

# 指定の日が範囲内か確認する
my $range = Date::Range->new($first, $last);
print "Range start: " . $range->start . "\n";
print "Range end : " . $range->end . "\n";
if ($range->includes($some_day)) {
  print $some_day . " is between " . $range->start . " and " . $range->end . ".\n";
}
else {
  print $some_day . " is NOT between " . $range->start . " and " . $range->end . ".\n";
}
if ($range->includes($today)) {
  print $today . " is between " . $range->start . " and " . $range->end . ".\n";
}
else {
  print $today . " is NOT between " . $range->start . " and " . $range->end . ".\n";
}

実行結果

Today: 2009-04-24
2009-01-01
Days in month: 30
First: 2009-04-01
Last : 2009-04-30
Range start: 2009-04-01
Range end : 2009-04-30
2009-01-01 is NOT between 2009-04-01 and 2009-04-30.
2009-04-24 is between 2009-04-01 and 2009-04-30.

[Perl]バイナリファイルの作成

pack 関数を使用してバイナリデータを作成しファイルに書き出す。

use utf8;
use strict;
my $buf, my $num, my $num10;
# バイナリモードであることを明示する
open(OUT, "> test.bin");
binmode OUT;
# 16 進数を 1 byte ずつ書き込む
$buf = pack("cccc", 0x31, 0x32, 0x33, 0x34);
print(OUT $buf);
# 16 進数を 4 byte 書き込む ("N" は Network byte order, Big endian)
$buf = pack("N", 0x35363738);
print(OUT $buf);
# 数値変数を 4 byte 書き込む
$num = 0x393a3b3c;
$buf = pack("N", $num);
print(OUT $buf);
# 文字列 16 進数を 4 byte 書き込む
$num = "41424344";
$num10 = hex($num);
$buf = pack("N", $num10);
print(OUT $buf);
close(OUT);

結果は以下のようなデータとなる。

         +0 +1 +2 +3 +4 +5 +6 +7 +8 +9 +A +B +C +D +E +F
-------+------------------------------------------------
000000 | 31 32 33 34 35 36 37 38 39 3A 3B 3C 41 42 43 44

[Perl]文字列, 10 進数, 16 進数, 2 進数の変換

unpack, sprintf を使用して文字列を ASCII コードに変換したり、10 進数, 16 進数, 2 進数間の変換をすることができる。

use strict;
use utf8;
my $hex, my $dec, my $bin;
# A を 0x41 に変換
$hex = unpack("H2", "A");
print("A -> 0x$hex\n");
# AB を 0x4142 に変換
$hex = unpack("H*", "AB");
print("AB -> 0x$hex\n");
# 10 を 0x0A に変換
$hex = sprintf("%02X", 10);
print("10 -> 0x$hex\n");
# 0x30 を 48 に変換
$dec = sprintf("%d", 0x30);
print("0x30 -> $dec\n");
# 6 を 0110b に変換
$bin = sprintf("%04b", 6);
print("6 -> $bin\n");

出力結果

> perl convert_char_hex_dec_bin.pl
A -> 0x41
AB -> 0x4142
10 -> 0x0A
0x30 -> 48
6 -> 0110

[Perl]ビットシフト

use strict;
use utf8;
my $i, my $j;
# ビットシフト
$i = 0x01;
printf("0x%02x (%08b) -> ", $i, $i);
$j = $i << 2;
printf("0x%02x (%08b)\n", $j, $j);
# ビット演算子
printf("0x%02x (%08b)\n", ($i | $j), ($i | $j));

0x01 を左 2 bit シフトして 0x04 に変えている。結果は %x, %b を使用して 16 進数、2 進数で表示している。
実行結果

> perl bit_shift.pl
0x01 (00000001) -> 0x04 (00000100)
0x05 (00000101)