1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
#!/usr/bin/perl -w
=head1 NAME
Debconf::FrontEnd::Teletype - FrontEnd for any teletype
=cut
package Debconf::FrontEnd::Teletype;
use strict;
use Debconf::Encoding qw(width wrap);
use Debconf::Gettext;
use Debconf::Config;
use base qw(Debconf::FrontEnd::ScreenSize);
=head1 DESCRIPTION
This is a very basic frontend that should work on any terminal, from a real
teletype on up. It also serves as the parent for the Readline frontend.
=head1 FIELDS
=over 4
=item linecount
How many lines have been displayed since the last pause.
=back
=head1 METHODS
=over 4
=cut
sub init {
my $this=shift;
$this->SUPER::init(@_);
$this->interactive(1);
$this->linecount(0);
}
=item display
Displays text wrapped to fit on the screen. If too much text is displayed at
once, it will page it. If a title has been set and has not yet been displayed,
displays it first.
The important flag, if set, will make it always be shown. If unset, the
text will not be shown in terse mode,
=cut
sub display {
my $this=shift;
my $text=shift;
$Debconf::Encoding::columns=$this->screenwidth;
$this->display_nowrap(wrap('','',$text));
}
=item display_nowrap
Display text, paging if necessary. If a title has been set and has not
yet been displayed, displays it first.
=cut
sub display_nowrap {
my $this=shift;
my $text=shift;
# Terse mode skips all this stuff.
return if Debconf::Config->terse eq 'true';
# Silly split elides trailing null matches.
my @lines=split(/\n/, $text);
push @lines, "" if $text=~/\n$/;
# Add to the display any pending title.
my $title=$this->title;
if (length $title) {
unshift @lines, $title, ('-' x width $title), '';
$this->title('');
}
foreach (@lines) {
# If we had to guess at the screenheight, don't bother
# ever pausing; for all I know this is some real teletype
# with an infinite height "screen" of fan-fold paper..
if (! $this->screenheight_guessed &&
$this->linecount($this->linecount+1) > $this->screenheight - 2) {
$this->prompt(
prompt => '['.gettext("More").']',
default => '',
completions => [],
);
}
print "$_\n";
}
}
=item prompt
Prompts the user for input, and returns it. If a title is pending,
it will be displayed before the prompt.
This function will return undef if the user opts to skip the question
(by backing up or moving on to the next question). Anything that uses this
function should catch that and handle it, probably by exiting any
read/validate loop it is in.
The function uses named parameters.
=cut
sub prompt {
my $this=shift;
my %params=@_;
$this->linecount(0);
local $|=1;
print "$params{prompt} ";
chomp(my $ret=<STDIN>);
$this->display_nowrap("\n");
return $ret;
}
=item prompt_password
Safely prompts for a password; arguments are the same as for prompt.
=cut
sub prompt_password {
my $this=shift;
my %params=@_;
# Kill default: not a good idea for passwords.
delete $params{default};
# Force echoing off.
system('stty -echo 2>/dev/null');
# Always use this class's version of prompt here, not whatever
# children put in its place. Only this one is guarenteed to not
# echo, and work properly for password prompting.
my $ret=$this->Debconf::FrontEnd::Teletype::prompt(%params);
system('stty sane 2>/dev/null');
return $ret;
}
=back
=head1 AUTHOR
Joey Hess <joeyh@debian.org>
=cut
1
|
