2 # Copyright 1999, 2000, 2001 Patrik Stridvall
4 # This library is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU Lesser General Public
6 # License as published by the Free Software Foundation; either
7 # version 2.1 of the License, or (at your option) any later version.
9 # This library is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 # Lesser General Public License for more details.
14 # You should have received a copy of the GNU Lesser General Public
15 # License along with this library; if not, write to the Free Software
16 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
28 @EXPORT_OK = qw($output);
32 $output = '_output'->new;
38 my $stdout_isatty = -t STDOUT;
39 my $stderr_isatty = -t STDERR;
43 my $class = ref($proto) || $proto;
45 bless ($self, $class);
47 my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
48 my $progress = \${$self->{PROGRESS}};
49 my $last_progress = \${$self->{LAST_PROGRESS}};
50 my $last_time = \${$self->{LAST_TIME}};
51 my $progress_count = \${$self->{PROGRESS_COUNT}};
52 my $prefix = \${$self->{PREFIX}};
53 my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
55 $$progress_enabled = 1;
61 $$prefix_callback = undef;
72 sub enable_progress($) {
74 my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
76 $$progress_enabled = 1;
79 sub disable_progress($) {
81 my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
83 $$progress_enabled = 0;
86 sub show_progress($) {
88 my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
89 my $progress = ${$self->{PROGRESS}};
90 my $last_progress = \${$self->{LAST_PROGRESS}};
91 my $progress_count = \${$self->{PROGRESS_COUNT}};
95 if($$progress_enabled) {
96 if($$progress_count > 0 && $$progress && $stderr_isatty) {
97 # If progress has more than $columns characters the xterm will
98 # scroll to the next line and our ^H characters will fail to
100 my $columns=$ENV{COLUMNS} || 80;
101 $progress = substr $progress,0,($columns-1);
102 print STDERR $progress;
103 $$last_progress = $progress;
108 sub hide_progress($) {
110 my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
111 my $progress = \${$self->{PROGRESS}};
112 my $last_progress = \${$self->{LAST_PROGRESS}};
113 my $progress_count = \${$self->{PROGRESS_COUNT}};
117 if($$progress_enabled) {
118 if($$last_progress && $stderr_isatty) {
119 my $message="
\b \b" x length($$last_progress);
120 print STDERR $message;
121 undef $$last_progress;
126 sub update_progress($) {
128 my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
129 my $progress = ${$self->{PROGRESS}};
130 my $last_progress = \${$self->{LAST_PROGRESS}};
132 if($$progress_enabled) {
133 # If progress has more than $columns characters the xterm will
134 # scroll to the next line and our ^H characters will fail to
136 my $columns=$ENV{COLUMNS} || 80;
137 $progress = substr $progress,0,($columns-1);
141 if($$last_progress) {
142 $prefix = "
\b" x length($$last_progress);
144 my $diff = length($$last_progress)-length($progress);
146 $suffix = (" " x $diff) . ("
\b" x $diff);
149 print STDERR $prefix, $progress, $suffix;
150 $$last_progress = $progress;
156 my $progress = \${$self->{PROGRESS}};
157 my $last_time = \${$self->{LAST_TIME}};
159 my $new_progress = shift;
160 if(defined($new_progress)) {
161 if(!defined($$progress) || $new_progress ne $$progress) {
162 $$progress = $new_progress;
164 $self->update_progress;
172 sub lazy_progress($$) {
174 my $progress = \${$self->{PROGRESS}};
175 my $last_time = \${$self->{LAST_TIME}};
180 if($time - $$last_time > 0) {
181 $self->update_progress;
188 my $prefix = \${$self->{PREFIX}};
189 my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
191 my $new_prefix = shift;
192 if(defined($new_prefix)) {
193 if(!defined($$prefix) || $new_prefix ne $$prefix) {
194 $$prefix = $new_prefix;
195 $$prefix_callback = undef;
202 sub prefix_callback($) {
205 my $prefix = \${$self->{PREFIX}};
206 my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
209 $$prefix_callback = shift;
217 my $prefix = \${$self->{PREFIX}};
218 my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
220 $self->hide_progress if $stdout_isatty;
221 if(defined($$prefix)) {
222 print $$prefix . $message;
223 } elsif(defined($$prefix_callback)) {
224 print &{$$prefix_callback}() . $message;
228 $self->show_progress if $stdout_isatty;