Perl - オブジェクトに関する高度なトピックス(特殊クラスUNIVERSAL、メソッド)

続・初めてのPerl 改訂版
Randal L. Schwartz
brian d foy, Tom Phoenix 著

開発環境

• OS X Lion - Apple(OS)
• BBEdit - Bare Bones Software, Inc., Emacs(Text Editor)
• プログラミング言語: Perl

『続・初めてのPerl 改訂版』(Randal L. Schwartz, brian d foy, Tom Phoenix 著、伊藤 直也、田中 慎司、吉川 英興 監訳、株式会社ロングテール/長尾 高弘 訳、オライリー・ジャパン、2006年、ISBN4-87311-305-9)の14章(オブジェクトに関する高度なトピックス)の14.7(練習問題)2を解いてみる。

その他参考書籍

• プログラミングPerl〈VOLUME1〉
• プログラミングPerl〈VOLUME2〉
• Perlクックブック〈VOLUME1〉
• Perlクックブック〈VOLUME2〉

1.

@ISAの継承の階層でメソッドの検索に失敗したら、次にUNIVERSALという特殊クラスを検索して、それでも見つからなかった場合に最後の手段としてAUTOLOADという名前のメソッドを探すからdebugの呼び出しはAUTOLOADのメカニズムに引っかからない。

コード(BBEdit)

sample.pl

#!/usr/bin/env perl
use strict;
use warnings;
use 5.016;
use utf8;
binmode STDOUT, ':utf8';
binmode STDIN, ':utf8';
binmode STDERR, ':utf8';

sub UNIVERSAL::debug {
    my $self = shift;
    say scalar localtime, ": @_";
}

{
    package MyDate;
    use Carp;
    
    sub new { bless {}, $_[0] }
    sub DESTROY {}
    my %methods = (
        'day' => 3,
        'month' => 4,
        'year' => 5
    );
    sub AUTOLOAD {
        our $AUTOLOAD;
        (my $method = $AUTOLOAD) =~ s/.*:://s;
        
        unless( exists $methods{$method} ) {
            carp $AUTOLOAD;
            return;
        }
        my $i = $methods{$method};
        
        given( $method ){
            when('day' ) { return (localtime)[$i]; }
            when( 'month' ) {return (localtime)[$i] + 1; }
            when( 'year' ) { return (localtime)[$i] + 1900; }
        }
    }
}

my $date = MyDate->new();

$date->wday; # これはcarp
say "day: ", $date->day, " month: ", $date->month, " year: ", $date->year;
$date->debug("MyDate", "debug", 'done');

入出力結果(Terminal)

$ ./sample.pl
MyDate::wday at ./sample.pl line 46.
day: 25 month: 9 year: 2013
Wed Sep 25 14:54:23 2013: MyDate debug done
$