sub enter_number {
  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>##

package Preempt::Stdin;
use strict;

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

sub READLINE {
	my $self = shift;
	shift @$self;
}

1;

##</code><code>##

package main;
use strict;
use warnings;

my @lines = (
	'a string with numbers and letters 4678',
	'5678',
	'46789',
	' 4678',
	'4678',
);

tie *STDIN, 'Preempt::Stdin', @lines;
my $room = enter_number();
untie *STDIN;
print "Room:  $room\n";

##</code><code>##

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

my @lines = (
	'a string with numbers and letters 4678',
	'5678',
	'46789',
	' 4678',
	'4678',
);

tie *STDIN, 'Preempt::Stdin', @lines;
my $room;
ok($room = enter_number(), 'enter_number executed');
is(4678, $room, 'predicted value achieved');

untie *STDIN;
print "Room:  $room\n";

sub enter_number {
    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;
        }
    }
}