Perl のクラスって個性的ですね！(生で見えるオブジェクト指向)

#Perl のクラスって個性的ですね！(生で見えるオブジェクト指向)

#はじめに
2015年03月08日の初回投稿なので久々の更新です。そして、内容がプアだったので全面改訂です。自分は、Perl の猛者という訳でもないので、誤りなどがあったら指摘していただくとうれしいです。それに、わかりやすさを優先にしているので、正確でないところがあるかもしれません。

#Perl で OOP (Object Oriented Programming) する意味
現在よく使われている Perl 5.x は Ruby などに比べると古い言語なので、元々 OO (Object Oriented) 機能はありませんでした。OO 機能は後付けであり、便利な構文などはありません。そのため、現代的なプログラミング言語として Perl 6 が開発されましたが、Perl 5.x と互換性がないため普及していません。

そもそも Perl 5.x にはキーワードの class がありません。それじゃ、「クラスはどうやって定義するの？」と誰もが思うでしょうね？

Perl 5.x では特別なお約束に従ったパッケージ(モジュール)をクラスと呼んでいます。VBA で .cls 拡張子のモジュールをクラスとしているのに似ていますが、VBA では継承とかはできません。一方、Perl では継承も可能です。

その特別なお約束ですが、OO 機能のない C 言語で OO するような感じです。つまり、C++ で表面的に表れてこない OO の裏方機能を記述して、無理やり OO するみたいな感じでしょうか。

そのため、本来のロジック以外のプログラムの記述量が多くなり、Perl で OO するメリットはない気がします。しかし、規模が大きいプログラムでは OO しないより、見通しがよくなるというメリットもあります。

まあ、お気楽に OOP するなら、Python や Ruby を最初から使ったほうがいいと思いますが。

一方、OO 機能を生でいじれるので、ガチなプログラマの人にとっては楽しいかもしれませんね。

#まずはモジュールから
モジュールは関数などを集めたファイルで、拡張子は .pm です。モジュールは require や use で読み込んで内部の関数や定数を使用できます。

モジュールの置き場所ですが、プログラムと同じ場所の他、@INC という配列にその場所が含まれている必要があります。具体的には環境変数 PERL5LIB にその場所を追加する、BEGIN 構文で @INC にその場所を追加するとか、いくつか方法があるようです。

BEGIN { push @INC, '/path/to/my/lib' }

require でモジュールを使用する場合は、モジュールのファイル名をずばり指定できます。これは、C 言語の #include に近いですね。一方、use でモジュールを参照する場合は、モジュール名でなく内部のパッケージ名を使います。use は require + αの機能を持っています。このα部分はエクスポートに関連する機能だそうですが、ここではα部分は扱わないので、基本 require を使用します。

モジュールの内部では package でパッケージ名を定義します。このパッケージ名は名前空間みたいなものなので、複数定義することもできます。しかし、ここでは複雑なモジュール(クラス)を扱うつもりはないので、1つのモジュールには1つのパッケージということにします。

モジュールの最後には "1;" (True を意味する) が必要です。これは require (あるいは use) で使用するそうです。

##モジュールのサンプル（１）
次のモジュールはファイル名 Text.pm、パッケージ名 Text で文字列処理関数を集めたものです。

use strict; から use utf8; まではおまじないみたいなもので、なくても動作しますが、use utf8 以外はデバッグに役立つので入れておいたほうが良いです。use utf8 はこのプログラムが UTF8 で書かれていることをコンパイラに教えるものです。perldoc にはそのほかいろいろ書いてありますが、ここでは気にしないことにします。

次の2行は定数を定義しています。Perl では BOOL 値が特に定義されていなくて不便なので追加しています。

use constant False => 0;
use constant True => 1;

その後には、関数がいくつか定義してありますが、これらの関数は名前空間 Text の中にあるので、外部からアクセスする場合は、Text::isdigit(a) などとします。

Text.pm

package Text;
#  文字列処理関数パッケージ
use strict;
use warnings;
use utf8;
use constant False => 0;
use constant True => 1;


