tools/winapi/output.pm

   1 #
   2 # Copyright 1999, 2000, 2001 Patrik Stridvall
   3 #
   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.
   8 #
   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.
  13 #
  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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  17 #
  18
  19 package output;
  20
  21 use strict;
  22
  23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  24 require Exporter;
  25
  26 @ISA = qw(Exporter);
  27 @EXPORT = qw();
  28 @EXPORT_OK = qw($output);
  29
  30 use vars qw($output);
  31
  32 $output = '_output'->new;
  33
  34 package _output;
  35
  36 use strict;
  37
  38 my $stdout_isatty = -t STDOUT;
  39 my $stderr_isatty = -t STDERR;
  40
  41 sub new {
  42     my $proto = shift;
  43     my $class = ref($proto) || $proto;
  44     my $self  = {};
  45     bless ($self, $class);
  46
  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}};
  54
  55     $$progress_enabled = 1;
  56     $$progress = "";
  57     $$last_progress = "";
  58     $$last_time = 0;
  59     $$progress_count = 0;
  60     $$prefix = undef;
  61     $$prefix_callback = undef;
  62
  63     return $self;
  64 }
  65
  66 sub DESTROY {
  67     my $self = shift;
  68
  69     $self->hide_progress;
  70 }
  71
  72 sub enable_progress {
  73     my $self = shift;
  74     my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
  75
  76     $$progress_enabled = 1;
  77 }
  78
  79 sub disable_progress {
  80     my $self = shift;
  81     my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
  82
  83     $$progress_enabled = 0;
  84 }
  85
  86 sub show_progress {
  87     my $self = shift;
  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}};
  92
  93     $$progress_count++;
  94
  95     if($$progress_enabled) {
  96         if($$progress_count > 0 && $$progress && $stderr_isatty) {
  97             print STDERR $$progress;
  98             $$last_progress = $$progress;
  99         }
 100     }
 101 }
 102
 103 sub hide_progress  {
 104     my $self = shift;
 105     my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
 106     my $progress = \${$self->{PROGRESS}};
 107     my $last_progress = \${$self->{LAST_PROGRESS}};
 108     my $progress_count = \${$self->{PROGRESS_COUNT}};
 109
 110     $$progress_count--;
 111
 112     if($$progress_enabled) {
 113         if($$last_progress && $stderr_isatty) {
 114             my $message;
 115             for (1..length($$last_progress)) {
 116                 $message .= "\b \b";
 117             }
 118             print STDERR $message;
 119             undef $$last_progress;
 120         }
 121     }
 122 }
 123
 124 sub update_progress {
 125     my $self = shift;
 126     my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
 127     my $progress = \${$self->{PROGRESS}};
 128     my $last_progress = \${$self->{LAST_PROGRESS}};
 129
 130     if($$progress_enabled) {
 131         my $prefix = "";
 132         my $suffix = "";
 133         if($$last_progress) {
 134             for (1..length($$last_progress)) {
 135                 $prefix .= "\b";
 136             }
 137
 138             my $diff = length($$last_progress)-length($$progress);
 139             if($diff > 0) {
 140                 for (1..$diff) {
 141                     $suffix .= " ";
 142                 }
 143                 for (1..$diff) {
 144                     $suffix .= "\b";
 145                 }
 146             }
 147         }
 148         print STDERR $prefix . $$progress . $suffix;
 149         $$last_progress = $$progress;
 150     }
 151 }
 152
 153 sub progress {
 154     my $self = shift;
 155     my $progress = \${$self->{PROGRESS}};
 156     my $last_time = \${$self->{LAST_TIME}};
 157
 158     my $new_progress = shift;
 159     if(defined($new_progress)) {
 160         if(!defined($$progress) || $new_progress ne $$progress) {
 161             $$progress = $new_progress;
 162
 163             $self->update_progress;
 164             $$last_time = 0;
 165         }
 166     } else {
 167         return $$progress;
 168     }
 169 }
 170
 171 sub lazy_progress {
 172     my $self = shift;
 173     my $progress = \${$self->{PROGRESS}};
 174     my $last_time = \${$self->{LAST_TIME}};
 175
 176     $$progress = shift;
 177
 178     my $time = time();
 179     if($time - $$last_time > 0) {
 180         $self->update_progress;
 181         $$last_time = $time;
 182     }
 183 }
 184
 185 sub prefix {
 186     my $self = shift;
 187     my $prefix = \${$self->{PREFIX}};
 188     my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
 189
 190     my $new_prefix = shift;
 191     if(defined($new_prefix)) {
 192         if(!defined($$prefix) || $new_prefix ne $$prefix) {
 193             $$prefix = $new_prefix;
 194             $$prefix_callback = undef;
 195         }
 196     } else {
 197         return $$prefix;
 198     }
 199 }
 200
 201 sub prefix_callback {
 202     my $self = shift;
 203
 204     my $prefix = \${$self->{PREFIX}};
 205     my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
 206
 207     $$prefix = undef;
 208     $$prefix_callback = shift;
 209 }
 210
 211 sub write {
 212     my $self = shift;
 213
 214     my $message = shift;
 215
 216     my $prefix = \${$self->{PREFIX}};
 217     my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
 218
 219     $self->hide_progress if $stdout_isatty;
 220     if(defined($$prefix)) {
 221         print $$prefix . $message;
 222     } elsif(defined($$prefix_callback)) {
 223         print &{$$prefix_callback}() . $message;
 224     } else {
 225         print $message;
 226     }
 227     $self->show_progress if $stdout_isatty;
 228 }
 229
 230 1;