1# ex:ts=8 sw=4:
2# $OpenBSD: Term.pm,v 1.40 2018/12/16 10:16:43 espie Exp $
3#
4# Copyright (c) 2004-2007 Marc Espie <espie@openbsd.org>
5#
6# Permission to use, copy, modify, and distribute this software for any
7# purpose with or without fee is hereby granted, provided that the above
8# copyright notice and this permission notice appear in all copies.
9#
10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16
17use strict;
18use warnings;
19
20package OpenBSD::PackingElement;
21sub size_and
22{
23	my ($self, $p, $method, @r) = @_;
24	$p->advance($self);
25	$self->$method(@r);
26}
27
28sub compute_count
29{
30	my ($self, $count) = @_;
31
32	$$count ++;
33}
34
35sub count_and
36{
37	my ($self, $progress, $done, $total, $method, @r) = @_;
38	$$done ++;
39	$progress->show($$done, $total);
40	$self->$method(@r);
41}
42
43package OpenBSD::ProgressMeter::Real;
44our @ISA = qw(OpenBSD::ProgressMeter);
45
46sub ntogo
47{
48	my ($self, $state, $offset) = @_;
49	return $state->ntodo($offset // 0);
50}
51
52sub compute_count
53{
54	my ($progres, $plist) = @_;
55	my $total = 0;
56	$plist->compute_count(\$total);
57	$total = 1 if $total == 0;
58	return $total;
59}
60
61sub visit_with_size
62{
63	my ($progress, $plist, $method, @r) = @_;
64	my $p = $progress->new_sizer($plist);
65	$plist->size_and($p, $method, $progress->{state}, @r);
66}
67
68sub sizer_class
69{
70	"ProgressSizer"
71}
72
73sub visit_with_count
74{
75	my ($progress, $plist, $method, @r) = @_;
76	$plist->{total} //= $progress->compute_count($plist);
77	my $count = 0;
78	$progress->show($count, $plist->{total});
79	$plist->count_and($progress, \$count, $plist->{total},
80	    $method, $progress->{state}, @r);
81}
82
83package OpenBSD::ProgressMeter::Term;
84our @ISA = qw(OpenBSD::ProgressMeter::Real);
85use POSIX;
86use Term::Cap;
87
88sub width
89{
90	my $self = shift;
91	return $self->{state}->width;
92}
93
94sub forked
95{
96	my $self = shift;
97	$self->{lastdisplay} = ' 'x($self->width-1);
98}
99
100sub init
101{
102	my $self = shift;
103	my $oldfh = select(STDOUT);
104	$| = 1;
105	select($oldfh);
106	$self->{lastdisplay} = '';
107	$self->{continued} = 0;
108	$self->{work} = 0;
109	$self->{header} = '';
110	return unless defined $ENV{TERM} || defined $ENV{TERMCAP};
111	my $termios = POSIX::Termios->new;
112	$termios->getattr(0);
113	my $terminal = Term::Cap->Tgetent({ OSPEED =>
114	    $termios->getospeed});
115	$self->{glitch} = $terminal->{_xn};
116	$self->{cleareol} = $terminal->Tputs("ce", 1);
117	$self->{hpa} = $terminal->Tputs("ch", 1);
118	if (!defined $self->{hpa}) {
119		# XXX this works with screen and tmux
120		$self->{cuf} = $terminal->Tputs("RI", 1);
121		if (defined $self->{cuf}) {
122			$self->{hpa} = "\r".$self->{cuf};
123		}
124	}
125}
126
127sub compute_playfield
128{
129	my ($self, $cont) = @_;
130	$self->{playfield} = $self->width - length($self->{header}) - 7;
131	if ($self->{playfield} < 5) {
132		$self->{playfield} = 0;
133	}
134	if ($cont) {
135		$self->{continued} = 1;
136	}
137}
138
139sub set_header
140{
141	my ($self, $header) = @_;
142	$self->{header} = $header;
143	$self->compute_playfield;
144	return 1;
145}
146
147sub hmove
148{
149	my ($self, $v) = @_;
150	my $seq = $self->{hpa};
151	$seq =~ s/\%i// and $v++;
152	$seq =~ s/\%n// and $v ^= 0140;
153	$seq =~ s/\%B// and $v = 16 * ($v/10) + $v%10;
154	$seq =~ s/\%D// and $v = $v - 2*($v%16);
155	$seq =~ s/\%\./sprintf('%c', $v)/e;
156	$seq =~ s/\%d/sprintf('%d', $v)/e;
157	$seq =~ s/\%2/sprintf('%2d', $v)/e;
158	$seq =~ s/\%3/sprintf('%3d', $v)/e;
159	$seq =~ s/\%\+(.)/sprintf('%c', $v+ord($1))/e;
160	$seq =~ s/\%\%/\%/g;
161	return $seq;
162}
163
164sub _show
165{
166	my ($self, $extra, $stars) = @_;
167	my $d = $self->{header};
168	my $prefix = length($d);
169	if (defined $extra) {
170		$d.="|$extra";
171		$prefix++;
172	}
173	if ($self->width > length($d)) {
174		if ($self->{cleareol}) {
175			$d .= $self->{cleareol};
176		} else {
177			$d .= ' 'x($self->width - length($d) - 1);
178		}
179	}
180
181	if ($self->{continued}) {
182		print "\r$d";
183		$self->{continued} = 0;
184		$self->{lastdisplay} = $d;
185		return;
186	}
187
188	return if $d eq $self->{lastdisplay};
189
190
191	if (defined $self->{hpa}) {
192		if (defined $stars && defined $self->{stars}) {
193			$prefix += $self->{stars};
194		}
195	}
196	if (defined $self->{hpa} && substr($self->{lastdisplay}, 0, $prefix) eq
197	    substr($d, 0, $prefix)) {
198		print $self->hmove($prefix), substr($d, $prefix);
199	} else {
200		print "\r$d";
201	}
202	$self->{lastdisplay} = $d;
203}
204
205sub message
206{
207	my ($self, $message) = @_;
208	if ($self->{cleareol}) {
209		$message .= $self->{cleareol};
210	} elsif ($self->{playfield} > length($message)) {
211		$message .= ' 'x($self->{playfield} - length($message));
212	}
213	if ($self->{playfield}) {
214		$self->_show(substr($message, 0, $self->{playfield}));
215	} else {
216		$self->_show;
217	}
218}
219
220sub show
221{
222	my ($self, $current, $total) = @_;
223
224	if ($self->{playfield}) {
225		my $stars = int (($current * $self->{playfield}) / $total + 0.5);
226		my $percent = int (($current * 100)/$total + 0.5);
227		if ($percent < 100) {
228			$self->_show('*'x$stars.' 'x($self->{playfield}-$stars)."| ".$percent."\%", $stars);
229		} else {
230			$self->_show('*'x$self->{playfield}."|100\%", $stars);
231		}
232		$self->{stars} = $stars;
233	} else {
234	    	$self->_show;
235	}
236}
237
238sub working
239{
240	my ($self, $slowdown) = @_;
241	$self->{work}++;
242	return if $self->{work} < $slowdown;
243	$self->message(substr("/-\\|", ($self->{work}/$slowdown) % 4, 1));
244}
245
246sub clear
247{
248	my $self = shift;
249	return unless length($self->{lastdisplay}) > 0;
250	if ($self->{cleareol}) {
251		print "\r", $self->{cleareol};
252	} else {
253		print "\r", ' 'x length($self->{lastdisplay}), "\r";
254	}
255	$self->{lastdisplay} = '';
256	delete $self->{stars};
257}
258
259sub disable
260{
261	my $self = shift;
262	print "\n" if length($self->{lastdisplay}) > 0;
263
264	bless $self, "OpenBSD::ProgressMeter::Stub";
265}
266
267sub next
268{
269	my ($self, $todo) = @_;
270	$self->clear;
271
272	$todo //= 'ok';
273	print "\r$self->{header}: $todo\n";
274}
275
276package ProgressSizer;
277our @ISA = qw(PureSizer);
278
279sub new
280{
281	my ($class, $progress, $plist) = @_;
282	my $p = $class->SUPER::new($progress, $plist);
283	$progress->show(0, $p->{totsize});
284	if (defined $progress->{state}{archive}) {
285		$progress->{state}{archive}->set_callback(
286		    sub {
287			my $done = shift;
288			$progress->show($p->{donesize} + $done, $p->{totsize});
289		});
290	}
291	return $p;
292}
293
294sub advance
295{
296	my ($self, $e) = @_;
297	if (defined $e->{size}) {
298		$self->{donesize} += $e->{size};
299		$self->{progress}->show($self->{donesize}, $self->{totsize});
300	}
301}
302
3031;
304