# ASCII 文字が数字かどうか判別する。 bool isdigit(c)
sub isdigit {
  my $c = shift;
  return False if ($c eq '');
  my $a = ord($c);
  if (($a >= 0x30) && ($a <= 0x39)) {
    return True;
  }
  else {
    return False;
  }
}

# ASCII 文字が英字かどうか判別する。 bool isalpha(c)
sub isalpha {
  my $c = shift;
  return False if ($c eq '');
  my $a = ord($c);
  if (($a >= 0x41 && $a <= 0x5a) || ($a >= 0x61 && $a <= 0x7a)) {
    return True;
  }
  else {
    return False;
  }
}

# ASCII 文字が区切りかどうか判別する。 bool isdelim(c)
sub isdelim {
  my $c = shift;
  return False if (isdigit($c) || isalpha($c));
  my $a = ord($c);
  if (($a >= 0x20) && ($a <= 0x7e)) {
    return True;
  }
  else {
    return False;
  }
}

# ASCII 文字が表示可能かどうか判別する。bool isprint(c)
sub isprint {
  my $c = shift;
  my $a = ord($c);
  if (($a >= 0x20) && ($a <= 0x7e)) {
    return True;
  }
  else {
    return False;
  }
}

# 文字列に含まれる英大文字をすべて小文字に変換する。
sub tolower {
  my $s = shift;
  return lc($s);
}


# 文字列に含まれる英小文字をすべて大文字に変換する。
sub toupper {
  my $s = shift;
  return uc($s);
}


# 文字列の長さ int len(str)
sub len {
  my $str = shift;
  return length($str);
}

# 文字列に別の文字列を連結する。string append(str, other)
sub append {
  my $str = shift;
  my $other = shift;
  my $rs = $str . $other;
  return $rs;
}

# 部分文字列 string substring(str, start, length)
sub substring {
  my $str = shift;
  my $start = shift;
  my $length = shift;
  return substr($str, $start, $length);
}

# str の先頭から長さ length の部分文字列を返す。
sub left {
  my $str = shift;
  my $length = shift;
  return substr($str, 0, $length);
}

# str の最後から長さ length の部分文字列を返す。
sub right {
  my $str = shift;
  my $length = -shift;
  return substr($str, $length);
}

# 同じ文字からなる長さ n の文字列を得る。string times(c, n)
sub times {
  my $c = shift;
  my $n = shift;
  my $buff = "";
  for (my $i = 0; $i < $n; $i++) {
    $buff .= $c;
  }
  return $buff;
}


# おまじないとして最後に 1 を返す。
1;

このサンプルは十分テストしたわけではないのでバグがある可能性があります。ご了承ください。

この Text モジュールの使用例を示します。Text.pm とテストプログラムは同じ場所にあるものとします。

text1.pl

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
require "./Text.pm";


if ($#ARGV == -1) {
  print("isdigit(c)\n");
  print Text::isdigit('0');
  print Text::isdigit('');
  print Text::isdigit('x');
  print Text::isdigit('('), "\n";
  exit 0;
}
else {
  if ($ARGV[0] eq 'a') {
    print Text::isalpha('A');
    print Text::isalpha('z');
    print Text::isalpha('0');
    print Text::isalpha('*'), "\n";
  }
  elsif ($ARGV[0] eq 'd') {
    print Text::isdelim('A');
    print Text::isdelim('z');
    print Text::isdelim('0');
    print Text::isdelim('*'), "\n";
  }
  elsif ($ARGV[0] eq 'p') {
    print Text::isdelim('A');
    print Text::isdelim('\x01');
    print Text::isdelim('\xff');
    print Text::isdelim('*'), "\n";
  }
  else {
    print("'', 'a', 'd', 'p' must be specified.\n");
  }
}

##モジュールのサンプル（２）
このサンプルは1つのモジュール (ModuleAB.pm) に2つのパッケージ (PackageA, PackageB) を定義しています。

ModuleAB.pm

