今日のNewbiethon成果(CatalytApp::CLI)

全然汎用的じゃないけど、Catalystの依存をできるだけ避けて、CLI補助モジュール作った。
config , schemaが使えるだけなんだけど。

Catalyst-Plugin-ConfigLoader-Multi
を使ってる方なら、少しコードを変更すれば使えると思うよ！

今日はコーディングより、考える作業が多かった>_<

package Nirvana::CLI;

use strict;
use warnings;

use base qw/Class::Accessor/;
use Catalyst::Utils;
use Config::Any;
use DirHandle;
use Nirvana::Schema;
use FindBin;
use File::Spec;

__PACKAGE__->mk_accessors(qw/config schema/);

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

sub config_path {
    File::Spec->catfile( $FindBin::Bin , '../conf' );
}
sub app_name {
    'Nirvana::Catalyst';
}

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

    $self->{schema}  = Nirvana::Schema->connect( @{ $self->{config}{'Model::DB'}{'connect_info'} } );
}

sub load_config {
    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_file = $self->local_file;
    for ( @$cfg ) {
        if ( ( keys %$_ )[ 0 ] eq $local_file ) {
            $config_local =  $_->{ (keys %{$_})[0] };
        }
        else {
            $config = {
                 %{ $_->{ (keys %{$_})[0] }},
                %{$config} , 
            }
        }
    }

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

sub local_file {
    my $self = shift;
    my $prefix = Catalyst::Utils::appprefix( $self->app_name );
    return $self->config_path . '/'.  $prefix . '_local.yml';
}
sub find_files {
    my $self = shift;
    my $path = $self->config_path;
    my $extension = 'yml';
    my $prefix = Catalyst::Utils::appprefix( $self->app_name );

    my @files;
    push @files , "$path/$prefix.$extension";
   my $dh = DirHandle->new( $path );

    while ( my $file = $dh->read() ) {
        if ( $file =~ /^$prefix\_(\w+)\.$extension$/  ) {
            push @files , "$path/$file";
        }
    }

    return \@files;
}

1;

使い方

#!/usr/bin/perl 

use strict;
use warnings;
use Storable qw(freeze thaw);
use FindBin::libs;
use Nirvana::CLI;
use Gearman::Client;

my $nirvana = Nirvana::CLI->new();

my $client = Gearman::Client->new;
$client->job_servers( @{ $nirvana->config->{gearman}{job_servers} } );

my $words = $nirvana->schema->resultset('Words')->search({});

while( my $word  = $words->next ) {
    my $args = freeze( { word_id => $word->word_id } );
    $client->dispatch_background( "nirvana_report", \$args, {} );
}