注释多个文件中的特定代码块

Question

我有多个包含某些代码块、多行的文件，我需要将其注释掉。我对一些包含特定关键字的特殊块感兴趣：

ic 创建

这些块总是以

开头

%put %str

结束于

%rcSet

示例块如下：

  text
  text
  text

  %put %str(NOTE: integrity constraints);
  proc datasets library=TESTING nolist;
     modify TESTING_UPDATES;
        ic create not null (id);
        ic create not null (prsn);
        ic create not null (valid_from);
        ic create not null (valid_to);
        ic create not null (current_flag);
        ic create not null (active_flag);
        ic create not null (hist);
  quit;

  %rcSet(&syserr);

  %put %str(NOTE: integrity constraints);
  proc datasets library=TESTING nolist;
     modify TESTING_UPDATES;
  quit;

  %rcSet(&syserr);

可能有更多块以指定的关键字开始和结束，但没有“ic create”关键字，需要忽略。

我写了一个代码，它可以找到并显示所有这些块，但我不知道

1. 我怎样才能得到这些从头到尾中间有所需图案的块
2. 最好的注释方式是什么，在行首加*，从头到尾都是这样
3. 代码最好不带任何外部模块，因为不是每个未来阅读本文的人都可以访问它们

期望的输出：

      text
      text
      text

*     %put %str(NOTE: integrity constraints);
*     proc datasets library=TESTING nolist;
*        modify TESTING_UPDATES;
*           ic create not null (id);
*           ic create not null (prsn);
*           ic create not null (valid_from);
*           ic create not null (valid_to);
*           ic create not null (current_flag);
*           ic create not null (active_flag);
*           ic create not null (hist);
*     quit;
*
*     %rcSet(&syserr);

      %put %str(NOTE: integrity constraints);
      proc datasets library=TESTING nolist;
         modify TESTING_UPDATES;
      quit;

      %rcSet(&syserr);

我的 Perl 代码：

use strict;
use warnings;

my @files = glob ("*.sas");

foreach my $file (@files) {
open my $fh, '<', $file or die "Cannot open file: $!"; {
        while ( <$fh> ) {
                if ( /%put\s%str/ ) {
                print;
                while ( <$fh> ) {
                        print;
                        last if /%rcSet/;
                }
                print "-" x 20, "\n";
        }
}

__END__

非常感谢任何帮助。谢谢！

Answer 1

您正在逐行工作，并试图“知道”您是否在一节中有“ic create”。

因此解决方法是：

#!/usr/bin/env perl
use strict;
use warnings;

my $buffer;

while (<>) {
   if ( m/\%put\s\%str/ .. /\%rcSet/ ) {
      $buffer .= $_;
      next;
   }
   if ($buffer) {
      if ( $buffer =~ m/ic create/ ) {
         $buffer =~ s/^/*/gm;
      }
      print $buffer;
      $buffer = "";
   }
   print;
}


#handle the case of buffer being the last line:

if ($buffer) {
   if ( $buffer =~ m/ic create/ ) {
      $buffer =~ s/^/*/gm;
   }
   print $buffer;
}

Answer 2

更新

对于任何希望避免使用核心模块 List::Util 的人，您可以从下面的代码中删除 use 语句并像这样定义 any 运算符

sub any(&@) {
    my ($f) = @_;
    $f->() and return 1 for @_;
    return 0;
}

---

我已使用此文件来测试我的代码。如果您提供自己的测试文件会更合适，因为我们必须猜测您的数据包含什么，我们在这里免费编写代码

数据

  text
  text
  text

  %put %str(NOTE: integrity constraints);
  proc datasets library=TESTING nolist;
     modify TESTING_UPDATES;
        ic create not null (id);
        ic create not null (prsn);
        ic create not null (valid_from);
        ic create not null (valid_to);
        ic create not null (current_flag);
        ic create not null (active_flag);
        ic create not null (hist);
  quit;

  %rcSet(&syserr);

  %put %str(NOTE: integrity constraints);
  proc datasets library=TESTING nolist;
     modify TESTING_UPDATES;
  quit;

  %rcSet(&syserr);

Perl 代码

此程序需要输入文件的路径作为命令行上的参数。输出被发送到标准输出

use strict;
use warnings 'all';

use List::Util 'any';

my @block;

while ( <> ) {
    my $status = /^\s*%put\s+%str\b/ .. /^\s*%rcSet\b/;

    if ( $status ) {

        push @block, $_;

        if ( $status =~ /E/ ) {
            if ( any { /\bic create\b/ } @block ) {
                s/^ ?/*/ for @block;
            }
            print @block;
            @block = ();
        }
    }
    else {
        print;
    }
}

输出

      text
      text
      text

*     %put %str(NOTE: integrity constraints);
*     proc datasets library=TESTING nolist;
*        modify TESTING_UPDATES;
*           ic create not null (id);
*           ic create not null (prsn);
*           ic create not null (valid_from);
*           ic create not null (valid_to);
*           ic create not null (current_flag);
*           ic create not null (active_flag);
*           ic create not null (hist);
*     quit;
*
*     %rcSet(&syserr);

      %put %str(NOTE: integrity constraints);
      proc datasets library=TESTING nolist;
         modify TESTING_UPDATES;
      quit;

      %rcSet(&syserr);

Answer 3

大多数 Perl 程序只使用一个 while (<>) 循环，但可以嵌套它们，这使得内部和外部循环具有不同的循环语义变得容易。而且我认为它使代码更清晰。外循环搜索开始标记，内循环搜索结束标记。

#! /usr/bin/perl
use strict;
use warnings;

# Outer loop searching for begin marker.
while (<>)
{
  if (/%put %str/)
  {
    my @block = ($_);
    my $is_ic_create = 0;

    # Inner loop searching for end marker.
    while (<>)
    {
      push @block, $_;
      if (/ic create/) {
        $is_ic_create = 1;
      }
      elsif (/%rcSet/) {
        map { s/^/* / if $is_ic_create; print } @block;
        last;
      }
    }
  }
  else {
    print;
  }
}