Skip to content

Commit 8b5c463

Browse files
skajiskaji
committed
[ci skip]
1 parent b05b8bd commit 8b5c463

File tree

7 files changed

+140
-36
lines changed

7 files changed

+140
-36
lines changed

‎META.json‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,7 @@
4040
"Module::CPANfile" : "0",
4141
"Module::Metadata" : "0",
4242
"Module::cpmfile" : "0.001",
43-
"Parallel::Pipes::App" : "0.100",
43+
"Parallel::Pipes::App" : "0.200",
4444
"Parse::PMFile" : "0.43",
4545
"Proc::ForkSafe" : "0.001",
4646
"local::lib" : "2.000018",
@@ -79,6 +79,12 @@
7979
"App::cpm::Logger::File" : {
8080
"file" : "lib/App/cpm/Logger/File.pm"
8181
},
82+
"App::cpm::Logger::Terminal" : {
83+
"file" : "lib/App/cpm/Logger/Terminal.pm"
84+
},
85+
"App::cpm::Logger::Terminal::Lines" : {
86+
"file" : "lib/App/cpm/Logger/Terminal.pm"
87+
},
8288
"App::cpm::Master" : {
8389
"file" : "lib/App/cpm/Master.pm"
8490
},

‎cpm.yml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ prereqs:
2727
Module::CPANfile:
2828
Module::Metadata:
2929
Module::cpmfile: { version: '0.001' }
30-
Parallel::Pipes::App: { version: '0.100' }
30+
Parallel::Pipes::App: { version: '0.200' }
3131
Parse::PMFile: { version: '0.43' }
3232
Proc::ForkSafe: { version: '0.001' }
3333
local::lib: { version: '2.000018' }

‎lib/App/cpm/CLI.pm‎

Lines changed: 13 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -371,21 +371,31 @@ sub install {
371371
my @task = $master->get_task;
372372
Parallel::Pipes::App->run(
373373
num => $num,
374+
init_work => sub {
375+
my $pipes = shift;
376+
my @pid = sort { $a <=> $b } keys %{$pipes->{pipes}};
377+
$master->{_pids} = \@pid;
378+
},
374379
before_work => sub {
375-
my $task = shift;
376-
$task->in_charge(1);
380+
my ($task, $worker) = @_;
381+
$task->in_charge($worker->{pid});
377382
},
378383
work => sub {
379384
my $task = shift;
380-
return $worker->work($task);
385+
$worker->work($task);
381386
},
382387
after_work => sub {
383388
my $result = shift;
384389
$master->register_result($result);
385390
@task = $master->get_task;
386391
},
387392
tasks => \@task,
393+
idle_tick => 0.5,
394+
idle_work => sub {
395+
$master->log_task;
396+
},
388397
);
398+
$master->log_task_finalize;
389399
}
390400

