更佳编程之路: 第 12 章. 使用 perledit: 段编辑文件

  perledit:
 any::
  filter in place /etc/hosts 'use Regexp::Common qw/net/; next unless m/$RE{net}{IPv4}/;'
  

input_filename: input_pipe |
                input_regular_filename
output_filename: output_pipe |
                 output_regular_filename
input_pipe: /"[^"]+?\|"/
{
 $item[1] =~ s/"([^"]*)"/$1/;
 chop $item[1]; # cut the last (pipe) character
 $return = {
            mode => ::EDIT_INPUT(),
            type => ::EDIT_FILETYPE_PIPE(),
            file => $item[1],
           };
 1;
}
output_pipe: /"\|[^"]+?"/
{
 $item[1] =~ s/"([^"]*)"/$1/;
 $item[1] = substr $item[1], 1; # cut the first (pipe) character
 $return = {
            mode => ::EDIT_OUTPUT(),
            type => ::EDIT_FILETYPE_PIPE(),
            file => $item[1],
           };
 1;
}
output_regular_filename: regular_filename { $return =
                                           {
                                            mode => ::EDIT_OUTPUT(),
                                            type => ::EDIT_FILETYPE_FILE(),
                                            file => $item[1],
                                           };
                                           1;
                                          }
input_regular_filename: regular_filename { $return =
                                          {
                                           mode => ::EDIT_INPUT(),
                                           type => ::EDIT_FILETYPE_FILE(),
                                           file => $item[1],
                                          };
                                          1;
                                         }
regular_filename: unquoted_regular_filename | quoted_regular_filename
quoted_regular_filename: /"[^"|]+"/
{
  $item[1] =~ s/^"(.*)"/$1/;
  $return = $item[1];
  1;
}
unquoted_regular_filename: /[^'"\s|]+/ # no pipes, space, or quotes

input: filter_in_place | write_in_place |
       filter_from_to | write_from_to |
       <error>
filter_in_place: /filter/ /in/ /place/ output_regular_filename command 
{::edit_op(::EDIT_IN_PLACE, $item{command}, undef, $item{output_regular_filename}); 1; }
filter_from_to: /filter/ /from/ input_filename /to/ output_filename command 
{::edit_op(::EDIT_FROM_TO, $item{command}, $item{input_filename}, $item{output_filename});
 1; }
write_in_place: /write/ output_filename command 
{::edit_op(::WRITE_IN_PLACE, $item{command}, undef, $item{output_filename}); 1; }
write_from_to: /write/ /from/ input_filename /to/ output_filename command 
{::edit_op(::WRITE_FROM_TO, $item{command}, $item{input_filename}, $item{output_filename});
 1; }
command: /'.*'/
{
  $item[1] =~ s/^'(.*)'/$1/;
  $return = $item[1];
  1;
}

perledit:
 any::
  filter in place /var/tmp/passwd 's/root/toor/g'
  filter from /var/tmp/passwd to /var/tmp/passwd.rewrite 's/0/0wn J00/g'
  filter from "ls /etc |" to /var/tmp/listing 's/s/ss/g'
  filter from "ls /etc |" to "|cat > /var/tmp/listing2" 's/s/ss/g'
# this one should be an error
  filter in place "|nmap" 's/s/ss/g'
# this one should make edit_op return unhappily
  filter from /var/tmp/passwd to /var/tmp/passwd 's/0/0wn J00/g'
  write /var/tmp/environment 'use Data::Dumper; print Dumper \%ENV'
  write /var/tmp/environment-error 'use Data::Dumper; print Dumper \%ENV'
# the following two lines of text are one line of code -
# remove the (CONTINUED) text and merge them!
  write from /etc/passwd to /var/tmp/passwd.rewrite2 (CONTINUED)
'use Data::Dumper; push @a, $_; print Dumper map { $_, $i++ } @a;'
# the following two lines of text are one line of code -
# remove the (CONTINUED) text and merge them!
  write from "ls /etc|" to /var/tmp/listing-env (CONTINUED)
'use Data::Dumper; push @a, $_; print Dumper map { $_, $i++ } @a;'

sub edit_open_file
{
 my $data = shift @_;
 my $mode = shift @_ || $data->{mode};
 my $to_open;
 if ($data->{type} eq EDIT_FILETYPE_FILE)
 {
  $to_open = $data->{file};
  $data->{object} = new IO::File;
  
  # if the output file has not been prepended with a > already...
  if ($mode eq EDIT_OUTPUT && $to_open !~ m/^>/)
  {
   $to_open = ">$to_open";
  }
  $data->{object}->open($to_open);
  out(5, "edit_open_file: opened file '$to_open'");
 }
 elsif ($data->{type} eq EDIT_FILETYPE_PIPE)
 {
  $to_open = $data->{file};
  $data->{object} = new IO::Pipe;
  if ($mode eq EDIT_INPUT)
  {
   $data->{object}->reader($to_open);
  }
  elsif ($mode eq EDIT_OUTPUT)
  {
   $data->{object}->writer($to_open);
  }
 }
 else
 {
  warn "edit_open_file: Invalid input/output description passed in " . Dumper($data);
 }
 unless ($data->{object}->opened())
 {
  out(0,
      "edit_open_file: could not open " . $data->{type} .
      " '$to_open', editing operation will fail");
  return undef;
 }
 return $data;
}

out (0, "edit_op: invoked with insufficient parameters")  
 unless defined $command;
out (0, "edit_op: invoked with insufficient parameters") 
 unless defined $input || defined $output;
if (defined $output && defined $input &&
    $input->{file} eq $output->{file})
{
 out(0, "edit_op: input and output file '" . $input->{file} . 
     "' is the same, exiting");
 return 1;
}

my $in_place_mode = ($op == EDIT_IN_PLACE) || ($op == WRITE_IN_PLACE);
my $from_to_mode = ($op == EDIT_FROM_TO) || ($op == WRITE_FROM_TO);
my $edit_mode = ($op == EDIT_IN_PLACE) || ($op == EDIT_FROM_TO);
my $write_mode = ($op == WRITE_IN_PLACE) || ($op == WRITE_FROM_TO);
my $write_once_mode = 0;
if ($write_mode && $in_place_mode)
{
 $write_once_mode = 1;                       # there is no loop for this case
}

my $old_handle = select;                 # save the old output destination
eval
{
 no strict;
 no warnings;
 if ($edit_mode && $in_place_mode)       # filter in place
 {
  ...
 }
 elsif ($write_once_mode)                # "write" command
 {
  ...
 }
 else                                    # "write from to" or "edit from to"
 {
  ...
 }
};
select $old_handle;                      # restore output in case it's needed