Perlで書かれた「何か」のバージョンを調べるスクリプト

Perlで書かれた何かのバージョンを調べるときに

% perl -MCPAN -e 'print CPAN->VERSION'
1.8801

とかやるのは( ゚Д゚)マンドクセーし、.plな実行ファイルはrequireすると実行されてしまってよろしくないのでちょっと作ってみた。エントリ末尾にあるソースをperl_versionという名前で保存して使います。SYNOPSISはこんな感じ。

% perl_version CPAN ~/root/bin/perl_version
CPAN = 1.880100
/home/yoshida/root/bin/perl_version = v0.22.0

引数にモジュール名かファイル名を複数個渡せます。
表示部分はもうちょっとマシにした方がいいと思います。


ソースです。煮るなり焼くなり好きにしてください。多分バグ入りなので気を付けて。
一応標準モジュールだけ使ってます。バージョン抜き出しの部分はExtUtilsか何かを使った方がいいかも知れません。
パッケージ名→モジュール名の変換に失敗していたのを修正

#!/usr/bin/env perl
#
# $Id$
#
package main;
use strict;
use warnings;
use version; our $VERSION = qv('0.1.0');

use Carp;
use English qw(-no_match_vars);

sub print_version {
    my ( $object, $version ) = @_;
    if ( !defined $version ) {
        $version = 'undef';
    }
    return printf "%s = %s\n", $object, $version;
}

sub package_to_module {
    my $package = shift;
    ( my $module = $package ) =~ s{::}{/}gmsx;
    $module .= '.pm';
    return $module;
}

FILE:
foreach my $path (@ARGV) {
    if ( -f $path ) {
        open my $fh, q{<}, $path or croak $OS_ERROR;
        my $package = q{};
        while (<$fh>) {
            if (/package\s+([^;]+);/msx) {
                $package = "$1::";
            }
            if (/\$(?:$package)?VERSION\s*=(.*)/msx) {
                my $version = eval qq{$_};    ## no critic (ProhibitStringyEval)
                print_version( $path, $version );
                next FILE;
            }
        }
        print_version( $path, undef );
    }
    else {
        eval {
            my $module = package_to_module($path);
            require $module;
            print_version( $path, $path->VERSION );
        };
        if ($EVAL_ERROR) {
            carp $EVAL_ERROR;
            print_version( $path, undef );
        }
    }
}