Initial Commit

database/perl/vendor/lib/Term/UI/History.pm

@@ -0,0 +1,142 @@
+package Term::UI::History;
+
+use strict;
+use vars qw[$VERSION];
+use base 'Exporter';
+use base 'Log::Message::Simple';
+
+$VERSION = '0.46';
+
+=pod
+
+=head1 NAME
+
+Term::UI::History - history function
+
+=head1 SYNOPSIS
+
+    use Term::UI::History qw[history];
+
+    history("Some message");
+
+    ### retrieve the history in printable form
+    $hist  = Term::UI::History->history_as_string;
+
+    ### redirect output
+    local $Term::UI::History::HISTORY_FH = \*STDERR;
+
+=head1 DESCRIPTION
+
+This module provides the C<history> function for C<Term::UI>,
+printing and saving all the C<UI> interaction.
+
+Refer to the C<Term::UI> manpage for details on usage from
+C<Term::UI>.
+
+This module subclasses C<Log::Message::Simple>. Refer to its
+manpage for additional functionality available via this package.
+
+=head1 FUNCTIONS
+
+=head2 history("message string" [,VERBOSE])
+
+Records a message on the stack, and prints it to C<STDOUT>
+(or actually C<$HISTORY_FH>, see the C<GLOBAL VARIABLES> section
+below), if the C<VERBOSE> option is true.
+
+The C<VERBOSE> option defaults to true.
+
+=cut
+
+BEGIN {
+    use Log::Message private => 0;
+
+    use vars      qw[ @EXPORT $HISTORY_FH ];
+    @EXPORT     = qw[ history ];
+    my $log     = new Log::Message;
+    $HISTORY_FH = \*STDOUT;
+
+    for my $func ( @EXPORT ) {
+        no strict 'refs';
+
+        *$func = sub {  my $msg     = shift;
+                        $log->store(
+                                message => $msg,
+                                tag     => uc $func,
+                                level   => $func,
+                                extra   => [@_]
+                        );
+                };
+    }
+
+    sub history_as_string {
+        my $class = shift;
+
+        return join $/, map { $_->message } __PACKAGE__->stack;
+    }
+}
+
+
+{
+    package # hide this from PAUSE
+      Log::Message::Handlers;
+
+    sub history {
+        my $self    = shift;
+        my $verbose = shift;
+           $verbose = 1 unless defined $verbose;    # default to true
+
+        ### so you don't want us to print the msg? ###
+        return if defined $verbose && $verbose == 0;
+
+        local $| = 1;
+        my $old_fh = select $Term::UI::History::HISTORY_FH;
+
+        print $self->message . "\n";
+        select $old_fh;
+
+        return;
+    }
+}
+
+
+=head1 GLOBAL VARIABLES
+
+=over 4
+
+=item $HISTORY_FH
+
+This is the filehandle all the messages sent to C<history()> are being
+printed. This defaults to C<*STDOUT>.
+
+=back
+
+=head1 See Also
+
+C<Log::Message::Simple>, C<Term::UI>
+
+=head1 AUTHOR
+
+This module by
+Jos Boumans E<lt>kane@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+This module is
+copyright (c) 2005 Jos Boumans E<lt>kane@cpan.orgE<gt>.
+All rights reserved.
+
+This library is free software;
+you may redistribute and/or modify it under the same
+terms as Perl itself.
+
+=cut
+
+1;
+
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4: