- FreeBSD now supported.
[wine] / 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;