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