package PackageA;
# パッケージA

sub name {
  return "A";
}

package PackageB;
# パッケージB

sub name {
  return "B";
}

1;

下のコードは ModuleAB.pm の異なるパッケージの同じ名前の関数を呼び出す例です。

testModuleAB.pl

#!/usr/bin/perl
require "./ModuleAB.pm";

print PackageA::name(), "\n";
print PackageB::name(), "\n";

#Perl のクラス
ここからが本題となります。Perl のクラスは特別なパッケージです。特別な部分はオブジェクトをパッケージに関連付けるという部分です。ここでオブジェクトとは具体的には連想配列の参照で、これはコンストラクタ(の役割をするただの関数)で構築します。このコンストラクタ関数は関数値としてこのオブジェクトを返します。

具体的なコードを詳しく見ていきます。

BasicClass.pm

package BasicClass;
# クラスのテンプレート
use strict;
use warnings;

# クラス変数
our $version = "1.0.0";

# コンストラクタ  new(x=0.0)
sub new {
  # パッケージ名をクラス名として記憶しておく。
  my $class = shift;
  # このクラスのインスタンスに相当するオブジェクト(連想配列の参照)
  my $self = {};
  # 引数の処理
  if ($#_ < 0) {
    # 引数を省略したとき
    $self->{x} = 0.0;
  }
  else {
    # 引数を省略しないとき
    $self->{x} = shift;
  }
  # このパッケージにオブジェクト $self を連携させる。
  bless $self, $class;
  # このオブジェクトを返す。
  return $self;
}

# 2乗を返すメソッド float square(x)
sub squre {
  my $self = shift;
  return $self->{x} * $self->{x};
}

# プロパティ x (get x)
sub get_x {
  my $self = shift;
  return $self->{x};
}


# プロパティ x (set y = value)
sub set_x {
  my $self = shift;
  $self->{x} = shift;
}


# おまじないとして必要。(require で使用)
1;

コードの先頭にはパッケージ名を定義します。これはクラス名として使用されます。

次の2行は一種のおまじない(なくてもよい)ですが、バグの発生しやすくなるのを防いでくれます。

use strict;
use warnings;

次のコードはクラス変数の例です。クラス変数と言っても単なるグローバル変数です。

our $version = "1.0.0";

次にコンストラクタですが、new という名前にしています。この「名前にしてる」という意味は "new" 以外でも問題ないということです。Perl ではコンストラクタと言っても単なる関数です。

(注意) 関数名は "new" 以外でも可能ですが、可読性の面から習慣として new を使うのがよいです。

コンストラクタで最初にやることは、最初のパラメータを受け取ることです。この値はパッケージ名のはずです。これを $class というローカル変数に代入しておきます。これは、後で bless 関数で使用します。

パッケージ名をクラス名として記憶しておく。
my $class = shift;

次にこのクラスのインスタンスに相当するオブジェクト (連想配列の参照) を定義します。

このクラスのインスタンスに相当するオブジェクト(連想配列の参照)
my $self = {};

このコンストラクタはパラメータ x を1つだけ取りますが、省略しても構いません。(パラメータのデフォルト値を持つ)
省略されたときは、値 0.0 を取ります。これは、パラメータの数を判別することで判断します。

new.pl

  # 引数の処理
  if ($#_ < 0) {
    # 引数を省略したとき
    $self->{x} = 0.0;
  }
  else {
    # 引数を省略しないとき
    $self->{x} = shift;
  }

この後、bless 関数でこのパッケージにオブジェクト $self を連携させます。$self は new 関数のローカル変数なので、関数が終了すると、消えてしまいます。それでは困るので、bless でクラス名(パッケージ名)に連携したヒープ上にコピーして値が残るようにします。

このパッケージにオブジェクト $self を連携させる。
bless $self, $class;

最後にこのクラスのインスタンスに相当するオブジェクト $self を関数値として返します。(Python のような言語では黙っていてもこの処理をやってくれますが、Perl では忘れないようにします)

