Hatena::Groupcatalyst

dann@catalyst このページをアンテナに追加 RSSフィード

2008-03-16

starter

14:47 |  starter - dann@catalyst を含むブックマーク はてなブックマーク -  starter - dann@catalyst  starter - dann@catalyst のブックマークコメント

テンプレートを別ファイルに分離したのを作ろうと思って、結局やってない。暇みつけてやろっと。

CLIの作成

14:42 |  CLIの作成 - dann@catalyst を含むブックマーク はてなブックマーク -  CLIの作成 - dann@catalyst  CLIの作成 - dann@catalyst のブックマークコメント

  • App::CLI, App::CmdのようなCLI作成のフレームワークを使う方法
  • App::Options
  • 標準モジュール

CLI用のフレームワークはCatalystアプリ用のCLIとして使うにはいいかなって気がする。もともと、多量のモジュールに依存するのが前提になっているので。App::CLIとApp::Cmdのどっちかがよいのかは分からなかったけれど、一応、App::Cmdでやりたいことは一通りできそう。コマンドの追加もとても楽。

App::Optionsは綺麗に書けるけれど、単体のスクリプトで配布するときには標準モジュールじゃないので都合が悪そう。その点で使いどころがどこになるのかが少し難しい。

標準モジュールは、極力モジュールに依存しないスクリプトを作るときに使う。

App::CLI, App::Cmd または 標準モジュール のいずれかを使うってことになるかなぁ。App::CLIとApp::Cmdがどっちがよいのかはよく分からない。コードはApp::CLIのほうが綺麗だけど、ドキュメントが...

Catalyst用のCLI作成

| 14:11 |  Catalyst用のCLI作成 - dann@catalyst を含むブックマーク はてなブックマーク -  Catalyst用のCLI作成 - dann@catalyst  Catalyst用のCLI作成 - dann@catalyst のブックマークコメント

昨日のエントリのtomyheroさんのCatApp::CLIをベースに、

  • Catalystに依存しないでConfigを読む仕組み
  • CLIのスクリプトのコマンドを拡張する仕組み
  • CLIのコマンドからSchemaを参照する仕組み

を用意してみた。

Catalystに依存しないで使えるので、Catalyst外でも使えるし、App::CmdベースでCLIのコマンドそのもののテストができる。大分、テスタビリティも高いし、いいかなと。

これで、starterで一通りクラスを生成すれば、CLIを拡張していくときには、新規にMyApp::CLI::Commandを拡張していくだけになりました。

  • 簡単にコマンドが追加できること
  • コマンド中からSchemaとconfigを参照できること
  • Catalystに依存せずにCLIを作れること

という用件をひとまずは満たしたので、一応満足。

Schemaを直接参照ではなくて、ここでCというクラスを参照という形にするのがBetterなんだけれど、その仕組みを用意するには、ちと幾つか足りないのでまた今度。

コマンドライン用の管理スクリプト admin.pl

#!/usr/bin/env perl

use MyApp::CLI;
MyApp::CLI->new->run;

使うときは、

script/admin.pl list --open

など。

コマンドラインのコマンドの実装

CLIクラス
package MyApp::CLI;
use base qw(App::Cmd);

1;
コマンドのベースクラス

全てのコマンドでyamlschemaが参照できるようにする。コマンドラインのコマンドのベースクラス。

package MyApp::CLI::Command;
use base qw/App::Cmd::Command/;
use MyApp::ConfigLoader;
use MyApp::Schema;

sub config {
    my $self = shift;
    $self->{config} ||= MyApp::ConfigLoader->new->config;
    return $self->{config};
}

sub schema {
    my $self = shift;
    $app->{schema}  = MyApp::Schema->connect( @{ $self->config->{'Model::DBIC'}{'connect_info'} } );
}

1;
コマンドのクラス

後は、上記のベースクラスを継承して、実装を追加すればコマンドラインオプションが追加できる。

