Class::OOorNoでゴネゴネ

Class::OOorNOなるものを発見したので、ちょっとやってみました。

Class::OOorNOはその名の通りオブジェクト指向か否かを吸収してくれるモジュールです。
オブジェクト呼出しでもクラス呼出しでもサブルーチン呼出しでも動くようにしたい！という時に重宝するのでは無かろうかと。(File::statチックなモジュール作る時とか。)

さわりをざっくり

#!/usr/bin/perl
use strict;
package Foo;
use Class::OOorNO qw(OOorNO myargs);
use YAML;
use base qw(Class::Accessor);

sub dump_myargs {
    my (@args) = myargs(@_);
    warn YAML::Dump @args;
}
 
sub show_call_style {
    my $class = __PACKAGE__;
    if (ref OOorNO(@_)) {
        warn $class. "::object method";
    } elsif (OOorNO(@_)) {
        warn $class. "::class method"
    } else {
        warn $class. "::subroutine";
    }
}

package main;

my $args = { foo => 'A', bar => 'B'};

sub obj_style {
    my $foo = Foo->new;
    $foo->show_call_style;
    $foo->dump_myargs($args);
}

sub class_style {
    Foo->show_call_style;
    Foo->dump_myargs($args);
}

sub subroutine_style {
    Foo::show_call_style;
    Foo::dump_myargs($args);
}
 
&obj_style;
&class_style;
&subroutine_style;

結果

Foo::object method at ./foo.pl line 20.
---
bar: B
foo: A
Foo::class method at ./foo.pl line 22.
---
bar: B
foo: A
Foo::subroutine at ./foo.pl line 24.
---
bar: B
foo: A

myargs
何が一番困るってFoo::barとFoo->barで引数の数が変わってくるとこです。
そこで

my (@args) = @_;

の変わりに

my (@args) = myargs(@_);

としてあげると第1引数($selfとか$classとか)の状態から判断し必要な(実際に渡された)引数を返してくれます。

OOorNO
状態を判断するメソッドです。上記のshow_call_styleのようにどう呼ばれたが判別できます。

やってみました。

古いモジュールをOOに！
従来動いてるモジュールがあって従来の機能を生かしつつ、それをOOにしたい。的な感じで。
サンプルはファイルの最終更新時をYYYY-MM-DDで返してくれるだけのモジュールです。
そこにオブジェクトメソッドを足してみました。

#!/usr/bin/perl
 
use strict;
 
package File::MDate;
 
use Class::OOorNO qw(OOorNO myargs);
use DateTime;
 
use base qw(Class::Accessor);
 
sub file_mdate {
    # my ($file) = @_;
    my ($file) = myargs(@_);
    DateTime->from_epoch(epoch => (stat $file)[9])->ymd;
}
 
sub _is_subroutine_style {
    return ref OOorNO(@_) || OOorNO(@_) ? 0 : 1;
}
 
sub obj_method {
    if (_is_subroutine_style(@_)) {
        my $meth = (caller(0))[3];
        die sprintf "%s is object method.", $meth;
    }
    # オブジェクトを使った処理...
}

package main;
 
my $file = './text.txt';
 
# Object method
my $mdate = File::MDate->new;
warn $mdate->file_mdate($file);
 
$mdate->obj_method;
File::MDate::obj_method;
warn File::MDate->file_mdate($file);

結果

2007-02-28 at ./bar.pl line 37.
File::MDate::obj_method is object method. at ./bar.pl line 26.

とりあえず、myargsで何呼び出しでも引数を正しく受けれるようにします。
そして、新たに追加したobject用メソッド(サンプルだとクラス呼出しでもokになってまするが。。)に
サブルーチン呼び出しした場合dieするように仕込んでおきます。