このオブジェクトを返す。
return $self;

クラスもモジュールの一種なので最後に "1;" を書いておくのを忘れないようにします。

次にクラスの利用側のコードを示します。

basicClass.pl

#!/usr/bin/perl
# BasicClass のテスト
use strict;
use warnings;
require "./BasicClass.pm";

# クラス変数 version を表示する。
print $BasicClass::version . "\n";

# BasicClass クラスをインスタンス化
my $obj = BasicClass->new;

# プロパティ x
printf("%f\n", $obj->get_x());
$obj->set_x(5.0);
printf("%f\n", $obj->get_x());

# メソッド square
printf("%f\n", $obj->squre());

print "Done.\n";

次のコードはおまじないでなくても構いませんが、バグになりやすいコードでエラーになったり、警告を出してくれます。

use strict;
use warnings;

クラス BasicClass の入ったモジュールを読み込みます。このテストプログラムとモジュールは同じ場所にあるものとします。

require "./BasicClass.pm";

クラス変数 version にちゃんとアクセスできるか確認します。

クラス変数 version を表示する。
print $BasicClass::version . "\n";

BasicClass クラスをインスタンス化して $obj に代入しています。BasicClass->new は new BasicClass と書いても大丈夫です。

BasicClass クラスをインスタンス化
my $obj = BasicClass->new;

プロパティ x のデフォルト値を表示した後、値を変更して、ちゃんと変更されたかを確認しています。

# プロパティ x
printf("%f\n", $obj->get_x());
$obj->set_x(5.0);
printf("%f\n", $obj->get_x());

メソッド square を使って、$self->{x} の2乗を表示します。

メソッド square
printf("%f\n", $obj->squre());

クラスの継承
Perl のクラスでもクラスの継承をサポートしています。

例として2次元ベクトルクラス (Vector) を定義します。

Vector.pm

package Vector;
# 2次元ベクトル
use strict;
use warnings;

# コンストラクタ new(x=0.0, y=0.0)
sub new {
  my $class = shift;
  my $self = {};
  if ($#_ >= 1) {
    $self->{x} = shift;
    $self->{y} = shift;
  }
  else {
    $self->{x} = 0.0;
    $self->{y} = 0.0;
  }
  bless $self, $class;
  return $self;
}

# ベクトルの値を得る。 \array get()
sub get {
  my $self = shift;
  my $v = [$self->{x}, $self->{y}];
  return $v;
}


# ベクトルの値を変更する。 void set(\array)
sub set {
  my $self = shift;
  my $v = shift;
  $self->{x} = $v->[0];
  $self->{y} = $v->[1];
}

# ベクトルオブジェクトを加える。 void add(\array)
sub add {
  my $self = shift;
  my $v = shift;
  $self->{x} += $v->{x};
  $self->{y} += $v->{y};
}

# ベクトルオブジェクトを引く。 void sub(\array)
sub sub {
  my $self = shift;
  my $v = shift;
  $self->{x} -= $v->{x};
  $self->{y} -= $v->{y};
}

# スカラーを掛ける。 void scalar_mul(a)
sub scalar_mul {
  my $self = shift;
  my $a = shift;
  $self->{x} *= $a;
  $self->{y} *= $a;
}

# オブジェクトの文字列表現を返す。 str toString()
sub toString {
  my $self = shift;
  return "(" . $self->{x} . ", " . $self->{y} . ")";
}


# おまじないとして true を返す。
1;

さらに Vector クラスを継承したクラス Vector2 を定義します。

ここでキモとなる部分が2か所あります。まず、次のコードですが、@ISA という配列に入っているパッケージ(この場合は Vector)も Vector2 も並列して名前空間として使うみたいな意味です。qw 演算子の代わりに配列定義で (Vector) と書いても大丈夫です。

require "./Vector.pm";
our @ISA = qw(Vector);

もう一か所は、自オブジェクトに基底クラス Vector のオブジェクトを設定する部分です。これにより、親オブジェクトのプロパティが自オブジェクトで参照できるようになります。

