Sweden-Number/tools/winapi/output.pm

133 lines
2.3 KiB
Perl
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

package output;
use strict;
my $_output;
sub new {
my $self = shift;
$_output = _output->new(@_);
return $_output;
}
sub AUTOLOAD {
my $self = shift;
my $name = $output::AUTOLOAD;
$name =~ s/^.*::(.[^:]*)$/$1/;
return $_output->$name(@_);
}
package _output;
use strict;
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
my $progress = \${$self->{PROGRESS}};
my $last_progress = \${$self->{LAST_PROGRESS}};
my $progress_count = \${$self->{PROGRESS_COUNT}};
my $prefix = \${$self->{PREFIX}};
$$progress = "";
$$last_progress = "";
$$progress_count = 0;
$$prefix = "";
return $self;
}
sub show_progress {
my $self = shift;
my $progress = \${$self->{PROGRESS}};
my $last_progress = \${$self->{LAST_PROGRESS}};
my $progress_count = \${$self->{PROGRESS_COUNT}};
$$progress_count++;
if($$progress_count > 0 && $$progress) {
print STDERR $$progress;
$$last_progress = $$progress;
}
}
sub hide_progress {
my $self = shift;
my $progress = \${$self->{PROGRESS}};
my $last_progress = \${$self->{LAST_PROGRESS}};
my $progress_count = \${$self->{PROGRESS_COUNT}};
$$progress_count--;
if($$last_progress) {
my $message;
for (1..length($$last_progress)) {
$message .= " ";
}
print STDERR $message;
undef $$last_progress;
}
}
sub update_progress {
my $self = shift;
my $progress = \${$self->{PROGRESS}};
my $last_progress = \${$self->{LAST_PROGRESS}};
my $prefix = "";
my $suffix = "";
if($$last_progress) {
for (1..length($$last_progress)) {
$prefix .= "";
}
my $diff = length($$last_progress)-length($$progress);
if($diff > 0) {
for (1..$diff) {
$suffix .= " ";
}
for (1..$diff) {
$suffix .= "";
}
}
}
print STDERR $prefix . $$progress . $suffix;
$$last_progress = $$progress;
}
sub progress {
my $self = shift;
my $progress = \${$self->{PROGRESS}};
$$progress = shift;
$self->update_progress;
}
sub prefix {
my $self = shift;
my $prefix = \${$self->{PREFIX}};
$$prefix = shift;
}
sub write {
my $self = shift;
my $message = shift;
my $prefix = \${$self->{PREFIX}};
$self->hide_progress;
print $$prefix . $message;
$self->show_progress;
}
1;