lib/Term/UI/History.pm

   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
  11 Log::Message::Simple
  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: