tools/winapi/output.pm

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