package MyApp::CLI::Command::List;
use base qw/MyApp::CLI::Command/;

=head1 NAME
MyApp::CLI::Command::List - list events
=cut

sub opt_desk {
    return (
        ["open", "only unfinished events"],
    );
}

sub validate_args {
    my ($self, $opt, $args) = @_;
    # we need at least one argument beyond the options
    die $self->usage->text unless @$args;
}

sub run {
    my ($self, $opt, $args) = @_;
    use Data::Dumper;
    warn Dumper $self->schema;
    warn Dumper $self->config;
}

1;

Catalystに依存しないconfigの読み込み

14:11 |  Catalystに依存しないconfigの読み込み - dann@catalyst を含むブックマーク はてなブックマーク -  Catalystに依存しないconfigの読み込み - dann@catalyst  Catalystに依存しないconfigの読み込み - dann@catalyst のブックマークコメント

Catalystに依存せずにyamlなどの設定を読むようにした。

package MyApp::ConfigLoader;

use strict;
use warnings;

use MyApp::Utils;
use Config::Any;
use File::Spec;

sub new {
    my $class = shift;
    my $self = {};
    bless $self , $class;
    $self->{config} = $self->load;
    return $self;
}

# looks ugly. Fix later
sub app_name {
    'MyApp::Catalyst';
}

sub prefix {
    my $self = shift;
    my $prefix = MyApp::Utils::appprefix( $self->app_name );
    return $prefix;
}

sub config {
    my $self = shift;
    return $self->{config};
}

sub load {
    my $self = shift;
    my @files = $self->find_files;
    my $cfg   = Config::Any->load_files(
        {   files       => \@files,
            use_ext     => 1,
        }
    );

    my $config = {};
    my $config_local = {};
    my $local_suffix = $self->get_config_local_suffix;
    for ( @$cfg ) {

        if ( ( keys %$_ )[ 0 ] =~ m{ $local_suffix \. }xms ) {
            $config_local =  $_->{ (keys %{$_})[0] };
        }
        else {
            $config = {
                %{ $_->{ (keys %{$_})[0] }},
                %{$config} ,
            }
        }
    }

    $config = {
        %{$config},
        %{$config_local} ,
    };
    return $config;
}

sub local_file {
    my $self = shift;
    my $prefix = $self->prefix;
    return File::Spec->catfile($self->get_config_dir_path, $prefix . '_' . $self->get_config_local_suffix);
}

sub find_files {
    my $self = shift;
    my ( $path, $extension ) = $self->get_config_path;
    my $suffix     = $self->get_config_local_suffix;
    my @extensions = @{ Config::Any->extensions };

    my @files;
    if ( $extension ) {
        next unless grep { $_ eq $extension } @extensions;
        ( my $local = $path ) =~ s{\.$extension}{_$suffix.$extension};
        push @files, $path, $local;
    }
    else {
        @files = map { ( "$path.$_", "${path}_${suffix}.$_" ) } @extensions;
    }

    return @files;
}

sub get_config_dir_path {
    my $self = shift;
    my $home = MyApp::Utils->home;
    return File::Spec->catfile( $home , 'conf', $self->prefix . ".yml");

}

sub get_config_path {
    my $self = shift;
    my $path = $self->get_config_dir_path;
    my $extension = 'yml';
    return ( $path, $extension );
}

sub get_config_local_suffix {
    my $self = shift;
    my $suffix = MyApp::Utils::env_value( $self->app_name, 'CONFIG_LOCAL_SUFFIX' ) || "local";
    return $suffix;
}

1;

MyApp::Utils

Catalyst::Utilsの必要なところだけ、Catalystに依存しないように抽出。

package MyApp::Utils;

use strict;
use File::Spec;
use Path::Class;
use URI;
use Class::Inspector;
use Carp qw/croak/;

sub appprefix {
    my $class = shift;
    $class =~ s/::/_/g;
    $class = lc($class);
    return $class;
}

