File Coverage

lib/Term/UI/History.pm
Criterion Covered Total %
statement 40 40 100.0
branch 4 4 100.0
condition 2 3 66.6
subroutine 11 11 100.0
pod 0 2 0.0
total 57 60 95.0


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