1package IO::Pager::Unbuffered; 2our $VERSION = 1.04; #Untouched since 1.02 3 4use strict; 5use warnings; 6use base qw( IO::Pager ); 7use SelectSaver; 8 9 10sub new(;$) { # [FH], procedural 11 my($class, $tied_fh); 12 13 eval { ($class, $tied_fh) = &IO::Pager::_init }; 14 #We're not on a TTY so... 15 if( defined($class) && $class eq '0' or $@ =~ '!TTY' ){ 16 #...leave filehandle alone if procedural 17 return $_[1] if defined($_[2]) && $_[2] eq 'procedural'; 18 19 #...fall back to IO::Handle for transparent OO programming 20 eval "require IO::Handle" or die $@; 21 return IO::Handle->new_from_fd(fileno($_[1]), 'w'); 22 } 23 $!=$@, return 0 if $@ =~ 'pipe'; 24 25 my $self = tie *$tied_fh, $class, $tied_fh or return 0; 26 { # Truly unbuffered 27 my $saver = SelectSaver->new($self->{real_fh}); 28 $|=1; 29 } 30 return $self; 31} 32 33#Punt to base, preserving FH ($_[0]) for pass by reference to gensym 34sub open(;$) { # [FH] 35# IO::Pager::open($_[0], 'IO::Pager::Unbuffered'); 36 &new('IO::Pager::procedural', $_[0], 'procedural'); 37} 38 39 401; 41 42__END__ 43 44=pod 45 46=head1 NAME 47 48IO::Pager::Unbuffered - Pipe output to PAGER if destination is a TTY 49 50=head1 SYNOPSIS 51 52 use IO::Pager::Unbuffered; 53 { 54 local $STDOUT = IO::Pager::Unbuffered::open *STDOUT; 55 print <<" HEREDOC" ; 56 ... 57 A bunch of text later 58 HEREDOC 59 } 60 61 { 62 # You can also use scalar filehandles... 63 my $token = IO::Pager::Unbuffered::open($FH) or warn($!); 64 print $FH "No globs or barewords for us thanks!\n" while 1; 65 } 66 67 { 68 # ...or an object interface 69 my $token = new IO::Pager::Unbuffered; 70 71 $token->print("OO shiny...\n") while 1; 72 } 73 74=head1 DESCRIPTION 75 76IO::Pager subclasses are designed to programmatically decide whether 77or not to pipe a filehandle's output to a program specified in I<PAGER>; 78determined and set by IO::Pager at runtime if not yet defined. 79 80See L<IO::Pager> for method details. 81 82=head1 METHODS 83 84All methods are inherited from IO::Pager; except for instantiation. 85 86=head1 CAVEATS 87 88You probably want to do something with SIGPIPE eg; 89 90 eval { 91 local $SIG{PIPE} = sub { die }; 92 local $STDOUT = IO::Pager::open(*STDOUT); 93 94 while (1) { 95 # Do something 96 } 97 } 98 99 # Do something else 100 101=head1 SEE ALSO 102 103L<IO::Pager>, L<IO::Pager::Buffered>, L<IO::Pager::Page>, 104 105=head1 AUTHOR 106 107Jerrad Pierce <jpierce@cpan.org> 108 109Florent Angly <florent.angly@gmail.com> 110 111This module was inspired by Monte Mitzelfelt's IO::Page 0.02 112 113Significant proddage provided by Tye McQueen. 114 115=head1 COPYRIGHT AND LICENSE 116 117Copyright (C) 2003-2018 Jerrad Pierce 118 119=over 120 121=item * Thou shalt not claim ownership of unmodified materials. 122 123=item * Thou shalt not claim whole ownership of modified materials. 124 125=item * Thou shalt grant the indemnity of the provider of materials. 126 127=item * Thou shalt use and dispense freely without other restrictions. 128 129=back 130 131Or, if you prefer: 132 133This library is free software; you can redistribute it and/or modify 134it under the same terms as Perl itself, either Perl version 5.0 or, 135at your option, any later version of Perl 5 you may have available. 136 137=cut 138