in reply to Using a regex function from a hash

In particular, have a look at the "Execute command" part.
#!/usr/bin/perl # # $Id: whatprog,v 1.2 1994/11/20 06:19:00 weingart Exp weingart $ # # Whatnowproc for MH-6.8 # Get the command line arguments push(@ARGV, split(' ', `mhparam whatnow`)); # Dispatch table %dispatch = ( 'alias', 'alias_proc', 'echo', 'echo_proc', 'edit', 'edit_proc', 'encrypt', 'encrypt_proc', 'env', 'env_proc', 'mime', 'mime_proc', 'quit', 'quit_proc', 'send', 'send_proc', 'set', 'set_proc', 'sign', 'sign_proc', 'unalias', 'unalias_proc', 'unset', 'unset_proc', ); # Alias table %aliases = ( ); # Variables table %var = ( 'prompt', '"Draft($message): "', 'alias_level', 10, ); # Mainline { # Init variables foreach $key (keys %ENV){ next if($key !~ m/^mh/); $var{$key} = $ENV{$key}; } split(/\//, $ENV{'mhdraft'}); $var{'message'} = pop(@_); # Read init file if(open(INIT, "$ENV{HOME}/.whatnowrc")){ while(<INIT>){ &do_command($_); } close(INIT); } # Command loop &prompt; while(<>){ # Execute command &do_command($_); &prompt; } exit(0); } # Handle command sub do_command { local($cmd) = $_[0]; local(@cmd); # Massage line into list chop($cmd); @cmd = &do_token($cmd); return if($#cmd == -1); # Interpolate vars @cmd = &do_vars(@cmd); # Do aliases @cmd = &do_aliases(@cmd); # Execute cmd if(defined($dispatch{$cmd[0]})){ &{ $dispatch{$cmd[0]} }(@cmd); print "$@\n" if($@); }else{ print "Not finished yet\n"; } } # Do aliases sub do_aliases { local(@args) = @_; local($deep) = 0; while(defined($aliases{$args[0]}) && ($deep != $var{'alias_lev +el'})){ $args[0] = $aliases{$args[0]} if(defined($aliases{$arg +s[0]})); $deep++; print "Infinite recursion...\n" if($deep == $var{'alia +s_level'}); } if($deep >= $var{'alias_level'}){ &prompt; next; } return(@args); } # Print out prompt sub prompt { local($message); local($prompt); split('/', $ENV{'mhdraft'}); $message = pop(@_); if(defined($var{'prompt'})){ $prompt = eval("$var{'prompt'}"); print "$prompt"; }else{ print "Draft $message> "; } flush; } # Unalias an alias sub unalias_proc { local(@args) = @_; local($cmd); $cmd = shift(@args); $cmd = shift(@args); if(!defined($aliases{$cmd})){ if($cmd !~ m/^\s*$/){ print "Alias $cmd does not exist!\n"; }else{ print "Huh, say what?\n"; } }else{ delete($aliases{$cmd}); } } # Alias some command sub alias_proc { local(@args) = @_; local($cmd, $exp, $tmp); $cmd = shift(args); $cmd = shift(args); $exp = join(' ', @args); if(defined($dispatch{$cmd})){ print "Can not alias that!\n"; return; } if($exp !~ m/^\s*$/){ $aliases{$cmd} = $exp; }else{ foreach $tmp (keys %aliases){ print "$tmp\t->\t$aliases{$tmp}\n"; } } } # Echo arguments sub echo_proc { local(@args) = @_; shift(@args); print join(' ', @args); print "\n"; } # Set a variable sub set_proc { local(@args) = @_; local($tmp); if($#args == 0){ foreach $tmp (keys %var){ print "$tmp = $var{$tmp}\n"; } }else{ $var{$args[1]} = $args[3]; } } # Unset a variable sub unset_proc { local(@args) = @_; local($tmp); return if($#args != 1); $tmp = $args[1]; delete $var{$tmp} if(defined($var{$tmp})); } # Interpolate variables sub do_vars { local(@args) = @_; local($tmp); foreach $tmp (@args){ next if($tmp !~ m/^\$([a-zA-Z]\w*)/); if(!defined($var{$1})){ print "\$$1 is not defined.\n"; }else{ $tmp =~ s/\$(\w+)/$var{"$1"}/; } } return(@args); } # Encrypt a document sub encrypt_proc { print "Hang on sloopy!\n"; print @_; } # Sign a document sub sign_proc { print "Hang on sloopy!\n"; print @_; } # Mime a document sub mime_proc { local($mimeproc); local(@mimeproc); chop($mimeproc = `mhparam buildmimeproc`); chop($mimeproc = `mhparam automhnproc`) if($mimeproc eq ''); @mimeproc = split(/\s+/, $mimeproc); system(@mimeproc, "$ENV{'mhdraft'}"); } # Send a document sub send_proc { local($sendproc); local(@sendproc); local($domime); chop($domime = `mhparam automimeproc`); &mime_proc if($domime eq '1'); chop($sendproc = `mhparam sendproc`); @sendproc = split(/\s+/, $sendproc); system(@sendproc, "$ENV{'mhdraft'}"); } # Edit a document sub edit_proc { system("$ENV{'mheditor'}", "$ENV{'mhdraft'}"); } # Print environment sub env_proc { local($i); foreach $i (keys %ENV){ next if($i !~ m/^mh/i); print "$i => $ENV{$i}\n"; } } # Quit this sub quit_proc { local(@args); local($tmp); $tmp = join(' ', @_); @args = split(/\s+/, $tmp); if(!grep(/^-nodel(ete)?/, @args)){ $tmp = $ENV{'mhdraft'}; $tmp =~ s|/(\d+)$|/,$1|; rename($ENV{'mhdraft'}, $tmp); } exit(0); } # Tokenize line sub do_token { local($line) = $_[0]; local(@match) = (); local(@what) = (); local($i, $tmp); for($i = 0; $line ne ''; $i++){ # BLANK if($line =~ m/^(\s+)/){ $line = substr($line, length($1)); } # WORD if($line =~ m/^(\w+)/){ $what[$i] = 'WORD'; $match[$i] = $1; $line = substr($line, length($1)); next; } # VAR if($line =~ m/^(\$[a-zA-Z]\w*)/){ $what[$i] = 'VAR'; $match[$i] = $1; $line = substr($line, length($1)); next; } # STRING if($line =~ m/^("[^"]*")/){ $what[$i] = 'STRING'; $match[$i] = $1; $line = substr($line , length($1)); next; } # SPECIAL if($line =~ m/^([=])/){ $what[$i] = 'SPECIAL'; $match[$i] = $1; $line = substr($line, length($1)); next; } # Comment if($line =~ m/^(#.*)/){ $line = substr($line, length($1)); next; } # ERROR if($line =~ m/^(.+)$/){ print "Found ERROR($1).\n"; $line = substr($line, length($1)); next; } } return(@match); }

2006-08-04 Retitled by planetscape, as per Monastery guidelines

( keep:0 edit:13 reap:0 )

Original title: 'I use something like this:'

Replies are listed 'Best First'.
Re: Using a regex function from a hash
by Excalibor (Pilgrim) on Aug 04, 2006 at 20:40 UTC

    Not to be picky, as the code is pretty clear (and complete!) but all those local() declarations on the functions shoould really be my() declarations, IMO... local() does not create a local variable... (Perl 5! check the docs)

    best regards!

    --
    our $Perl6 is Fantastic;

      Much of this was written quite some time ago... :) Yes, it needs a rewrite, but other things usually take precedence.. -T.