package Preempt::Stdin;
use strict;
use Carp;

sub TIEHANDLE {
    my $class = shift;
    my @lines = @_;
    bless \@lines, $class;
}

sub READLINE {
    my $self = shift;
    if (@$self) { shift @$self; } 
    else { croak "List of prompt responses has been exhausted: $!"; }
}

1;

##</code><code>##

package main;
use strict;
use warnings;
use Test::More tests => 3;

my (@lines, $room);

# 1st pass: valid data reached at $lines[4]
@lines = (
    'a string with numbers and letters 4678',
    '5678', '46789', ' 4678', '4678',
);
tie *STDIN, 'Preempt::Stdin', @lines;
ok($room = enter_number(), 'enter_number executed');
is(4678, $room, 'predicted value achieved');
untie *STDIN;

# 2nd pass: never reached valid data
@lines = (
    'a string with numbers and letters 4678',
    '5678', '46789',
);
{
    tie *STDIN, 'Preempt::Stdin', @lines;
    my $room;
    eval { $room = enter_number(); };
    like($@, qr/^List of prompt responses has been exhausted/, 
       "Prompt responses exhausted")
       || print STDERR "$@\n";
    untie *STDIN;
}

sub enter_number { # no change from yesterday
    local $_;
    while () {
        print "Enter new room number:  ";
        chomp ($_ = <STDIN>);
        if ($_ =~ /^4\d\d\d$/) {
            return $_;
        } else {
            print "\nMust be a 4-digit number beginning with '4'; try again.\n";
            next;
        }
    }
}

##</code><code>##

    local $SIG{__WARN__} = \&_capture;
    tie *STDIN, 'Preempt::Stdin', @lines;
    ...  # as before