$self = Vector->new($x, $y); あるいは $self = Vector->new;

Vector2.pm

package Vector2;
# ベクトル v2
use strict;
use warnings;
use utf8;
require "./Vector.pm";
our @ISA = qw/Vector/;


# コンストラクタ new(x = 0, y = 0)
sub new {
  # クラス名を取得
  my $class = shift;
  # 自オブジェクト
  my $self;
  # パラメータがあるか判別
  if ($#_ >= 1) {
    # パラメータがある場合
    my $x = shift;
    my $y = shift;
    # ここで Vector のインスタンスを自分のオブジェクトとして代入
    $self = Vector->new($x, $y);
  }
  else {
    # ここで Vector のインスタンスを自分のオブジェクトとして代入(パラメータが x=0, y=0)
    $self = Vector->new;
  }
  # 追加のプロパティ version
  $self->{version} = "2.0";
  # オブジェクトをパッケージに関連付ける。
  bless $self, $class;
  # オブジェクトを関数値として返す。
  return $self;
}



# プロパティ version
sub version {
  my $self = shift;
  return $self->{version};
}

# 内積を計算して返す。scalar inner_product(\array)
sub inner_product {
  my $self = shift;
  my $v = shift;
  return $self->{x} * $v->{y} + $self->{y} * $v->{x};
}

# ベクトルの長さを返す。scalar norm()
sub norm {
  my $self = shift;
  return sqrt($self->{x} * $self->{x} + $self->{y} * $self->{y});
}

# おまじないとして必要。
1;

次のコードは Vector2 クラスのテストプログラムです。Vector2 にインスタンスから Vector のメソッドが正しく呼び出せるか確認しています。

testVector2.pl

#!/usr/bin/perl
# Vector2 のテスト
use strict;
use warnings;
use utf8;
require "./Vector2.pm";

my $v1 = new Vector2;
print $v1->version, "\n";  # Vector2 で追加したプロパティ
print $v1->toString(), "\n";  # Vector のメソッド

$v1->set([2, 1]);  # Vector のメソッド
print $v1->toString(), "\n";  # Vector のメソッド
print $v1->norm(), "\n";  # Vector2 で追加したメソッド
my $v2 = new Vector2(2, 3);
print $v2->toString(), "\n";  # Vector のメソッド

print $v2->inner_product($v1), "\n";  # Vector2 で追加したメソッド

#サンプル
(注意) 以下のサンプルは、実用性のあるクラスとして作りました。しかし、テストケースは限られたものしか行っていないので、十分実用に足りるかは不明です。

Regexp (正規表現クラス)

Perl の正規表現は強力ですが、独特な記述方法が他の言語に慣れた人には違和感があります。このクラスは、他の言語に慣れた人でも使いやすいようにしたものです。半面、Perl の強力な正規表現機能の一部しか利用できません。

Regexp.pm

package Regexp;
# 正規表現クラス
use strict;
use warnings;
use utf8;


# コンストラクタ  new(regex)
sub new {
  my $class = shift;
  my $sr = shift;  # regex
  my $self = {};
  $self->{re} = $sr;
  
  bless $self, $class;
}

# 指定した部分文字列が含まれているかどうかを返す。 bool ismatch(str)
sub ismatch {
  my $self = shift;
  my $str = shift;
  return $str =~ m"$self->{re}";
}


# 部分文字列を検索して見つかったものを返す。str matches(str)
sub matches {
  my $self = shift;
  my $str = shift;
  my $n = shift;
  $str =~ m"$self->{re}";
  if ($n == 0) {
    return $1;
  }
  elsif ($n == 1) {
    return $2;
  }
  elsif ($n == 2) {
    return $3;
  }
  elsif ($n == 3) {
    return $4;
  }
  else {
    return $5;
  }
}

# 部分文字列を置き換える。str replace(str, pattern, new)
sub replace {
  my $self = shift;
  my $str = shift;  # str
  my $rep = shift;  # replaced
  my $pat = qr/$self->{re}/;  # pattern
  $str =~ s/$pat/$rep/g;
  return $str;
}