sub class2appclass {
    my $class = shift || '';
    my $appname = '';
    if ( $class =~ /^(.+?)::([MVC]|Model|View|Controller)::.+$/ ) {
        $appname = $1;
    }
    return $appname;
}

sub class2classprefix {
    my $class = shift || '';
    my $prefix;
    if ( $class =~ /^(.+?::([MVC]|Model|View|Controller))::.+$/ ) {
        $prefix = $1;
    }
    return $prefix;
}

sub class2classsuffix {
    my $class = shift || '';
    my $prefix = class2appclass($class) || '';
    $class =~ s/$prefix\:://;
    return $class;
}

sub class2env {
    my $class = shift || '';
    $class =~ s/::/_/g;
    return uc($class);
}

sub class2prefix {
    my $class = shift || '';
    my $case  = shift || 0;
    my $prefix;
    if ( $class =~ /^.+?::([MVC]|Model|View|Controller)::(.+)$/ ) {
        $prefix = $case ? $2 : lc $2;
        $prefix =~ s{::}{/}g;
    }
    return $prefix;
}

sub class2tempdir {
    my $class  = shift || '';
    my $create = shift || 0;
    my @parts = split '::', lc $class;

    my $tmpdir = dir( File::Spec->tmpdir, @parts )->cleanup;

    if ( $create && !-e $tmpdir ) {

        eval { $tmpdir->mkpath };

        if ($@) {
            # FIXME
            #MyApp::Exception->throw(
            #    message => qq/Couldn't create tmpdir '$tmpdir', "$@"/ );
        }
    }

    return $tmpdir->stringify;
}

sub home {
    my $class = shift;

    # make an $INC{ $key } style string from the class name
    (my $file = "$class.pm") =~ s{::}{/}g;

    if ( my $inc_entry = $INC{$file} ) {
        {
            # look for an uninstalled Catalyst app

            # find the @INC entry in which $file was found
            (my $path = $inc_entry) =~ s/$file$//;
            my $home = dir($path)->absolute->cleanup;

            # pop off /lib and /blib if they're there
            $home = $home->parent while $home =~ /b?lib$/;

            # only return the dir if it has a Makefile.PL or Build.PL
            if (-f $home->file("Makefile.PL") or -f $home->file("Build.PL")) {

                # clean up relative path:
                # MyApp/script/.. -> MyApp

                my ($lastdir) = $home->dir_list( -1, 1 );
                if ( $lastdir eq '..' ) {
                    $home = dir($home)->parent->parent;
                }

                return $home->stringify;
            }
        }

        {
            # look for an installed Catalyst app

            # trim the .pm off the thing ( Foo/Bar.pm -> Foo/Bar/ )
            ( my $path = $inc_entry) =~ s/\.pm$//;
            my $home = dir($path)->absolute->cleanup;

            # return if if it's a valid directory
            return $home->stringify if -d $home;
        }
    }

    # we found nothing
    return 0;
}

sub prefix {
    my ( $class, $name ) = @_;
    my $prefix = &class2prefix($class);
    $name = "$prefix/$name" if $prefix;
    return $name;
}

sub env_value {
    my ( $class, $key ) = @_;

    $key = uc($key);
    my @prefixes = ( class2env($class), 'CATALYST' );

    for my $prefix (@prefixes) {
        if ( defined( my $value = $ENV{"${prefix}_${key}"} ) ) {
            return $value;
        }
    }

    return;
}

1;

lcipavlcipav 2011/03/24 10:16 4IGWLn <a href="http://glbzfqoqlaox.com/">glbzfqoqlaox</a>, [url=http://ikimzilitduw.com/]ikimzilitduw[/url], [link=http://koddoycduxbb.com/]koddoycduxbb[/link], http://licjkrlymalo.com/

ゲスト



トラックバック - http://catalyst.g.hatena.ne.jp/dann/20080316