Commit | Line | Data |
4f08f5ad |
1 | package Term::UI::History; |
2 | |
3 | use strict; |
4 | use base 'Exporter'; |
5 | use base 'Log::Message::Simple'; |
6 | |
7 | =pod |
8 | |
9 | =head1 NAME |
10 | |
ce5e090c |
11 | Term::UI::History |
4f08f5ad |
12 | |
13 | =head1 SYNOPSIS |
14 | |
15 | use Term::UI::History qw[history]; |
16 | |
17 | history("Some message"); |
18 | |
19 | ### retrieve the history in printable form |
20 | $hist = Term::UI::History->history_as_string; |
21 | |
22 | ### redirect output |
23 | local $Term::UI::History::HISTORY_FH = \*STDERR; |
24 | |
25 | =head1 DESCRIPTION |
26 | |
27 | This module provides the C<history> function for C<Term::UI>, |
28 | printing and saving all the C<UI> interaction. |
29 | |
30 | Refer to the C<Term::UI> manpage for details on usage from |
31 | C<Term::UI>. |
32 | |
33 | This module subclasses C<Log::Message::Simple>. Refer to its |
34 | manpage for additional functionality available via this package. |
35 | |
36 | =head1 FUNCTIONS |
37 | |
38 | =head2 history("message string" [,VERBOSE]) |
39 | |
40 | Records a message on the stack, and prints it to C<STDOUT> |
41 | (or actually C<$HISTORY_FH>, see the C<GLOBAL VARIABLES> section |
42 | below), if the C<VERBOSE> option is true. |
43 | |
44 | The C<VERBOSE> option defaults to true. |
45 | |
46 | =cut |
47 | |
48 | BEGIN { |
49 | use Log::Message private => 0; |
50 | |
51 | use vars qw[ @EXPORT $HISTORY_FH ]; |
52 | @EXPORT = qw[ history ]; |
53 | my $log = new Log::Message; |
54 | $HISTORY_FH = \*STDOUT; |
55 | |
56 | for my $func ( @EXPORT ) { |
57 | no strict 'refs'; |
58 | |
59 | *$func = sub { my $msg = shift; |
60 | $log->store( |
61 | message => $msg, |
62 | tag => uc $func, |
63 | level => $func, |
64 | extra => [@_] |
65 | ); |
66 | }; |
67 | } |
68 | |
69 | sub history_as_string { |
70 | my $class = shift; |
71 | |
72 | return join $/, map { $_->message } __PACKAGE__->stack; |
73 | } |
74 | } |
75 | |
76 | |
77 | { package Log::Message::Handlers; |
78 | |
79 | sub history { |
80 | my $self = shift; |
81 | my $verbose = shift; |
82 | $verbose = 1 unless defined $verbose; # default to true |
83 | |
84 | ### so you don't want us to print the msg? ### |
85 | return if defined $verbose && $verbose == 0; |
86 | |
87 | local $| = 1; |
88 | my $old_fh = select $Term::UI::History::HISTORY_FH; |
89 | |
90 | print $self->message . "\n"; |
91 | select $old_fh; |
92 | |
93 | return; |
94 | } |
95 | } |
96 | |
97 | |
98 | =head1 GLOBAL VARIABLES |
99 | |
100 | =over 4 |
101 | |
102 | =item $HISTORY_FH |
103 | |
104 | This is the filehandle all the messages sent to C<history()> are being |
105 | printed. This defaults to C<*STDOUT>. |
106 | |
107 | =back |
108 | |
109 | =head1 See Also |
110 | |
111 | C<Log::Message::Simple>, C<Term::UI> |
112 | |
113 | =head1 AUTHOR |
114 | |
115 | This module by |
116 | Jos Boumans E<lt>kane@cpan.orgE<gt>. |
117 | |
118 | =head1 COPYRIGHT |
119 | |
120 | This module is |
121 | copyright (c) 2005 Jos Boumans E<lt>kane@cpan.orgE<gt>. |
122 | All rights reserved. |
123 | |
124 | This library is free software; |
125 | you may redistribute and/or modify it under the same |
126 | terms as Perl itself. |
127 | |
128 | =cut |
129 | |
130 | 1; |
131 | |
132 | # Local variables: |
133 | # c-indentation-style: bsd |
134 | # c-basic-offset: 4 |
135 | # indent-tabs-mode: nil |
136 | # End: |
137 | # vim: expandtab shiftwidth=4: |