# 部分文字列で元の文字列を分割した配列を返す。array split(str)
sub split {
  my $self = shift;
  my $str = shift;
  return split(qr/$self->{re}/, $str);
}



#  おまじないとして必要。(require の約束事)
1

Regexp クラスの使用例を示します。

###Regexp クラスの使用例 (1)

testRegexp.pl

#!/usr/bin/perl
use strict;
use warnings;
require "./Regexp.pm";
use constant True=>1;
use constant False=>0;

sub to_bool {
  my $v = shift;
  if (($v eq '') || ($v == 0) || !defined($v)) {
    return False;
  }
  else {
    return True;
  }
}

my $str = "20:10:00";

# インスタンス化
my $r1 = new Regexp('(\d\d):(\d\d):(\d\d)');


# ismatch  (マッチする)
my $d1 = $r1->ismatch($str);
print to_bool($d1), "\n";

# matches  (マッチしたものを取り出す)
my $s = $r1->matches($str, 0);
if (defined($s)) {
  print "$s\n";
}
else {
  print "Error (Not Match)\n";
}

# ismatch  (マッチしない)
my $r2 = Regexp->new('(\d\d):(\d\d):(\d\d)');
my $d2 = $r2->ismatch("2019-01-01");
print to_bool($d2), "\n";

###Regexp クラスの使用例 (2)

testRegexp2.pl

#!/usr/bin/perl
#  Refexp.pm のテスト
use strict;
use warnings;
require "./Regexp.pm";
use constant True=>1;
use constant False=>0;


my $str = "80,Title,Creator,/home/user/path";

my $r1 = new Regexp(',');
my $s1 = $r1->replace($str, ' ');
print "$s1\n";

my $r2 = Regexp->new(',');
my @arr = $r2->split($str);
for (@arr) {
  print "$_\n";
}

Parameters (コマンドライン引数クラス)

次のクラスは、コマンドライン引数を解析して、params プロパティに連想配列として格納します。コマンドオプションは -w 形式のみで --long は使えません。コマンドオプションは、オプション名がキーになる連想配列として格納します。その他のパラメータはキーが 0 から始まる番号の連想配列として格納します。

Parameters.pm

package Parameters;
# パラメータクラス
use strict;
use warnings;
use utf8;


# コンストラクタ  new()
sub new {
  my $class = shift;
  my $self = {};
  bless $self, $class;
  $self->parse();
  return $self;
}

# @ARGV を分析して params に格納する。
sub parse {
  my $key;
  my $idx = 0;
  my $kix = 0;
  my $self = shift;
  for (@ARGV) {
    if (/^\-[a-z,A-Z]/) {
      $key = substr($_, 1);
      $self->{keys}->[$kix] = $key;
      $kix += 1;
    }
    elsif (defined($key)) {
      $self->{params}->{$key} = $_;
      $key = undef;
    }
    else {
      $self->{params}->{$idx} = $_;
      $idx += 1;
    }
  }
  $self->{nkeys} = $kix;
  $self->{nidx} = $idx;
}

# 指定したキーのオプション値または指定したインデックスの文字列を得る。ない場合は undef を返す。
sub get {
  my $self = shift;
  my $key = shift;
  my $val = undef;
  if (exists($self->{params}->{$key})) {
    $val = $self->{params}->{$key};
  }
  return $val;
}

# オプションのキー数
sub numkey {
  my $self = shift;
  return $self->{nkeys};
}

# パラメータ(非オプション)の数
sub numparam {
  my $self = shift;
  return $self->{nidx};
}

# オプションのキーを得る。
sub getkey {
  my $self = shift;
  my $n = shift;
  return $self->{keys}->[$n];
}



# おまじないとして必要。(require の約束事)
1;

###使用例 (1)
コマンドオプションが -a, -b, -c、その他が２つあるコマンドライン引数を解析する例です。

