1# ex:ts=8 sw=4:
2# $OpenBSD: Term.pm,v 1.45 2023/10/18 08:50:13 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 v5.36;
18use warnings;
19
20package OpenBSD::PackingElement;
21sub size_and($self, $p, $method, @r)
22{
23	$p->advance($self);
24	$self->$method(@r);
25}
26
27sub compute_count($self, $count)
28{
29	$$count++;
30}
31
32sub count_and($self, $progress, $done, $total, $method, @r)
33{
34	$$done ++;
35	$progress->show($$done, $total);
36	$self->$method(@r);
37}
38
39package OpenBSD::ProgressMeter::Real;
40our @ISA = qw(OpenBSD::ProgressMeter);
41
42sub ntogo($self, $state, $offset = 0)
43{
44	return $state->ntodo($offset);
45}
46
47sub compute_count($progress, $plist)
48{
49	my $total = 0;
50	$plist->compute_count(\$total);
51	$total = 1 if $total == 0;
52	return $total;
53}
54
55sub visit_with_size($progress, $plist, $method, @r)
56{
57	my $p = $progress->new_sizer($plist);
58	$plist->size_and($p, $method, $progress->{state}, @r);
59}
60
61sub sizer_class($)
62{
63	"ProgressSizer"
64}
65
66sub visit_with_count($progress, $plist, $method, @r)
67{
68	$plist->{total} //= $progress->compute_count($plist);
69	my $count = 0;
70	$progress->show($count, $plist->{total});
71	$plist->count_and($progress, \$count, $plist->{total},
72	    $method, $progress->{state}, @r);
73}
74
75package OpenBSD::ProgressMeter::Term;
76our @ISA = qw(OpenBSD::ProgressMeter::Real);
77use POSIX;
78use Term::Cap;
79
80sub width($self)
81{
82	return $self->{state}->width;
83}
84
85sub forked($self)
86{
87	$self->{lastdisplay} = ' 'x($self->width-1);
88}
89
90sub init($self)
91{
92	my $oldfh = select(STDOUT);
93	$| = 1;
94	select($oldfh);
95	$self->{lastdisplay} = '';
96	$self->{continued} = 0;
97	$self->{work} = 0;
98	$self->{header} = '';
99	return unless defined $ENV{TERM} || defined $ENV{TERMCAP};
100	my $termios = POSIX::Termios->new;
101	$termios->getattr(0);
102	my $terminal;
103	eval {
104		$terminal =
105		    Term::Cap->Tgetent({ OSPEED => $termios->getospeed});
106	};
107	if ($@) {
108		chomp $@;
109		$@ =~ s/\s+at\s+\/.*\s+line\s+.*//;
110		$self->{state}->errsay("No progress meter: #1", $@);
111		bless $self, "OpenBSD::ProgressMeter::Stub";
112		return;
113	}
114	$self->{glitch} = $terminal->{_xn};
115	$self->{cleareol} = $terminal->Tputs("ce", 1);
116	$self->{hpa} = $terminal->Tputs("ch", 1);
117	if (!defined $self->{hpa}) {
118		# XXX this works with screen and tmux
119		$self->{cuf} = $terminal->Tputs("RI", 1);
120		if (defined $self->{cuf}) {
121			$self->{hpa} = "\r".$self->{cuf};
122		}
123	}
124}
125
126sub compute_playfield($self)
127{
128	$self->{playfield} = $self->width - length($self->{header}) - 7;
129	if ($self->{playfield} < 5) {
130		$self->{playfield} = 0;
131	}
132}
133
134sub set_header($self, $header)
135{
136	$self->{header} = $header;
137	$self->compute_playfield;
138	return 1;
139}
140
141sub hmove($self, $v)
142{
143	my $seq = $self->{hpa};
144	$seq =~ s/\%i// and $v++;
145	$seq =~ s/\%n// and $v ^= 0140;
146	$seq =~ s/\%B// and $v = 16 * ($v/10) + $v%10;
147	$seq =~ s/\%D// and $v = $v - 2*($v%16);
148	$seq =~ s/\%\./sprintf('%c', $v)/e;
149	$seq =~ s/\%d/sprintf('%d', $v)/e;
150	$seq =~ s/\%2/sprintf('%2d', $v)/e;
151	$seq =~ s/\%3/sprintf('%3d', $v)/e;
152	$seq =~ s/\%\+(.)/sprintf('%c', $v+ord($1))/e;
153	$seq =~ s/\%\%/\%/g;
154	return $seq;
155}
156
157sub _show($self, $extra = undef, $stars = undef)
158{
159	my $d = $self->{header};
160	my $prefix = length($d);
161	if (defined $extra) {
162		$d.="|$extra";
163		$prefix++;
164	}
165	if ($self->width > length($d)) {
166		if ($self->{cleareol}) {
167			$d .= $self->{cleareol};
168		} else {
169			$d .= ' 'x($self->width - length($d) - 1);
170		}
171	}
172
173	if ($self->{continued}) {
174		print "\r$d";
175		$self->{continued} = 0;
176		$self->{lastdisplay} = $d;
177		return;
178	}
179
180	return if $d eq $self->{lastdisplay};
181
182
183	if (defined $self->{hpa}) {
184		if (defined $stars && defined $self->{stars}) {
185			$prefix += $self->{stars};
186		}
187	}
188	if (defined $self->{hpa} && substr($self->{lastdisplay}, 0, $prefix) eq
189	    substr($d, 0, $prefix)) {
190		print $self->hmove($prefix), substr($d, $prefix);
191	} else {
192		print "\r$d";
193	}
194	$self->{lastdisplay} = $d;
195}
196
197sub message($self, $message)
198{
199	return unless $self->can_output;
200	if ($self->{cleareol}) {
201		$message .= $self->{cleareol};
202	} elsif ($self->{playfield} > length($message)) {
203		$message .= ' 'x($self->{playfield} - length($message));
204	}
205	if ($self->{playfield}) {
206		$self->_show(substr($message, 0, $self->{playfield}));
207	} else {
208		$self->_show;
209	}
210}
211
212sub show($self, $current, $total)
213{
214	return unless $self->can_output;
215
216	if ($self->{playfield}) {
217		my $stars = int (($current * $self->{playfield}) / $total + 0.5);
218		my $percent = int (($current * 100)/$total + 0.5);
219		if ($percent < 100) {
220			$self->_show('*'x$stars.' 'x($self->{playfield}-$stars)."| ".$percent."\%", $stars);
221		} else {
222			$self->_show('*'x$self->{playfield}."|100\%", $stars);
223		}
224		$self->{stars} = $stars;
225	} else {
226	    	$self->_show;
227	}
228}
229
230sub working($self, $slowdown)
231{
232	$self->{work}++;
233	return if $self->{work} < $slowdown;
234	$self->message(substr("/-\\|", ($self->{work}/$slowdown) % 4, 1));
235}
236
237sub clear($self)
238{
239	return unless length($self->{lastdisplay}) > 0;
240	if ($self->can_output) {
241		if ($self->{cleareol}) {
242			print "\r", $self->{cleareol};
243		} else {
244			print "\r", ' 'x length($self->{lastdisplay}), "\r";
245		}
246	}
247	$self->{lastdisplay} = '';
248	delete $self->{stars};
249}
250
251sub disable($self)
252{
253	print "\n" if length($self->{lastdisplay}) > 0 and $self->can_output;
254
255	bless $self, "OpenBSD::ProgressMeter::Stub";
256}
257
258sub next($self, $todo = 'ok')
259{
260	$self->clear;
261
262	$todo //= 'ok';
263	print "\r$self->{header}: $todo\n" if $self->can_output;
264}
265
266package ProgressSizer;
267our @ISA = qw(PureSizer);
268
269sub new($class, $progress, $plist)
270{
271	my $p = $class->SUPER::new($progress, $plist);
272	$progress->show(0, $p->{totsize});
273	if (defined $progress->{state}{archive}) {
274		$progress->{state}{archive}->set_callback(
275		    sub($done) {
276			$progress->show($p->{donesize} + $done, $p->{totsize});
277		});
278	}
279	return $p;
280}
281
282sub advance($self, $e)
283{
284	if (defined $e->{size}) {
285		$self->{donesize} += $e->{size};
286		$self->{progress}->show($self->{donesize}, $self->{totsize});
287	}
288}
289
2901;
291