Getopt::Chainでgitライクなsubcommandを処理する

Yokohama.pmでxcezxさんがMonday Moduleのtech talkをされていたので、早速書いてみました。

http://d.hatena.ne.jp/xcezx/

今回紹介するのは、gitのようなsubcommandのoptionを処理してくれるモジュールです。

gitだと、例えば以下のようにcommitサブコマンドにオプションを渡します。このオプションなどをパースしてくれて、簡単に取得できるようにしてくれます。

git.pl init --quiete

git.pl commit -a -m 'Hello'

commands以下にsubcommandの記述を書くと、そのsubcommandのcontextで引数の値などを取得する事ができます。例えば、commitサブコマンドのmオプションの値とかが簡単にとれるようになります。

#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Chain;
use Perl6::Say;

main();

sub main {
    setup_commands();
}

sub setup_commands {
    Getopt::Chain->process(
        options => [qw/ version /],
        run => sub {
            my $context   = shift;
            my @arguments = @_;
            say $context->local_option('version');
        },

        commands => {
            init => {
                options => [qw/ quiet|q template=s shared=s/],
                run     => ¥&init,
            },
            commit => {
                options => [qw/ auto|a message|m=s /],
                run     => ¥&commit,
            },
        }
    );
}

# sub commands
sub init {
    my $context   = shift;
    my @arguments = @_;

    if($context->local_option('quiet')) {
        say 'Only print error and warning messages.';
    }
    say $context->local_option('template');
}

sub commit {
    my $context   = shift;
    my @arguments = @_;
    say $context->local_option('message');
}

__END__