洗練されたPerl : 平易な英語によるPerlプログラムの作成

                
#!/usr/bin/perl -w
use strict;				# always use strict, it's a good habit
use Getopt::Std;			# see "perldoc Getopt::Std"
my %options;
getopts('f:hl', \%options);		# read the options with getopts
# uncomment the following two lines to see what the options hash contains
#use Data::Dumper;
#print Dumper \%options;
$options{h} && usage();			# the -h switch
# use the -f switch, if it's given, or use a default configuration filename
my $config_file = $options{f} || 'first.conf';
print "Configuration file is $config_file\n";
# check for the -l switch
if ($options{l})
{
 system('/bin/ls -l');
}
else
{
 system('/bin/ls');
}
# print out the help and exit
sub usage
{
 print <<EOHIPPUS;
first.pl [-l] [-h] [-f FILENAME]
Lists the files in the current directory, using either /bin/ls or
/bin/ls -l.  The -f switch selects a different configuration file.
The -h switch prints this help.
EOHIPPUS
exit;
}
            

                
#!/usr/bin/perl -w
use strict; # always use strict, it's a good habit
use Getopt::Std; # see "perldoc Getopt::Std"
my %options;
getopts('f:hl', \%options); # read the options with getopts
# uncomment the following two lines to see what the options hash contains
#use Data::Dumper;
#print Dumper \%options;
$options{h} && usage(1); # the -h switch, with exit option
# use the -f switch, if it's given, or use a default configuration filename
my $config_file = $options{f} || 'first.conf';
print "Configuration file is $config_file\n";
# check for the -l switch
if ($options{l})
{
 system('/bin/ls -l');
}
else
{
 my $input; # a variable to hold user input do
 {
  print "Type 'help' for help, or 'quit' to quit\n-> ";
  $input =<stdin>;
  print "You entered $input\n"; # let the user know what we got
  # note that 'listlong' matches /list/, so listlong has to come first
  # also, the i switch is used so upper/lower case makes no difference
  if ($input =~ /listlong/i)
  {
   system('/bin/ls -l');
  }
  elsif ($input =~ /list/i)
  {
   system('/bin/ls');
  }
  elsif ($input =~ /help/i)
  {
   usage();
  }
  elsif ($input =~ /quit/i)
  {
   exit;
  }
 }
 while (1); # only 'quit' or ^C can exit the loop
}
exit; # implicit exit here anyway
# print out the help and exit
sub usage
{
 my $exit = shift @_ || 0; # don't exit unless explicitly told so
 print <<EOHIPPUS;
first.pl [-l] [-h] [-f FILENAME]
The -l switch lists the files in the current directory, using /bin/ls -l.
The -f switch selects a different configuration file.  The -h
switch prints this help.  Without the -l or -h arguments, will show
a command prompt.
Commands you can use at the prompt:
 list:     list the files in the current directory
 listlong: list the files in the current directory in long format
 help:     print out this help
 quit:     quit the program
 
EOHIPPUS
 exit if $exit;
}
            

                
word: /\w+/

                
token: word | non-word |<error>
word: /\w+/
non-word: /\W+/

                
print: /print/i { print_function(); }

                
word: letter(s)
letter: /\w/

                
print: /print/i word { print_function($item{word}); }
print2: /print2/i word word { print_function($item[1], $item[2]); }
print3: /print3/i word(s) { print_function(@{$item{word}}); }

                
#!/usr/bin/perl -w
use strict; # always use strict, it's a good habit
use Parse::RecDescent; # see "perldoc Parse::RecDescent"
my $global_grammar = q{
  input: help | helpquit | quit | listlong | list | fileoption |
         <error>
  help: /help|h/i { ::usage(); 1; }
  helpquit: /-h/i { ::usage(); exit(0); }
  list: /list|l/i { system('/bin/ls'); 1; }
  listlong: /-l|listlong|ll/i { system('/bin/ls -l'); 1; }
  fileoption: /-f/i word { print "Configuration file is $item{word}\n"; 1; }
  quit: /quit|q/i { exit(0) }
  word: /\S+/
};
{ # this is a static scope!  do not remove!
 # $parse is only initialized once...
 my $parse = new Parse::RecDescent ($global_grammar);
 sub process_line
 {
  # get the input that was passed from above
  my $input = shift @_ || '';
  # return undef if the input is undef, or was not parsed correctly  $parse->input($input)
   or return undef; # return 1 if everything went OK
  return 1;
 }
}
# first, process command-line arguments
if (@ARGV)			       
{
 process_line(join ' ', @ARGV);
}
do
{
 print "Type 'help' for help, or 'quit' to quit\n-> ";
 my $input = <STDIN>; # a variable to hold user input print "You entered $input\n"; # let the user know what we got
 process_line($input);
} while (1); # only 'quit' or ^C can exit the loop
exit; # implicit exit here anyway
# print out the help and exit
sub usage
{
 print <<EOHIPPUS;
first.pl [-l] [-h] [-f FILENAME]
The -l switch lists the files in the current directory, using /bin/ls -l.
The -f switch selects a different configuration file.  The -h
switch prints this help.  Without the -l or -h arguments, will show
a command prompt.
Commands you can use at the prompt:
 list | l           : list the files in the current directory
 listlong | ll | -l : list the files in the current directory in long format
 help | h           : print out this help
 quit | q           : quit the program
 
EOHIPPUS
}
            

                
#!/usr/bin/perl -w
use strict; # always use strict, it's a good habit
use Parse::RecDescent; # see "perldoc Parse::RecDescent"
my $global_grammar = q{
  { my $last_type = undef; } # this action is executed when the # grammar is created
  input: help | helpquit | quit | listlong | list | fileoption |
         show_last_type | set_type | order_dairy | order |
         <error>
  help: /help|h/i { ::usage(); 1; }
  helpquit: /-h/i { ::usage(); exit(0); }
  list: /list|l/i word(s?) { system('/bin/ls', @{$item{word}}); 1; }
  listlong: /-l|listlong|ll/i { system('/bin/ls -l'); 1; }
  fileoption: /-f/i word { print "Configuration file is $item{word}\n"; 1; }
  show_last_type: /show|s/i /last|l/i /type|t/ { ::show_last_type($last_type); 1; }
  set_type: /set|s/i /type|t/i word { $last_type = $item{word}; 1; }
  order_dairy: /order/i number(?) dairy_product
                { print "Dairy Order: @{$item{number}} $item{dairy_product}\n"; 1; }
  order: /order/i number(?) word
                { print "Order: @{$item{number}} $item{word}\n"; 1; }
  # come to Boston and try our frappes...
  dairy_product: /milk/i | /yogurt/i | /frappe|shake/i
  quit: /quit|q/i { exit(0) }
  word: /\S+/
  number: /\d+/
};
{ # this is a static scope!  do not remove!
 # $parse is only initialized once...
 my $parse = new Parse::RecDescent ($global_grammar);
 sub process_line
 {
  # get the input that was passed from above
  my $input = shift @_ || '';
  # return undef if the input is undef, or was not parsed correctly  $parse->input($input)
   or return undef; # return 1 if everything went OK
  return 1;
 }
}
# first, process command-line arguments
if (@ARGV)			       
{
 process_line(join ' ', @ARGV);
}
do
{
 print "Type 'help' for help, or 'quit' to quit\n-> ";
 my $input = <STDIN>; # a variable to hold user input print "You entered $input\n"; # let the user know what we got
 process_line($input);
} while (1); # only 'quit' or ^C can exit the loop
exit; # implicit exit here anyway
# print out the help and exit
sub usage
{
 print <<EOHIPPUS;
first.pl [-l] [-h] [-f FILENAME]
The -l switch lists the files in the current directory, using /bin/ls -l.
The -f switch selects a different configuration file.  The -h
switch prints this help.  Without the -l or -h arguments, will show
a command prompt.
Commands you can use at the prompt:
 list | l           : list the files in the current directory
 listlong | ll | -l : list the files in the current directory in long format
 help | h           : print out this help
 quit | q           : quit the program
 
EOHIPPUS
}
sub show_last_type
{
 my $type = shift;
 return unless defined $type; # do nothing for an undef type word
 print "The last type selected was $type\n";
}