File Coverage

blib/lib/Tie/Filehandle/Preempt/Stdin.pm
Criterion Covered Total %
statement 13 13 100.0
branch 2 2 100.0
condition n/a
subroutine 4 4 100.0
pod n/a
total 19 19 100.0


line stmt bran cond sub pod time code
1             package Tie::Filehandle::Preempt::Stdin;
2             $VERSION = "0.02";
3             require 5.008;
4 1     1   75495 use strict;
  1         4  
  1         38  
5 1     1   7 use Carp;
  1         3  
  1         218  
6              
7             sub TIEHANDLE {
8 3     3   2116 my $class = shift;
9 3         10 my @lines = @_;
10 3         16 bless \@lines, $class;
11             }
12              
13             sub READLINE {
14 9     9   2347 my $self = shift;
15 9 100       27 if (@$self) {
16 8         26 shift @$self;
17             } else {
18 1         232 croak "List of prompt responses has been exhausted: $!";
19             }
20             }
21              
22             1;
23              
24             ##### DOCUMENTATION #####
25              
26             =head1 NAME
27              
28             Tie::Filehandle::Preempt::Stdin - Preempt STDIN during testing.
29              
30             =head1 SYNOPSIS
31              
32             use Tie::Filehandle::Preempt::Stdin;
33             @prompts = qw| alpha beta gamma |;
34             $object = tie *STDIN, 'Tie::Filehandle::Preempt::Stdin', @prompts;
35              
36             =head1 DESCRIPTION
37              
38             Suppose a program requires manual input from the keyboard operator.
39             How do we test that we have properly handled operator input? More
40             specifically, how do we incorporate testing for user input in files
41             built on Perl's standard testing apparatus (C,
42             C, etc.)?
43              
44             Tie::Filehandle::Preempt::Stdin offers one way to do it -- a relatively
45             simple and unsophisticated todo it. The most difficult part is
46             analyzing the program to be tested so that you recognize all the points
47             at which input is needed via STDIN. This in turn requires an
48             understanding of all the different branches your program flow can take
49             in response to standard input. Once you know that, you construct a list
50             of dummy data that will be fed to each test at the points the program,
51             when put into production, would normally prompt for operator input.
52             This list of dummy data 'pre-empts' standard input via a tie of
53             filehandle STDIN; hence, the module's name.
54              
55             =head1 USAGE
56              
57             @prompts = qw| alpha beta gamma |;
58             $object = tie *STDIN, 'Tie::Filehandle::Preempt::Stdin', @prompts;
59              
60             print "Enter item 1: ";
61             chomp($entry = );
62             # 'alpha' is supplied in lieu of standard input;
63             # do something with $entry
64              
65             print "Enter item 2: ";
66             chomp($entry = );
67             # 'beta' is supplied in lieu of standard input;
68             # do something with $entry
69              
70             print "Enter item 3: ";
71             chomp($entry = );
72             # 'gamma' is supplied in lieu of standard input;
73             # do something with $entry
74              
75             Should the number of elements in C<@prompts> be less than the number of
76             points at which a given test prompts for operator input, you will get an
77             error message:
78              
79             "List of prompt responses has been exhausted"
80              
81             and the program will C.
82              
83             =head1 BUGS
84              
85             Tie::Filehandle::Preempt::Stdin does not work properly when the source
86             code being tested uses only the Perl diamond operator for standard input.
87              
88             print "Enter room whose data you wish to enter: ";
89             chomp ($try = <>);
90              
91             This doesn't work; your program will hang. You have to hard-code
92             C instead.
93              
94             chomp ($try = );
95              
96             I don't know why this happens. If this bothers you, look at
97             C which is reported to handle the diamond operator properly,
98             but which, IMHO, has a more complex interface.
99              
100             =head1 SUPPORT
101              
102             Contact author or post on perl.qa@perl.org.
103              
104             =head1 AUTHOR
105              
106             James E Keenan. CPAN ID: JKEENAN. Mail to: jkeenan [at] cpan [dot] org.
107              
108             =head1 ACKNOWLEDGEMENTS
109              
110             The author benefitted from -- but did not always agree with -- comments
111             from the following members of Perlmonks: chromatic, Revelation,
112             tmoertel, NiJo and dragonchild.
113              
114             Thanks to Michael G Schwern and Kevin Scaldeferri for answering
115             questions on the perl.qa mailing list.
116              
117             =head1 COPYRIGHT
118              
119             Copyright 2005 James E Keenan.
120             This program is free software; you can redistribute
121             it and/or modify it under the same terms as Perl itself.
122              
123             The full text of the license can be found in the
124             LICENSE file included with this module.
125              
126             Last revision: October 27 2007.
127              
128             =head1 SEE ALSO
129              
130             perltie(1).
131              
132             I (3rd ed.), Larry Wall, Tom Christiansen
133             and Jon Orwant. O'Reilly & Associates, 1991. Chapter 14: Tied
134             Variables: section on ''Tying Filehandles,'' p. 384 ff.
135              
136             Perlmonks discussion starting at:
137             L.
138              
139             Postings on perl.qa at:
140             L and
141             L.
142              
143             =cut