File Coverage

blib/lib/Archer.pm
Criterion Covered Total %
statement 91 120 75.8
branch 24 42 57.1
condition 15 23 65.2
subroutine 16 17 94.1
pod 0 8 0.0
total 146 210 69.5


line stmt bran cond sub pod time code
1             package Archer;
2 6     6   202081 use strict;
  6         18  
  6         551  
3 6     6   33 use warnings;
  6         10  
  6         241  
4 6     6   244 use 5.008001;
  6         28  
  6         261  
5 6     6   34 use Carp;
  6         10  
  6         708  
6 6     6   8456 use List::MoreUtils qw/uniq/;
  6         11608  
  6         1268  
7 6     6   3640 use Archer::ConfigLoader;
  6         22  
  6         341  
8 6     6   6546 use UNIVERSAL::require;
  6         11951  
  6         67  
9              
10             our $VERSION = '0.18';
11              
12             my $context;
13 17     17 0 169 sub context { $context }
14              
15             sub set_context {
16 7     7 0 17 my ( $class, $c ) = @_;
17 7         16 $context = $c;
18             }
19              
20             sub new {
21 7     7 0 62453 my ( $class, $opts ) = @_;
22 7         51 my $self = bless { %$opts }, $class;
23              
24 7 50       44 if ( !$$opts{ write_config } ) {
25 7         64 my $config_loader = Archer::ConfigLoader->new;
26 7         41 $self->{ config } = $config_loader->load( $opts->{ config_yaml }, $self );
27             }
28              
29 7 100       50 if ( $self->{ log_level } ) {
30 1         7 $self->{ config }->{ global }->{ log } = { level => $self->{ log_level } };
31             } else {
32 6   50     76 $self->{ config }->{ global }->{ log } ||= { level => 'debug' };
33             }
34              
35 7         63 Archer->set_context( $self );
36              
37 7         92 return $self;
38             }
39              
40             sub run {
41 6     6 0 17 my ( $self, ) = @_;
42              
43 6 50       37 if ( $self->{ shell } ) {
    50          
44              
45 0         0 require Archer::Shell;
46              
47 0         0 my $server_tree = $self->{config}->{projects}->{$self->{project}};
48 0         0 my @servers;
49 0         0 while ( my ( $role, $servers ) = each %$server_tree ) {
50 0 0 0     0 next if $self->{role} && $self->{role} ne $role;
51 0         0 for my $server ( @$servers ) {
52 0         0 push @servers, $server;
53             }
54             }
55 0         0 @servers = uniq @servers;
56              
57             my $shell = Archer::Shell->new(
58             { context => $self,
59             config => $self->{ config },
60 0         0 servers => \@servers,
61             }
62             );
63              
64 0         0 $shell->run_loop;
65             }
66             elsif ( $self->{ write_config } ) {
67             # XXX: There is no Archer::Util!!!
68 0         0 local $@;
69 0         0 my $archer_util = 'Archer::Util';
70 0         0 eval "require $archer_util;"; ## no critic
71 0 0       0 croak 'WTF! There is no Archer::Util! And that, Archer dist not contains it!' if $@;
72              
73 0         0 my $util = $archer_util->new;
74 0         0 $util->templatize( $self );
75             }
76             else {
77 6         53 $self->run_hook( 'init' );
78 5         38 $self->run_hook( 'ready' );
79              
80 5         32 $self->run_process;
81              
82 5         2421 $self->run_hook( 'finalize' );
83             }
84             }
85              
86             sub run_hook {
87 25     25 0 51 my ( $self, $hook, $args ) = @_;
88 25   100     95 $args ||= {};
89              
90 25         90 $self->log( 'info' => "run hook $hook" );
91             TASK:
92 25         412 for my $plugin ( @{ $self->{ config }->{ tasks }->{ $hook } } ) {
  25         124  
93 24 50       248 if ( $self->{ skips }->{ $plugin->{ name } } ) {
94 0         0 $self->log( info => "skipped: $plugin->{name}" );
95 0         0 next;
96             }
97              
98 24 100 100     201 if ( $hook =~ /^(?:process|ready)$/ && $self->{ only } ) {
99 3 100       11 if ( $self->{only} ne $plugin->{ name } ) {
100 2         8 $self->log( debug => "skipped: $plugin->{name}" );
101 2         30 next;
102             }
103             } else {
104 21 50 33     82 if ( $plugin->{skip_default} && ! $self->{ withs }->{ $plugin->{ name } } ) {
105 0         0 next;
106             }
107             }
108              
109 22         47 for my $filter ( qw/ role project / ) {
110 44 50       138 if ( my $data = $plugin->{ $filter } ) {
111 0 0       0 my @datas = ref $data eq 'ARRAY' ? @$data : ($data);
112 0 0       0 unless ( grep {$_ eq $args->{ $filter }} @datas ) {
  0         0  
113 0         0 $self->log( info =>
114 0         0 qq(skip $args->{server}. because "@{[join ' ', @datas]}" doesn't match $args->{$filter})
115             );
116 0         0 next TASK;
117             }
118             }
119             }
120              
121 22 100       191 my $class = ($plugin->{module} =~ /^\+(.+)$/) ? $1 : "Archer::Plugin::$plugin->{module}";
122 22         86 $self->log( 'debug' => "load $class" );
123 22 50       548 $class->use or die $@;
124              
125 22 100       195 if ( $args->{server} ) {
126 16         63 $self->log( 'info' => "run @{[ $plugin->{name} ]} ( $class ) to @{[ $args->{server} ]}" );
  16         109  
  16         64  
127             } else {
128 6         13 $self->log( 'info' => "run @{[ $plugin->{name} ]} ( $class )" );
  6         58  
129             }
130             $class->new(
131             { config => $plugin->{ config },
132             project => $self->{ project },
133 22         622 %$args
134             }
135             )->run( $self, $args );
136              
137 21         416 print "\n\n"; # for debug.
138             }
139             }
140              
141             sub run_process {
142 5     5 0 8 my ( $self ) = @_;
143              
144             my $parallel = $self->{ config }->{ global }->{ parallel }
145 5   50     32 || 'Archer::Parallel::ForkManager';
146 5 50       43 $parallel->use or die $@;
147              
148 5         74 my $server_tree = $self->{config}->{projects}->{$self->{project}};
149              
150 5         9 my @elems;
151 5         36 while ( my ( $role, $servers ) = each %$server_tree ) {
152 7 100 100     38 next if $self->{role} && $self->{role} ne $role;
153 6         16 for my $server ( @$servers ) {
154 9         52 push @elems, { server => $server, role => $role };
155             }
156             }
157 5         32 $self->log( debug => "run parallel : $self->{parallel_num}" );
158 5         117 my $manager = $parallel->new;
159             $manager->run(
160             { elems => \@elems,
161             callback => sub {
162 9     9   16 my $args = shift;
163 9         27 $self->run_hook( 'process', $args );
164             },
165             num => $self->{ parallel_num },
166             }
167 5         58 );
168             }
169              
170             sub bootstrap {
171 0     0   0 my ( $class, $opts ) = @_;
172              
173 0         0 my $self = $class->new( $opts );
174 0         0 $self->run;
175 0         0 return $self;
176             }
177              
178             sub log {
179 98     98 0 227 my ( $self, $level, $msg, %opt ) = @_;
180              
181 98 50       242 return unless $self->should_log( $level );
182              
183             # hack to get the original caller as Plugin or Rule
184             # from plagger.
185 98         170 my $caller = $opt{ caller };
186 98 50       207 unless ( $caller ) {
187 98         122 my $i = 0;
188 98         314 while ( my $c = caller( $i++ ) ) {
189 116 100       1410 last if $c !~ /Plugin|Rule/;
190 18         222 $caller = $c;
191             }
192 98   66     380 $caller ||= caller( 0 );
193             }
194              
195 98         932 warn "$caller [$level] $msg\n";
196             }
197              
198             my %levels = (
199             debug => 0,
200             warn => 1,
201             info => 2,
202             error => 3,
203             );
204              
205             sub should_log {
206 98     98 0 143 my ( $self, $level ) = @_;
207              
208 98   100     471 my $setting_level = $self->{config}->{global}->{log}->{level} || 'debug';
209 98         412 $levels{ $level } >= $levels{ $setting_level };
210             }
211              
212             1;
213              
214             __END__