A couple minor bugs:
- edit has a race condition, which I am ignoring for now. Will fix it eventually. ;)
- save might produce non-compiling code, if the user has been entering in lines that don't end with semi-colons but should.

A sample run through the tutor:

Welcome to the Perl Tutor!

Special commands are:
(H)elp      Get online help.
(L)oad      Load and evaluate the contents of the file.
(V)ars      Look at the present values of variables.
(C)lear     Clears the values of all variables and removes all undo da
+ta.
(B)lock     Type in more than one line of code at a time.
(U)ndo      Undo last Perl command.
(Q)uit      Quit the Perl Tutor.

Anything which is not a special command will be evaluated as Perl code
+.
> sub foo { $_ = shift; return $_ x 3 }

> $bar = foo("42 ");

> @baz = (1, 2, 3, 4);

> %quux = @baz

> vars
$bar = "42 42 42 "
@baz = (1, 2, 3, 4)
sub foo { ... }
%quux = (1 => 2, 3 => 4)
> undo
Successfully executed `undo' command.
> vars
$bar = "42 42 42 "
@baz = (1, 2, 3, 4)
sub foo { ... }
> quit
[download]

And here, finally, is the code for the tutor:

#!/usr/bin/perl -w
use strict;
use Term::ReadLine;

my $term = new Term::ReadLine 'Perl Tutor';
my $OUT = $term->OUT || *STDOUT;

print "Welcome to the Perl Tutor!\n\n";
print_commands();

my @undo_stack;
my @history;

LINE:
while (1) {
  $_ = $term->readline("> ");
  chomp;

  next LINE unless /./;
  help(),    next LINE if /^h$/i || /^help/i;
  edit(),    next LINE if /^e$/i || /^edit/i;
  vars(),    next LINE if /^v$/i || /^vars/i;
  block(),   next LINE if /^b$/i || /^block/i;
  load(),    next LINE if /^l$/i || /^load/i;
  save(),    next LINE if /^s$/i || /^save/i;
  clear(),   next LINE if /^c$/i || /^clear/i;
  undo(),    next LINE if /^u$/i || /^undo/i;
  re_do(),   next LINE if /^r$/i || /^redo/i;
  display(), next LINE if /^d$/i || /^display/i;
  exit()               if /^q$/i || /^quit/i;
  evaluate($_);
}

sub print_commands {
  print <<'DONE';
Special commands are:
(H)elp      Get online help.
(V)ars      Look at the present values of variables.
(C)lear     Clears the values of all variables and removes all undo da
+ta.
(B)lock     Type in more than one line of code at a time.
(U)ndo      Undo last Perl command.
(R)edo      Redo the last `undo' command.
(D)isplay   Display the code you've entered so far.
(L)oad      Load and evaluate the contents of a file.
(S)ave      Save the code you've entered so far into a file.
(E)dit      Edit your code in the editor of your choice.
(Q)uit      Quit the Perl Tutor.

Anything which is not a special command will be evaluated as Perl code
+.
DONE
}

sub load {
  my $filename = $term->readline("Please enter a filename to load: ");
  load_from_file($filename);
}

sub load_from_file {
  my $filename = shift;
  open (FILE, $filename) or return print "Could not load file $filenam
+e: $!\n";
  my @data = <FILE>;
  close(FILE) or return print "Could not close file $filename: $!\n";
  my $data = join "", @data;
  chomp $data;
  clear();
  print "File $filename loaded successfully.\n";
  evaluate($data);
}

# This bit is insecure to race conditions. I'll try to fix that later,
# but it shouldn't be a huge problem.
sub edit {
  my $loaded = 0;
  my $filename;
  until ($loaded) {
    $filename = ".perl-tutor-$$-" . int(rand(2**16)) . ".tmp";
    $loaded = 1 unless -e $filename;
  }
  my $default_editor = $ENV{EDITOR};
  unless ($default_editor) {
    $default_editor = "vi";
    $default_editor = "notepad.exe" if $^O =~ /Win32/i;
  }
  my $editor = $term->readline("Enter the name of an editor you would 
+like to use.\n[Default: $default_editor]: ");
  $editor = $editor || $default_editor;
  save_to_file($filename);
  system($editor, $filename);
  load_from_file($filename);
  unlink($filename) or return print "Could not remove temporary file $
+filename: $!\n";
}

sub save {
  my $filename = $term->readline("Please enter a filename to save to: 
+");
  save_to_file($filename);
}

sub save_to_file {
  my $filename = shift;
  open (FILE, ">$filename") or return print "Could not save to file $f
+ilename: $!\n";
  print FILE join("\n", @history);
  close(FILE) or return print "Could not close file $filename: $!\n";
}

sub display {
  print join("\n", @history);
  print "\n";
}

sub block {
  my @block = ();
  print "Entering Block Mode.\nEnter in as many lines of code as you w
+ant; type `done' on a blank line when done.\n\n";
  while (1) {
    $_ = $term->readline("block> ");
    chomp;
    last if /^done$/;
    push @block, $_;
  }
  evaluate(@block);
}

sub clear {
  %WorkSpace:: = ();
  @undo_stack = ();
  @history = ();
  print "Successfully cleared all variables and removed all undo data.
+\n"
}

sub help {
  print "Eventually, a nice help message will go here.\n\n";
  print_commands();
}

sub quote_strings {
  my @return_val;
  foreach (@_) {
    my $scalar = $_;
    $scalar = "\"$_\"" unless $scalar =~ /^[0-9.]+$/;
    push @return_val, $scalar;
  }
  return @return_val if wantarray;
  return $return_val[0];
}

sub undo {
  my @undo_data = @history;
  return print "Could not undo, because there is no undo data availabl
+e.\n" unless @undo_data;
  push @undo_stack, \@undo_data;
  my @old_history = @history;
  pop @old_history;
  @history = ();
  %WorkSpace:: = ();
  evaluate(@old_history);
}

sub re_do {
  my $history_ref = pop @undo_stack;
  return print "Could not redo, because there is no redo data availabl
+e.\n" unless $history_ref;
  my @new_history = @$history_ref;
  @history = ();
  %WorkSpace:: = ();
  evaluate(@new_history);
}

no strict;

sub evaluate {
  package WorkSpace;
  eval(join ("", @_));
  print "Unrecognized command or syntax error. (Type `help' for help.)
+" if $@;
  push @history, @_ unless $@;
  print "\n";
  package main;
}

sub vars {
  package WorkSpace;
  my $varcount = 0;
  foreach my $symname (sort keys %WorkSpace::) {
    local *sym = $WorkSpace::{$symname};
    if (defined $sym) {
      $varcount++;
      my $scalar = main::quote_strings($sym);
      print "\$$symname = $scalar\n";
    }
    if (defined @sym) {
      $varcount++;
      my @array = main::quote_strings(@sym);
      print "\@$symname = (";
      print join(", ", @array);
      print ")\n";
    }
    if (defined %sym) {
      $varcount++;
      print "\%$symname = (";
      my $output;
      foreach my $key (sort keys %sym) {
        my $value = main::quote_strings($sym{$key});
        $output .= "$key => $value, ";
      }
      chop $output;
      chop $output;
      print "$output)\n";
    }
    if (defined &sym) {
      $varcount++;
      print "sub $symname { ... }\n";
    }
  }
  print "No variables are currently defined.\n" unless $varcount;
  package main;
}
[download]