The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

KUERBIS / Term-TablePrint-0.169 / lib / Term / TablePrint / ProgressBar.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
—
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94

              
package Term::TablePrint::ProgressBar;
use strict;
use warnings;
use 5.10.1;
our $VERSION = '0.169';
use Term::Choose::Constants qw( EXTRA_W );
use Term::Choose::Screen    qw( clear_screen clear_to_end_of_line );
use Term::Choose::Util      qw( get_term_width );
sub new {
    my ( $class, $self ) = @_;
    bless $self, $class;
    $self->{show_progress_bar} //= 1;
    return $self;
}
sub set_progress_bar {
    my ( $self ) = @_;
    my $term_w = get_term_width() + EXTRA_W;
    $self->{fmt} = "\rComputing: %3d%% [%s]";
    $self->{short_print} = $term_w < 25 ? 1 : 0;
    if ( $self->{short_print} ) {
        $self->{bar_w} = $term_w
    }
    else {
        $self->{bar_w} = $term_w - length( sprintf $self->{fmt}, 100, '' ) + 1; # +1: lenght("\r") == 1
    }
    $self->{step} = int( $self->{total} / $self->{bar_w} || 1 );
    $self->{count} //= 0;
    $self->{next_update} ||= $self->{step};
    if ( ! $self->{count} ) {
        print clear_screen;
        print "\rComputing: ";
    }
    return;
}
sub update_progress_bar {
    my ( $self ) = @_;
    my $multi = int( $self->{count} / ( $self->{total} / $self->{bar_w} ) ) || 1;
    if ( $self->{short_print} ) {
        print "\r", clear_to_end_of_line;
        print( ( '=' x $multi ) . ( ' ' x ( $self->{bar_w} - $multi ) ) );
    }
    else {
        printf $self->{fmt}, ( $self->{count} / $self->{total} * 100 ), ( '=' x $multi ) . ( ' ' x ( $self->{bar_w} - $multi ) );
    }
    $self->{next_update} = $self->{next_update} + $self->{step};
}
=pod
=encoding UTF-8
=head1 NAME
Term::TablePrint::ProgressBar - Show a progress bar.
=head1 VERSION
Version 0.169
=cut
=head1 DESCRIPTION
Provides the progress bar used in C<Term::TablePrint>.
=head1 AUTHOR
Matthäus Kiem <cuer2s@gmail.com>
=head1 LICENSE AND COPYRIGHT
Copyright 2013-2025 Matthäus Kiem.
This library is free software; you can redistribute it and/or modify it under the same terms as Perl 5.10.0. For
details, see the full text of the licenses in the file LICENSE.
=cut
1;
__END__