output.pm 5.59 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
#
# Copyright 1999, 2000, 2001 Patrik Stridvall
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# 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
17 18
#

19 20 21 22
package output;

use strict;

23 24
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
25

26 27 28
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw($output);
29

30
use vars qw($output);
31

32
$output = '_output'->new;
33 34 35 36 37

package _output;

use strict;

38 39 40
my $stdout_isatty = -t STDOUT;
my $stderr_isatty = -t STDERR;

41
sub new($) {
42 43 44 45 46
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    bless ($self, $class);

47
    my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
48 49
    my $progress = \${$self->{PROGRESS}};
    my $last_progress = \${$self->{LAST_PROGRESS}};
50
    my $last_time = \${$self->{LAST_TIME}};
51 52
    my $progress_count = \${$self->{PROGRESS_COUNT}};
    my $prefix = \${$self->{PREFIX}};
53
    my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
54

55
    $$progress_enabled = 1;
56 57
    $$progress = "";
    $$last_progress = "";
58
    $$last_time = 0;
59
    $$progress_count = 0;
60 61
    $$prefix = undef;
    $$prefix_callback = undef;
62 63 64 65

    return $self;
}

66 67 68 69 70 71
sub DESTROY {
    my $self = shift;

    $self->hide_progress;
}

72
sub enable_progress($) {
73 74 75 76 77 78
    my $self = shift;
    my $progress_enabled = \${$self->{PROGRESS_ENABLED}};

    $$progress_enabled = 1;
}

79
sub disable_progress($) {
80 81 82 83 84 85
    my $self = shift;
    my $progress_enabled = \${$self->{PROGRESS_ENABLED}};

    $$progress_enabled = 0;
}

86
sub show_progress($) {
87
    my $self = shift;
88
    my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
89
    my $progress = ${$self->{PROGRESS}};
90 91 92 93 94
    my $last_progress = \${$self->{LAST_PROGRESS}};
    my $progress_count = \${$self->{PROGRESS_COUNT}};

    $$progress_count++;

95 96
    if($$progress_enabled) {
	if($$progress_count > 0 && $$progress && $stderr_isatty) {
97 98 99 100 101 102 103
            # If progress has more than $columns characters the xterm will
            # scroll to the next line and our ^H characters will fail to
            # erase it.
            my $columns=$ENV{COLUMNS} || 80;
            $progress = substr $progress,0,($columns-1);
	    print STDERR $progress;
	    $$last_progress = $progress;
104
	}
105 106 107
    }
}

108
sub hide_progress($)  {
109
    my $self = shift;
110
    my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
111 112 113 114 115 116
    my $progress = \${$self->{PROGRESS}};
    my $last_progress = \${$self->{LAST_PROGRESS}};
    my $progress_count = \${$self->{PROGRESS_COUNT}};

    $$progress_count--;

117 118
    if($$progress_enabled) {
	if($$last_progress && $stderr_isatty) {
119
	    my $message=" " x length($$last_progress);
120 121
	    print STDERR $message;
	    undef $$last_progress;
122 123 124 125
	}
    }
}

126
sub update_progress($) {
127
    my $self = shift;
128
    my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
129
    my $progress = ${$self->{PROGRESS}};
130
    my $last_progress = \${$self->{LAST_PROGRESS}};
131

132
    if($$progress_enabled) {
133 134 135 136 137 138
        # If progress has more than $columns characters the xterm will
        # scroll to the next line and our ^H characters will fail to
        # erase it.
        my $columns=$ENV{COLUMNS} || 80;
        $progress = substr $progress,0,($columns-1);

139 140 141
	my $prefix = "";
	my $suffix = "";
	if($$last_progress) {
142
            $prefix = "" x length($$last_progress);
143

144
	    my $diff = length($$last_progress)-length($progress);
145
	    if($diff > 0) {
146
                $suffix = (" " x $diff) . ("" x $diff);
147 148
	    }
	}
149 150
	print STDERR $prefix, $progress, $suffix;
	$$last_progress = $progress;
151 152 153
    }
}

154
sub progress($$) {
155 156
    my $self = shift;
    my $progress = \${$self->{PROGRESS}};
157
    my $last_time = \${$self->{LAST_TIME}};
158

159 160 161 162
    my $new_progress = shift;
    if(defined($new_progress)) {
	if(!defined($$progress) || $new_progress ne $$progress) {
	    $$progress = $new_progress;
163

164 165 166 167 168 169
	    $self->update_progress;
	    $$last_time = 0;
	}
    } else {
	return $$progress;
    }
170 171
}

172
sub lazy_progress($$) {
173 174 175 176 177 178 179 180 181 182 183
    my $self = shift;
    my $progress = \${$self->{PROGRESS}};
    my $last_time = \${$self->{LAST_TIME}};

    $$progress = shift;

    my $time = time();
    if($time - $$last_time > 0) {
	$self->update_progress;
    	$$last_time = $time;
    }
184 185
}

186
sub prefix($$) {
187 188
    my $self = shift;
    my $prefix = \${$self->{PREFIX}};
189
    my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
190

191 192
    my $new_prefix = shift;
    if(defined($new_prefix)) {
193 194 195 196
	if(!defined($$prefix) || $new_prefix ne $$prefix) {
	    $$prefix = $new_prefix;
	    $$prefix_callback = undef;
	}
197 198 199
    } else {
	return $$prefix;
    }
200 201
}

202
sub prefix_callback($) {
203 204 205 206 207 208 209
    my $self = shift;

    my $prefix = \${$self->{PREFIX}};
    my $prefix_callback = \${$self->{PREFIX_CALLBACK}};

    $$prefix = undef;
    $$prefix_callback = shift;
210 211
}

212
sub write($$) {
213 214 215 216 217
    my $self = shift;

    my $message = shift;

    my $prefix = \${$self->{PREFIX}};
218
    my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
219

220
    $self->hide_progress if $stdout_isatty;
221 222 223 224 225 226 227
    if(defined($$prefix)) {
	print $$prefix . $message;
    } elsif(defined($$prefix_callback)) {
	print &{$$prefix_callback}() . $message;
    } else {
	print $message;
    }
228
    $self->show_progress if $stdout_isatty;
229 230 231
}

1;