package MyCPAN::Indexer::Interface::Curses;
use strict;
use warnings;
BEGIN {
my $rc = eval { require Curses; 1 };
die "You need to install the Curses module to use MyCPAN::Indexer::Interface::Curses\n"
unless $rc;
Curses->import;
}
use vars qw($VERSION $logger);
$VERSION = '1.282';
=encoding utf8
=head1 NAME
MyCPAN::Indexer::Interface::Curses - Present the run info in a terminal
=head1 SYNOPSIS
Use this in backpan_indexer.pl by specifying it as the interface class:
# in backpan_indexer.config
interface_class MyCPAN::Indexer::Interface::Curses
=head1 DESCRIPTION
This class presents the information as the indexer runs, using Curses.
=head2 Methods
=over 4
=item do_interface( $Notes )
=cut
BEGIN { $SIG{INT} = sub { exit } }
BEGIN {
use Log::Log4perl;
$logger = Log::Log4perl->get_logger( 'Interface' );
}
sub component_type { $_[0]->interface_type }
sub do_interface
{
my( $self ) = @_;
$logger->debug( "Calling do_interface" );
initscr();
noecho();
raw();
$self->set_note( 'curses', {} );
my $curses = $self->get_note( 'curses' );
$curses->{rows} = LINES();
$curses->{cols} = COLS();
addstr( 0, 0, join " ", $Notes->{Config}{indexer_class}, $Notes->{Config}{indexer_class}->VERSION );
refresh();
$curses->{windows}{progress} = newwin( 3, COLS(), 1, 0 );
$curses->{windows}{left_tracker} = newwin( 6, 20, 4, 0 );
$curses->{windows}{right_tracker} = newwin( 6, COLS() - 21, 4, 21 );
$curses->{windows}{PID} = newwin( 7, COLS(), 10, 0 );
$curses->{windows}{Errors} = newwin( 7, COLS(), 17, 0 );
foreach my $value ( values %{ $curses->{windows} } )
{
box( $value, 0, 0 );
refresh( $value );
}
my $count = 0;
while( 1 )
{
$self->get_note( 'interface_callback' )->();
$self->_update_screen( $Notes );
last if $self->get_note( 'Finished' );
}
}
{
no warnings;
my $labels = {
# Label, win, row, column, key, key length, value length
Total => [ qw(left_tracker 1 1 Total 6 6) ],
Done => [ qw(left_tracker 2 1 Done 6 6) ],
Left => [ qw(left_tracker 3 1 Left 6 6) ],
Errors => [ qw(left_tracker 4 1 Errors 6 6) ],
UUID => [ qw(right_tracker 1 1 UUID 8 30) ],
Started => [ qw(right_tracker 2 1 Started 8 -30) ],
Elapsed => [ qw(right_tracker 3 1 Elapsed 8 -30) ],
Rate => [ qw(right_tracker 4 1 Rate 8 -30) ],
};
my $headers = {
'##' => [ qw(PID 1 1 ## 2 0) ],
PID => [ qw(PID 1 5 PID 6 0) ],
Processing => [ qw(PID 1 13 Processing -40 0) ],
ErrorList => [ qw(Errors 0 1 Errors 7 0) ],
};
my $values = {};
sub _update_screen
{
$_[0]->_update_labels;
$_[0]->_update_progress;
$_[0]->_update_values;
}
sub _update_labels
{
my( $self ) = @_;
#print "Calling _update_screen\n";
my $curses = $self->get_note( 'curses' );
foreach my $key ( keys %$labels )
{
my $tuple = $labels->{$key};
eval { addstr(
$curses->{windows}{ $tuple->[0] },
@$tuple[1,2,3]
);
refresh( $curses->{windows}{ $tuple->[0] } );
};
}
foreach my $key ( keys %$headers )
{
my $tuple = $headers->{$key};
eval {
my $width = $tuple->[4];
addstr(
$curses->{windows}{ $tuple->[0] },
@$tuple[1,2],
sprintf "%${width}s", $tuple->[3]
);
refresh( $curses->{windows}{ $tuple->[0] } );
};
}
foreach my $i ( 1 .. $Notes->{Threads} )
{
no warnings;
my $width = $headers->{'##'}[4];
addstr(
$curses->{windows}{PID},
$i + 1,
$headers->{'##'}[2] + 1,
sprintf "%${width}s", $i );
refresh( $curses->{windows}{PID} );
}
refresh( $curses->{windows}{PID} );
}
sub _update_progress
{
my( $self ) = @_;
my $curses = $self->get_note( 'curses' );
my $progress = eval { ( COLS() - 2 ) / $Notes->{Total} * $Notes->{Done} } || 0;
addstr(
$curses->{windows}{progress},
1, 1,
'*' x $progress
);
refresh( $curses->{windows}{progress} );
}
sub _update_values
{
my( $self ) = @_;
my $curses = $self->get_note( 'curses' );
no warnings;
foreach my $key ( qw(Total Done Left Errors UUID Started Elapsed Rate) )
{
my $tuple = $labels->{$key};
addstr(
$curses->{windows}{ $tuple->[0] },
$tuple->[1],
$tuple->[2] + $tuple->[4] + 2,
sprintf "%" . $tuple->[5] . "s", $self->get_notes( $tuple->[3] );
);
refresh( $curses->{windows}{ $tuple->[0] } );
}
foreach my $i ( 1 .. $self->get_note( 'Threads' ) )
{
my $width = $headers->{PID}[4];
addstr(
$curses->{windows}{PID},
$i + 1, $headers->{PID}[2],
sprintf "%${width}s", $self->get_note('PID')->[$i-1]
);
$width = COLS() - $headers->{Processing}[2] - 1;
addstr(
$curses->{windows}{PID},
$i + 1,
$headers->{Processing}[2],
' ' x ( COLS() - $headers->{Processing}[2] - 1 )
);
my $recent = $self->get_note( 'recent' );
addstr(
$curses->{windows}{PID},
$i + 1,
$headers->{Processing}[2],
sprintf "%-${width}s", substr(
(defined $recent->[$i-1] ? $recent->[$i-1] : ''), 0, $width )
);
refresh( $curses->{windows}{PID} );
}
}
}
END { endwin() }
=back
=head1 SEE ALSO
MyCPAN::Indexer
=head1 SOURCE AVAILABILITY
This code is in Github:
git://github.com/briandfoy/mycpan-indexer.git
=head1 AUTHOR
brian d foy, C<< <bdfoy@cpan.org> >>
=head1 COPYRIGHT AND LICENSE
Copyright © 2008-2018, brian d foy <bdfoy@cpan.org>. All rights reserved.
You may redistribute this under the terms of the Artistic License 2.0.
=cut
1;