391401
sub cleanup {

‎lib/App/cpm/Distribution.pm‎

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,6 @@ package App::cpm::Distribution;
22
use strict;
33
use warnings;
44

5-
use App::cpm::Logger;
65
use App::cpm::Requirement;
76
use App::cpm::version;
87
use CPAN::DistnameInfo;
@@ -145,16 +144,15 @@ sub providing {
145144
for my $provide (@{$self->provides}) {
146145
if ($provide->{package} eq $package) {
147146
if (!$version_range or App::cpm::version->parse($provide->{version})->satisfy($version_range)) {
148-
return 1;
147+
return (1, undef);
149148
} else {
150-
my $message = sprintf "%s provides %s (%s), but needs %s\n",
149+
my $err = sprintf "%s provides %s (%s), but needs %s\n",
151150
$self->distfile, $package, $provide->{version} || 0, $version_range;
152-
App::cpm::Logger->log(result => "WARN", message => $message);
153-
last;
151+
return (undef, $err);
154152
}
155153
}
156154
}
157-
return;
155+
return (undef, undef);
158156
}
159157

160158
sub equals {

‎lib/App/cpm/Logger/Terminal.pm‎

Lines changed: 78 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,78 @@
1+
package App::cpm::Logger::Terminal;
2+
use strict;
3+
use warnings;
4+
5+
{
6+
package App::cpm::Logger::Terminal::Lines;
7+
sub new {
8+
my ($class, $pids, $progress) = @_;
9+
my $num = keys %$pids;
10+
bless {
11+
pids => $pids,
12+
progress => $progress,
13+
num => $num,
14+
worker_prefix => $num < 10 ? "worker%d" : "worker%-2d",
15+
_lines => [],
16+
}, $class;
17+
}
18+
my %_ing = (install => "installing", resolve => "resolving", fetch => "fetching", configure => "configuring");
19+
sub set_worker {
20+
my ($self, $pid, $task) = @_;
21+
my $i = $self->{pids}{$pid};
22+
my ($progress, $ing, $name) = $task ?
23+
($self->{progress}, $_ing{$task->type}, $task->distvname) : (" ", "idle", "");
24+
$self->{_lines}[$i] = sprintf "$self->{worker_prefix} %s \e[1;30m%-11s\e[m %s\n",
25+
$i+1, $progress, $ing, $name;
26+
}
27+
sub set_summary {
28+
my ($self, $all, $num) = @_;
29+
$self->{_lines}[$self->{num}] = "--- $num/$all ---\n";
30+
}
31+
sub lines {
32+
my $self = shift;
33+
@{$self->{_lines}};
34+
}
35+
}
36+
37+
use IO::Handle;
38+
39+
sub new {
40+
my ($class, @pid) = @_;
41+
my %pid = map { ($pid[$_], $_) } 0 .. $#pid;
42+
bless {
43+
first => 1,
44+
pids => \%pid,
45+
lines => 1 + (keys %pid),
46+
fh => \*STDERR,
47+
_progress_index => 0,
48+
}, $class;
49+
}
50+
51+
my @_progress = qw(\\ | / -);
52+
sub progress {
53+
my $self = shift;
54+
$self->{_progress_index} = ($self->{_progress_index}+1) % 4;
55+
$_progress[$self->{_progress_index}];
56+
}
57+
58+
sub new_lines {
59+
my $self = shift;
60+
App::cpm::Logger::Terminal::Lines->new($self->{pids}, $self->progress);
61+
}
62+
63+
sub clear {
64+
my $self = shift;
65+
$self->{fh}->print( ("\e[1A\e[K") x $self->{lines} );
66+
}
67+
68+
sub write {
69+
my ($self, $lines) = @_;
70+
if ($self->{first}) {
71+
$self->{first} = undef;
72+
} else {
73+
$self->clear;
74+
}
75+
$self->{fh}->print($lines->lines);
76+
}
77+
78+
1;

‎lib/App/cpm/Master.pm‎

Lines changed: 36 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ use warnings;
44

55
use App::cpm::CircularDependency;
66
use App::cpm::Distribution;
7+
use App::cpm::Logger::Terminal;
78
use App::cpm::Logger;
89
use App::cpm::Task;
910
use App::cpm::version;
@@ -40,7 +41,7 @@ sub new {
4041
} else {
4142
my $msg = "You don't have Module::CoreList. "
4243
. "The local-lib may result in incomplete self-contained directory.";
43-
App::cpm::Logger->log(result => "WARN", message => $msg);
44+
warn "$msg\n";
4445
}
4546
}
4647
$self;
@@ -123,15 +124,33 @@ sub register_result {
123124

124125
%{$task} = %{$result}; # XXX
125126

126-
my $logged = $self->info($task);
127+
#my $logged = $self->info($task);
127128
my $method = "_register_@{[$task->{type}]}_result";
128129
$self->$method($task);
129130
$self->remove_task($task);
130-
$self->_show_progress if $logged && $self->{show_progress};
131+
#$self->_show_progress if $logged && $self->{show_progress};
132+
$self->log_task($task);
131133

132134
return 1;
133135
}
134136

137+
sub log_task {
138+
my ($self, @done) = @_;
139+
my $terminal = $self->{terminal} ||= App::cpm::Logger::Terminal->new(@{$self->{_pids}});
140+
my $lines = $terminal->new_lines;
141+
for my $pid (@{$self->{_pids}}) {
142+
my ($task) = grep { $_->in_charge == $pid } @done, $self->tasks; # maybe task is undef
143+
$lines->set_worker($pid, $task);
144+
}
145+
$lines->set_summary((0+keys %{$self->{distributions}}), $self->installed_distributions);
146+
$terminal->write($lines);
147+
}
148+
149+
sub log_task_finalize {
150+
my $self = shift;
151+
$self->{terminal}->clear;
152+
}
153+
135154
sub info {
136155
my ($self, $task) = @_;
137156
my $type = $task->type;
@@ -226,7 +245,6 @@ sub _calculate_tasks {
226245
my $msg = sprintf "%s requires perl %s, but you have only %s",
227246
$dist->distvname, $req->{version_range}, $self->{target_perl} || $];
228247
$self->{logger}->log($msg);
229-
App::cpm::Logger->log(result => "FAIL", message => $msg);
230248
$self->{_fail_install}{$dist->distfile}++;
231249
}
232250
}
@@ -264,7 +282,6 @@ sub _calculate_tasks {
264282
my $msg = sprintf "%s requires perl %s, but you have only %s",
265283
$dist->distvname, $req->{version_range}, $self->{target_perl} || $];
266284
$self->{logger}->log($msg);
267-
App::cpm::Logger->log(result => "FAIL", message => $msg);
268285
$self->{_fail_install}{$dist->distfile}++;
269286
}
270287
}
@@ -330,14 +347,7 @@ sub is_core {
330347
my $target_perl = $self->{target_perl};
331348
if (exists $Module::CoreList::version{$target_perl}{$package}) {
332349
if (!exists $Module::CoreList::version{$]}{$package}) {
333-
if (!$self->{_removed_core}{$package}++) {
334-
my $t = App::cpm::version->parse($target_perl)->normal;
335-
my $v = App::cpm::version->parse($])->normal;
336-
App::cpm::Logger->log(
337-
result => "WARN",
338-
message => "$package used to be core in $t, but not in $v, so will be installed",
339-
);
340-
}
350+
# $package used to be core in $target_perl, but not in $], so will be installed
341351
return;
342352
}
343353
return 1 unless $version_range;
@@ -363,7 +373,19 @@ sub is_satisfied {
363373
}
364374
next if $self->{target_perl} and $self->is_core($package, $version_range);
365375
next if $self->is_installed($package, $version_range);
366-
my ($resolved) = grep { $_->providing($package, $version_range) } @distributions;
376+
377+
my $resolved;
378+
for my $dist (@distributions) {
379+
my ($ok, $err) = $dist->providing($package, $version_range);
380+
if ($ok) {
381+
$resolved = $dist;
382+
last;
383+
}
384+
if ($err) {
385+
$self->{logger}->log($err);
386+
last;
387+
}
388+
}
367389
next if $resolved && $resolved->installed;
368390

369391
$is_satisfied = 0 if defined $is_satisfied;
@@ -397,11 +419,6 @@ sub _register_resolve_result {
397419
if ($task->{distfile} and $task->{distfile} =~ m{/perl-5[^/]+$}) {
398420
my $message = "$task->{package} is a core module.";
399421
$self->{logger}->log($message);
400-
App::cpm::Logger->log(
401-
result => "DONE",
402-
type => "install",
403-
message => $message,
404-
);
405422
return;
406423
}
407424

@@ -415,11 +432,6 @@ sub _register_resolve_result {
415432
: " is up to date. ($local)"
416433
);
417434
$self->{logger}->log($message);
418-
App::cpm::Logger->log(
419-
result => "DONE",
420-
type => "install",
421-
message => $message,
422-
);
423435
return;
424436
}
425437
}

‎lib/App/cpm/Task.pm‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ use CPAN::DistnameInfo;
55

66
sub new {
77
my ($class, %option) = @_;
8-
my $self = bless {%option}, $class;
8+
my $self = bless {in_charge => 0, %option}, $class;
99
$self->{uid} = $self->_uid;
1010
$self;
1111
}

0 commit comments

Comments
 (0)