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 data. (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 #### #!/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 data. (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 $filename: $!\n"; my @data = ; 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 $filename: $!\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 want; 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 available.\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 available.\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; }