testParam.pl

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
require "./Parameters.pm";

my $po = Parameters->new;
print 'a'."=>".$po->get('a')."\n";
print 'b'."=>".$po->get('b')."\n";
print 'c'."=>".$po->get('c')."\n";
print '0'."=>".$po->get(0)."\n";
print '1'."=>".$po->get(1)."\n";
print "Done.\n";

###使用例 (2)
オプションのキーの数とキーの値およびその他のパラメータの数を表示します。

testParam2.pl

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
require "./Parameters.pm";

my $po = Parameters->new;

# オプションキーの数
my $n = $po->numkey();
printf("Options keys : %d\n", $n);

# パラメータの数
printf("Number of parameters : %d\n", $po->numparam());

# オプションキーの値
for (my $i = 0; $i < $n; $i++) {
  printf("Key %d : %s\n", $i, $po->getkey($i));
}

print "Done.\n";

##DateTime (日付時間クラス)
このクラスは Perl 標準の Time::Piece を継承したクラスで、わかりやすい名前のメソッドを追加しています。

DateTime.pm

package DateTime;
#  日付時間パッケージ (クラス)
use strict;
use warnings;
use utf8;
use Time::Piece ':override';
our @ISA = qw(Time::Piece);
use Time::Local;
use Time::Seconds;
use constant False => 0;
use constant True => 1;

our $timezone = "JST";

# コンストラクタ new(pt)
sub new {
  my $class = shift;
  my $self;
  if ($#_ >= 0) {
    my $pt = shift;
    if (lc($pt) eq 'utc' || lc($pt) eq 'gmt') { 
      $self = gmtime;
    }
    else {
      $self = Time::Piece->strptime($pt, "%Y-%m-%d %H:%M:%S");
    }
  }
  else {
    $self = localtime;
  }
  bless $self, $class;
  return $self;
}


# このインスタンスを日付時刻文字列に変換する。(ISO 8601 標準)
sub toString {
  my $self = shift;
  my $result = $self->ymd . " " . $self->hms;
  return $result;
}

# このインスタンスの日付部分を日付文字列に変換する。(ISO 8601 標準)
sub toDateString {
  my $self = shift;
  my $result = $self->ymd;
  return $result;
}

# このインスタンスの時刻部分を時刻文字列に変換する。(ISO 8601 標準)
sub toTimeString {
  my $self = shift;
  my $result = $self->hms;
  return $result;
}

# このインスタンスのタイムスタンプ (実数)
sub timestamp {
  my $self = shift;
  return timelocal($self->sec, $self->min, $self->hour, $self->mday, $self->mon - 1, $self->year);
}




# おまじないとして 1 を返す。(require の約束事)
1;

##追加したメソッドの確認

testDateTime.pl

#!/usr/bin/perl
#  DateTime クラスのテスト
require "./DateTime.pm";

my $dt = DateTime->new;
print $dt->{"timezone"}, "\n";
print $dt->toString(), "\n";
print $dt->toDateString(), "\n";
print $dt->toTimeString(), "\n";

継承元の Time::Piece の機能が使えるかの確認
#!/usr/bin/perl
#  DateTime クラスのテスト
require "./DateTime.pm";

# オブジェクト作成
my $dt1 = DateTime->new('GMT');
print $dt1->toString(), "\n";
my $dt2 = DateTime->new('2010-09-10 13:22:00');
print $dt2->toString(), "\n";

# 日付要素
printf("%04d年%02d月%02d日\n", $dt2->year, $dt2->mon, $dt2->mday);

# 計算
my $dt3 = $dt2 + 60*60*1 + 60*1 + 1;
printf("%02d時%02d分%02d秒\n", $dt2->hour, $dt2->min, $dt2->sec);
printf("%02d時%02d分%02d秒\n", $dt3->hour, $dt3->min, $dt3->sec);

# タイムスタンプ
printf("%d\n", $dt1->timestamp());

# クラス変数
print $DateTime::timezone, "\n";

# 終わり
print "Done.\n";

-end-