perlでサブルーチンを動的に定義しようとしてハマりました

perlでモジュールの存在有無により、サブルーチンを動的に定義しようと考えました。具体的には次のような内容です。

#!/usr/bin/perl

BEGIN {
    $hires = "Time::HiRes qw(clock_gettime CLOCK_MONOTONIC)" ;
    unless (eval "use $hires ; 1") {
        print STDERR "WARNING: couldn't use $hires\n" ;
        undef $hires ;
    }
}

if (defined($hires)) {
    sub fine_uptime {
        return scalar clock_gettime(CLOCK_MONOTONIC) ;
    }
} else {
    open(UPTIME, "< /proc/uptime") ;
    sub fine_uptime {
        seek(UPTIME, 0, SEEK_SET) ;
        my $t ;
        ($t, undef) = split(" ", <UPTIME>) ;
        return $t ;
    }
}

print fine_uptime(), "\n" ;

しかし、このスクリプトは意図したようには動作しませんでした。

[root@hoge ~]# uname -a
Linux hoge 3.10.0-327.4.4.el7.x86_64 #1 SMP Tue Jan 5 16:07:00 UTC 2016 x86_64 x86_64 x86_64 GNU/Linux
[root@hoge ~]# rpm -q perl
perl-5.16.3-286.el7.x86_64
[root@hoge ~]# rpm -q perl-Time-HiRes
perl-Time-HiRes-1.9725-3.el7.x86_64
[root@hoge ~]# ./test_clock_gettime.pl 

[root@hoge ~]# 

このように何も出力されません。どうやら、else ブロック内の sub fine_uptime が生きてしまうようで、一方で open() が実行されないため、何も出力されないという結果になるようです。そこで久々に「Perl クックブック VOLUME 1」を読んでみたら、無名サブルーチンを型グロブへ代入すれば意図した動作となることが分かりました。具体的には次のように書き換えました。

#!/usr/bin/perl

BEGIN {
    $hires = "Time::HiRes qw(clock_gettime CLOCK_MONOTONIC)" ;
    unless (eval "use $hires ; 1") {
        print STDERR "WARNING: couldn't use $hires\n" ;
        undef $hires ;
    }
}

if (defined($hires)) {
    *fine_uptime = sub {
        return scalar clock_gettime(CLOCK_MONOTONIC) ;
    } ;
} else {
    open(UPTIME, "< /proc/uptime") ;
    *fine_uptime = sub {
        seek(UPTIME, 0, SEEK_SET) ;
        my $t ;
        ($t, undef) = split(" ", <UPTIME>) ;
        return $t ;
    } ;
}

print fine_uptime(), "\n" ;

[root@hoge ~]# diff -u test_clock_gettime.pl test_clock_gettime2.pl 
--- test_clock_gettime.pl 2016-01-16 17:37:48.436060959 +0900
+++ test_clock_gettime2.pl 2016-01-16 17:41:02.495271960 +0900
@@ -9,17 +9,17 @@
 }
 
 if (defined($hires)) {
-    sub fine_uptime {
+    *fine_uptime = sub {
         return scalar clock_gettime(CLOCK_MONOTONIC) ;
-    }
+    } ;
 } else {
     open(UPTIME, "< /proc/uptime") ;
-    sub fine_uptime {
+    *fine_uptime = sub {
         seek(UPTIME, 0, SEEK_SET) ;
         my $t ;
         ($t, undef) = split(" ", ) ;
         return $t ;
-    }
+    } ;
 }
 
 print fine_uptime(), "\n" ;
[root@hoge ~]# ./test_clock_gettime2.pl 
1780.807779516
[root@hoge ~]# ./test_clock_gettime2.pl ; cat /proc/uptime 
1791.497339723
1791.49 6891.38

つい最近、Bash スクリプトで、条件に応じて if else 文で関数を再定義する処理を書いていたため、perl でも同様に書こうとしてハマってしまったのでした。このような目に遭っても、なんでだか「Perl って、おもしろいな」と感じました。ラクダ本の関連部分（型グロブ）を読んでみよう！

2019-06-21追記
ラクダ本の「4.7 グローバル宣言」に、「サブルーチン宣言とフォーマット宣言は、グローバル宣言である。（中略）ifのように実行時に評価される条件文の中に宣言を置いてコンパイラから隠すことによって、条件に応じてサブルーチンやフォーマットを宣言する、ということはできない。」とありました。いまさらですが、なるほどでした。これにハマったのか。