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
162
163
164
165
166
167
168
169
170
|
package App::Info::Handler::Prompt;
# $Id: Prompt.pm,v 1.3 2005/01/08 07:18:58 theory Exp $
=head1 NAME
App::Info::Handler::Prompt - Prompting App::Info event handler
=head1 SYNOPSIS
use App::Info::Category::FooApp;
use App::Info::Handler::Print;
my $prompter = App::Info::Handler::Print->new;
my $app = App::Info::Category::FooApp->new( on_unknown => $prompter );
# Or...
my $app = App::Info::Category::FooApp->new( on_confirm => 'prompt' );
=head1 DESCRIPTION
App::Info::Handler::Prompt objects handle App::Info events by printing their
messages to C<STDOUT> and then accepting a new value from C<STDIN>. The new
value is validated by any callback supplied by the App::Info concrete subclass
that triggered the event. If the value is valid, App::Info::Handler::Prompt
assigns the new value to the event request. If it isn't it prints the error
message associated with the event request, and then prompts for the data
again.
Although designed with unknown and confirm events in mind,
App::Info::Handler::Prompt handles info and error events as well. It will
simply print info event messages to C<STDOUT> and print error event messages
to C<STDERR>. For more interesting info and error event handling, see
L<App::Info::Handler::Print|App::Info::Handler::Print> and
L<App::Info::Handler::Carp|App::Info::Handler::Carp>.
Upon loading, App::Info::Handler::Print registers itself with
App::Info::Handler, setting up a single string, "prompt", that can be passed
to an App::Info concrete subclass constructor. This string is a shortcut that
tells App::Info how to create an App::Info::Handler::Print object for handling
events.
=cut
use strict;
use App::Info::Handler;
use vars qw($VERSION @ISA);
$VERSION = '0.45';
@ISA = qw(App::Info::Handler);
# Register ourselves.
App::Info::Handler->register_handler
('prompt' => sub { __PACKAGE__->new } );
=head1 INTERFACE
=head2 Constructor
=head3 new
my $prompter = App::Info::Handler::Prompt->new;
Constructs a new App::Info::Handler::Prompt object and returns it. No special
arguments are required.
=cut
sub new {
my $pkg = shift;
my $self = $pkg->SUPER::new(@_);
$self->{tty} = -t STDIN && ( -t STDOUT || !( -f STDOUT || -c STDOUT ) );
# We're done!
return $self;
}
my $get_ans = sub {
my ($prompt, $tty, $def) = @_;
# Print the message.
local $| = 1;
local $\;
print $prompt;
# Collect the answer.
my $ans;
if ($tty) {
$ans = <STDIN>;
if (defined $ans ) {
chomp $ans;
} else { # user hit ctrl-D
print "\n";
}
} else {
print "$def\n" if defined $def;
}
return $ans;
};
sub handler {
my ($self, $req) = @_;
my $ans;
my $type = $req->type;
if ($type eq 'unknown' || $type eq 'confirm') {
# We'll want to prompt for a new value.
my $val = $req->value;
my ($def, $dispdef) = defined $val ? ($val, " [$val] ") : ('', ' ');
my $msg = $req->message or Carp::croak("No message in request");
$msg .= $dispdef;
# Get the answer.
$ans = $get_ans->($msg, $self->{tty}, $def);
# Just return if they entered an empty string or we couldnt' get an
# answer.
return 1 unless defined $ans && $ans ne '';
# Validate the answer.
my $err = $req->error;
while (!$req->value($ans)) {
print "$err: '$ans'\n";
$ans = $get_ans->($msg, $self->{tty}, $def);
return 1 unless defined $ans && $ans ne '';
}
} elsif ($type eq 'info') {
# Just print the message.
print STDOUT $req->message, "\n";
} elsif ($type eq 'error') {
# Just print the message.
print STDERR $req->message, "\n";
} else {
# This shouldn't happen.
Carp::croak("Invalid request type '$type'");
}
# Return true to indicate that we've handled the request.
return 1;
}
1;
__END__
=head1 BUGS
Please send bug reports to <bug-app-info@rt.cpan.org> or file them at
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
=head1 AUTHOR
David Wheeler <david@justatheory.com>
=head1 SEE ALSO
L<App::Info|App::Info> documents the event handling interface.
L<App::Info::Handler::Carp|App::Info::Handler::Carp> handles events by
passing their messages Carp module functions.
L<App::Info::Handler::Print|App::Info::Handler::Print> handles events by
printing their messages to a file handle.
L<App::Info::Handler|App::Info::Handler> describes how to implement custom
App::Info event handlers.
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2002-2004, David Wheeler. All Rights Reserved.
This module is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.
=cut
|
