No longer directly accessing debuggee memory.
[wine] / tools / winapi_check / output.pm
1 package output;
2
3 use strict;
4
5 sub new {
6     my $proto = shift;
7     my $class = ref($proto) || $proto;
8     my $self  = {};
9     bless ($self, $class);
10
11     my $progress = \${$self->{PROGRESS}};
12     my $last_progress = \${$self->{LAST_PROGRESS}};
13     my $progress_count = \${$self->{PROGRESS_COUNT}};
14
15     $$progress = "";
16     $$last_progress = "";
17     $progress_count = 0;
18
19     return $self;
20 }
21
22
23 sub show_progress {
24     my $self = shift;
25     my $progress = \${$self->{PROGRESS}};
26     my $last_progress = \${$self->{LAST_PROGRESS}};
27     my $progress_count = \${$self->{PROGRESS_COUNT}};
28
29     $$progress_count++;
30
31     if($$progress_count > 0 && $$progress) {
32         print STDERR $$progress;
33         $$last_progress = $$progress;
34     }
35 }
36
37 sub hide_progress  {
38     my $self = shift;
39     my $progress = \${$self->{PROGRESS}};
40     my $last_progress = \${$self->{LAST_PROGRESS}};
41     my $progress_count = \${$self->{PROGRESS_COUNT}};
42
43     $$progress_count--;
44
45     if($$last_progress) {
46         my $message;
47         for (1..length($$last_progress)) {
48             $message .= "\b \b";
49         }
50         print STDERR $message;
51         undef $$last_progress;
52     }
53 }
54
55 sub update_progress {
56     my $self = shift;
57     my $progress = \${$self->{PROGRESS}};
58     my $last_progress = \${$self->{LAST_PROGRESS}};
59     
60     my $prefix = "";
61     my $suffix = "";
62     if($$last_progress) {
63         for (1..length($$last_progress)) {
64             $prefix .= "\b";
65         }
66         
67         my $diff = length($$last_progress)-length($$progress);
68         if($diff > 0) {
69             for (1..$diff) {
70                 $suffix .= " ";
71             }
72             for (1..$diff) {
73                 $suffix .= "\b";
74             }
75         }
76     }
77     print STDERR $prefix . $$progress . $suffix;
78     $$last_progress = $$progress;
79 }
80
81 sub progress {
82     my $self = shift;
83     my $progress = \${$self->{PROGRESS}};
84
85     $$progress = shift;
86
87     $self->update_progress;
88 }
89
90 sub write {
91     my $self = shift;
92
93     my $message = shift;
94
95
96     $self->hide_progress;
97     print STDERR $message;
98     $self->show_progress;
99 }
100
101 1;