From 8b5c463272ce56cee8859f272a7854c7f25d718d Mon Sep 17 00:00:00 2001 From: Shoichi Kaji Date: Sat, 26 Aug 2023 12:33:52 +0900 Subject: [PATCH] [ci skip] --- META.json | 8 +++- cpm.yml | 2 +- lib/App/cpm/CLI.pm | 16 +++++-- lib/App/cpm/Distribution.pm | 10 ++--- lib/App/cpm/Logger/Terminal.pm | 78 ++++++++++++++++++++++++++++++++++ lib/App/cpm/Master.pm | 60 +++++++++++++++----------- lib/App/cpm/Task.pm | 2 +- 7 files changed, 140 insertions(+), 36 deletions(-) create mode 100644 lib/App/cpm/Logger/Terminal.pm diff --git a/META.json b/META.json index aec9e4f1..80458d14 100644 --- a/META.json +++ b/META.json @@ -40,7 +40,7 @@ "Module::CPANfile" : "0", "Module::Metadata" : "0", "Module::cpmfile" : "0.001", - "Parallel::Pipes::App" : "0.100", + "Parallel::Pipes::App" : "0.200", "Parse::PMFile" : "0.43", "Proc::ForkSafe" : "0.001", "local::lib" : "2.000018", @@ -79,6 +79,12 @@ "App::cpm::Logger::File" : { "file" : "lib/App/cpm/Logger/File.pm" }, + "App::cpm::Logger::Terminal" : { + "file" : "lib/App/cpm/Logger/Terminal.pm" + }, + "App::cpm::Logger::Terminal::Lines" : { + "file" : "lib/App/cpm/Logger/Terminal.pm" + }, "App::cpm::Master" : { "file" : "lib/App/cpm/Master.pm" }, diff --git a/cpm.yml b/cpm.yml index f150c562..89e1c56c 100644 --- a/cpm.yml +++ b/cpm.yml @@ -27,7 +27,7 @@ prereqs: Module::CPANfile: Module::Metadata: Module::cpmfile: { version: '0.001' } - Parallel::Pipes::App: { version: '0.100' } + Parallel::Pipes::App: { version: '0.200' } Parse::PMFile: { version: '0.43' } Proc::ForkSafe: { version: '0.001' } local::lib: { version: '2.000018' } diff --git a/lib/App/cpm/CLI.pm b/lib/App/cpm/CLI.pm index 890b65f9..ac5b3d3e 100644 --- a/lib/App/cpm/CLI.pm +++ b/lib/App/cpm/CLI.pm @@ -371,13 +371,18 @@ sub install { my @task = $master->get_task; Parallel::Pipes::App->run( num => $num, + init_work => sub { + my $pipes = shift; + my @pid = sort { $a <=> $b } keys %{$pipes->{pipes}}; + $master->{_pids} = \@pid; + }, before_work => sub { - my $task = shift; - $task->in_charge(1); + my ($task, $worker) = @_; + $task->in_charge($worker->{pid}); }, work => sub { my $task = shift; - return $worker->work($task); + $worker->work($task); }, after_work => sub { my $result = shift; @@ -385,7 +390,12 @@ sub install { @task = $master->get_task; }, tasks => \@task, + idle_tick => 0.5, + idle_work => sub { + $master->log_task; + }, ); + $master->log_task_finalize; } sub cleanup { diff --git a/lib/App/cpm/Distribution.pm b/lib/App/cpm/Distribution.pm index 24347cd2..4228a351 100644 --- a/lib/App/cpm/Distribution.pm +++ b/lib/App/cpm/Distribution.pm @@ -2,7 +2,6 @@ package App::cpm::Distribution; use strict; use warnings; -use App::cpm::Logger; use App::cpm::Requirement; use App::cpm::version; use CPAN::DistnameInfo; @@ -145,16 +144,15 @@ sub providing { for my $provide (@{$self->provides}) { if ($provide->{package} eq $package) { if (!$version_range or App::cpm::version->parse($provide->{version})->satisfy($version_range)) { - return 1; + return (1, undef); } else { - my $message = sprintf "%s provides %s (%s), but needs %s\n", + my $err = sprintf "%s provides %s (%s), but needs %s\n", $self->distfile, $package, $provide->{version} || 0, $version_range; - App::cpm::Logger->log(result => "WARN", message => $message); - last; + return (undef, $err); } } } - return; + return (undef, undef); } sub equals { diff --git a/lib/App/cpm/Logger/Terminal.pm b/lib/App/cpm/Logger/Terminal.pm new file mode 100644 index 00000000..c9d10a95 --- /dev/null +++ b/lib/App/cpm/Logger/Terminal.pm @@ -0,0 +1,78 @@ +package App::cpm::Logger::Terminal; +use strict; +use warnings; + +{ + package App::cpm::Logger::Terminal::Lines; + sub new { + my ($class, $pids, $progress) = @_; + my $num = keys %$pids; + bless { + pids => $pids, + progress => $progress, + num => $num, + worker_prefix => $num < 10 ? "worker%d" : "worker%-2d", + _lines => [], + }, $class; + } + my %_ing = (install => "installing", resolve => "resolving", fetch => "fetching", configure => "configuring"); + sub set_worker { + my ($self, $pid, $task) = @_; + my $i = $self->{pids}{$pid}; + my ($progress, $ing, $name) = $task ? + ($self->{progress}, $_ing{$task->type}, $task->distvname) : (" ", "idle", ""); + $self->{_lines}[$i] = sprintf "$self->{worker_prefix} %s \e[1;30m%-11s\e[m %s\n", + $i+1, $progress, $ing, $name; + } + sub set_summary { + my ($self, $all, $num) = @_; + $self->{_lines}[$self->{num}] = "--- $num/$all ---\n"; + } + sub lines { + my $self = shift; + @{$self->{_lines}}; + } +} + +use IO::Handle; + +sub new { + my ($class, @pid) = @_; + my %pid = map { ($pid[$_], $_) } 0 .. $#pid; + bless { + first => 1, + pids => \%pid, + lines => 1 + (keys %pid), + fh => \*STDERR, + _progress_index => 0, + }, $class; +} + +my @_progress = qw(\\ | / -); +sub progress { + my $self = shift; + $self->{_progress_index} = ($self->{_progress_index}+1) % 4; + $_progress[$self->{_progress_index}]; +} + +sub new_lines { + my $self = shift; + App::cpm::Logger::Terminal::Lines->new($self->{pids}, $self->progress); +} + +sub clear { + my $self = shift; + $self->{fh}->print( ("\e[1A\e[K") x $self->{lines} ); +} + +sub write { + my ($self, $lines) = @_; + if ($self->{first}) { + $self->{first} = undef; + } else { + $self->clear; + } + $self->{fh}->print($lines->lines); +} + +1; diff --git a/lib/App/cpm/Master.pm b/lib/App/cpm/Master.pm index 51266682..47243762 100644 --- a/lib/App/cpm/Master.pm +++ b/lib/App/cpm/Master.pm @@ -4,6 +4,7 @@ use warnings; use App::cpm::CircularDependency; use App::cpm::Distribution; +use App::cpm::Logger::Terminal; use App::cpm::Logger; use App::cpm::Task; use App::cpm::version; @@ -40,7 +41,7 @@ sub new { } else { my $msg = "You don't have Module::CoreList. " . "The local-lib may result in incomplete self-contained directory."; - App::cpm::Logger->log(result => "WARN", message => $msg); + warn "$msg\n"; } } $self; @@ -123,15 +124,33 @@ sub register_result { %{$task} = %{$result}; # XXX - my $logged = $self->info($task); + #my $logged = $self->info($task); my $method = "_register_@{[$task->{type}]}_result"; $self->$method($task); $self->remove_task($task); - $self->_show_progress if $logged && $self->{show_progress}; + #$self->_show_progress if $logged && $self->{show_progress}; + $self->log_task($task); return 1; } +sub log_task { + my ($self, @done) = @_; + my $terminal = $self->{terminal} ||= App::cpm::Logger::Terminal->new(@{$self->{_pids}}); + my $lines = $terminal->new_lines; + for my $pid (@{$self->{_pids}}) { + my ($task) = grep { $_->in_charge == $pid } @done, $self->tasks; # maybe task is undef + $lines->set_worker($pid, $task); + } + $lines->set_summary((0+keys %{$self->{distributions}}), $self->installed_distributions); + $terminal->write($lines); +} + +sub log_task_finalize { + my $self = shift; + $self->{terminal}->clear; +} + sub info { my ($self, $task) = @_; my $type = $task->type; @@ -226,7 +245,6 @@ sub _calculate_tasks { my $msg = sprintf "%s requires perl %s, but you have only %s", $dist->distvname, $req->{version_range}, $self->{target_perl} || $]; $self->{logger}->log($msg); - App::cpm::Logger->log(result => "FAIL", message => $msg); $self->{_fail_install}{$dist->distfile}++; } } @@ -264,7 +282,6 @@ sub _calculate_tasks { my $msg = sprintf "%s requires perl %s, but you have only %s", $dist->distvname, $req->{version_range}, $self->{target_perl} || $]; $self->{logger}->log($msg); - App::cpm::Logger->log(result => "FAIL", message => $msg); $self->{_fail_install}{$dist->distfile}++; } } @@ -330,14 +347,7 @@ sub is_core { my $target_perl = $self->{target_perl}; if (exists $Module::CoreList::version{$target_perl}{$package}) { if (!exists $Module::CoreList::version{$]}{$package}) { - if (!$self->{_removed_core}{$package}++) { - my $t = App::cpm::version->parse($target_perl)->normal; - my $v = App::cpm::version->parse($])->normal; - App::cpm::Logger->log( - result => "WARN", - message => "$package used to be core in $t, but not in $v, so will be installed", - ); - } + # $package used to be core in $target_perl, but not in $], so will be installed return; } return 1 unless $version_range; @@ -363,7 +373,19 @@ sub is_satisfied { } next if $self->{target_perl} and $self->is_core($package, $version_range); next if $self->is_installed($package, $version_range); - my ($resolved) = grep { $_->providing($package, $version_range) } @distributions; + + my $resolved; + for my $dist (@distributions) { + my ($ok, $err) = $dist->providing($package, $version_range); + if ($ok) { + $resolved = $dist; + last; + } + if ($err) { + $self->{logger}->log($err); + last; + } + } next if $resolved && $resolved->installed; $is_satisfied = 0 if defined $is_satisfied; @@ -397,11 +419,6 @@ sub _register_resolve_result { if ($task->{distfile} and $task->{distfile} =~ m{/perl-5[^/]+$}) { my $message = "$task->{package} is a core module."; $self->{logger}->log($message); - App::cpm::Logger->log( - result => "DONE", - type => "install", - message => $message, - ); return; } @@ -415,11 +432,6 @@ sub _register_resolve_result { : " is up to date. ($local)" ); $self->{logger}->log($message); - App::cpm::Logger->log( - result => "DONE", - type => "install", - message => $message, - ); return; } } diff --git a/lib/App/cpm/Task.pm b/lib/App/cpm/Task.pm index fb298e22..a55662bf 100644 --- a/lib/App/cpm/Task.pm +++ b/lib/App/cpm/Task.pm @@ -5,7 +5,7 @@ use CPAN::DistnameInfo; sub new { my ($class, %option) = @_; - my $self = bless {%option}, $class; + my $self = bless {in_charge => 0, %option}, $class; $self->{uid} = $self->_uid; $self; }