PGM->Perl/オブジェクト/UNIVERSALクラス - プログラミングの勉強をしよう@Wiki

Top > PGM->Perl > オブジェクト > UNIVERSALクラス

UNIVERSALクラス

isaメソッド（オブジェクトをチェック）、canメソッド（メソッドをチェック）、VERSION（バージョンをチェック）

'work/Module02.pm'

# パッケージ名定義
package Module02;
 
# コンストラクタ
sub new {
	# オブジェクトを取得
	my $class = shift;
 
	print "Module02:test-constract\n";
 
	# リファレンス
	my $ref = {};
 
	# オブジェクト生成
	my $obj = bless $ref, $class;
 
	# オブジェクト返却
	return $obj;
}
 
# インスタンスメソッド
sub method1{
	my $obj = shift;
 
	print "Module02:test-method1\n";
 
}
 
# インスタンスメソッド
sub method2{
	my $obj = shift;
 
	print "Module02:test-method2\n";
 
}
 
# デストラクタ
sub DESTROY {
	# オブジェクトを取得
	my $obj = shift;
 
	# 処理
	print "Module02:test-descract\n";
 
}
 
# モジュール終端
1;
 
 

'work/Module12.pm'

# パッケージ名定義
package Module12;
 
# 継承元のモジュールを定義
use work::Module02;
 
# 継承するモジュール名を設定
our @ISA = qw(Module02);
 
# バージョン番号
our $VERSION = "1.1";
 
# コンストラクタ
sub new {
	# オブジェクトを取得
	my $class = shift;
 
	print "Module12:test-constract\n";
 
	# リファレンス
	my $ref = {};
 
	# オブジェクト生成
	my $obj = bless $ref, $class;
 
	# オブジェクト返却
	return $obj;
}
 
# インスタンスメソッド
sub method1{
	my $obj = shift;
 
	print "Module12:test-method1\n";
 
}
 
# インスタンスメソッド
sub method2{
	my $obj = shift;
 
	print "Module12:test-method2(override)\n";
 
}
 
# デストラクタ
sub DESTROY {
	# オブジェクトを取得
	my $obj = shift;
 
	# 処理
	print "Module12:test-descract\n";
 
}
 
# モジュール終端
1;
 
 

'sample.pl'

# プラグマ
use strict;
use warnings;
 
# モジュール取り込み
use work::Module12;
 
sub check_isa{
 
 
	my $_name;
	my $_obj;
	my $_rtn;
 
	# 引数を取得
	($_name, $_obj) = @_;
 
	# オブジェクトチェック
	$_rtn = $_obj->isa($_name);
 
	if($_rtn){
		print $_name . "のオブジェクトです。\n";
	}else{
		print $_name . "のオブジェクトではありません。\n";
	}
 
}
 
sub check_can{
 
	my $_name;
	my $_obj;
	my $_rtn;
 
	# 引数を取得
	($_name, $_obj) = @_;
 
	# オブジェクトチェック
	$_rtn = $_obj->can($_name);
 
	if($_rtn){
		print $_name . " は定義されています。\n";
	}else{
		print $_name . " は定義されていません。\n";
	}
 
 
}
 
# メインスクリプト
my $obj = Module12->new();
$obj->method1();            # Module02のmethod1が呼び出される
$obj->method2();            # Module12のmethod2が呼び出される
 
print "\nオブジェクトチェック----\n";
check_isa("Module02", $obj);  # 継承オブジェクトはOK
check_isa("Module12", $obj);  # 参照オブジェクトはOK
check_isa("Module01", $obj);  # 存在しないのでNG
 
print "\nメソッドチェック    ----\n";
check_can("method1", $obj);  # 存在するOK
check_can("method2", $obj);  # 存在するOK
check_can("method3", $obj);  # 存在しないのでNG
 
print "\nバージョンチェック    ----\n";
print Module12->VERSION . "\n";
print Module12->VERSION('1.2') . "\n"; # バージョンが異なるのでメッセージが出力される
 
# 処理開始
BEGIN {
	print "test-script-start\n";
}
 
# 処理終了
END {
	print "test-script-end\n";
}
 
 

実行結果

>perl sample.pl
test-script-start
Module12:test-constract
Module12:test-method1
Module12:test-method2(override)
 
オブジェクトチェック----
Module02のオブジェクトです。
Module12のオブジェクトです。
Module01のオブジェクトではありません。
 
メャbドチェック    ----
method1 は定義されています。
method2 は定義されています。
method3 は定義されていません。
 
バージョンチェック    ----
1.1
Module12 version 1.2 required--this is only version 1.1 at sample.pl line 67.
Module12:test-descract
test-script-end
 
>
 

---