Perl中更好的正则表达式解决方案?

时间:2013-12-31 19:44:18

标签: regex perl

这是我的问题:

我有五列的文本文件。最后一个总是有一个数字。反斜杠在前三个是非法的。空格可能会显示在第一列中。我删除了第一列中最后一个@之后的所有内容。列由空格分隔。我可以将列宽设置为我想要的任何值,让我对列之间的间距进行一些控制。

所以,我可能会有这样的事情:

D Smith     Application     Database     Read     2

我有代码将其转换为:

grant read on database 'Application'.'Database' to 'D Smith';

这是我创建的正则表达式代码,用于分隔每个字段,避免将第一个字段中的任何空格与分隔间距混淆。

while (<>) {
    s/^ //m;
    if (/^([^\\]+?)( {80,})/) {
        my $atindex = rindex($1,"@",);
        my $username = substr($1,0,$atindex);
        if ($atindex != -1) {
            s/^([^\\]+?)( {80,})/$username  $2/m;
            s/ {2,}/ \\ \\ /g;
            s/\\ \d$//gm;
            s/ \\ $//gm;
        }
    }

这样做是使\\ \\字段之间的分隔符。然后我使用此代码进行转换:

if (/([^\\]+) \\ \\ ([^\\]+) \\ \\ ([^\\]+) \\ \\ ([^\\]+)\n/) {
    if ($4 eq "any") {
        my $execany = "execute any";
        print "grant $execany on database '$2'.'$3' to user '$1';\n";
    } else {
        print "grant $4 on database '$2'.'$3' to user '$1';\n";
    }

我这样做是因为我无法找到一种方法来辨别第一个字段中可能出现的空格中字段之间的空格。有没有更好的办法?这种方法运作得足够快,但并不优雅。

5 个答案:

答案 0 :(得分:5)

列是否恒定宽度?如果是这样,请跳过正则表达式,只需使用substr

数据格式

D Smith     Application     Database     Read     2
012345678901234567890123456789012345678901234567890

程序

use strict;
use warnings;
use feature qw(say);

while ( my $line = <> ) {
    chomp $line;
    ( my $user = substr( $line, 0, 10 )) =~ s/\s*$//;
    ( my $file = substr( $line, 12, 15 )) =~ s/\s*$//;
    ( my $db   = substr( $line, 28, 12 )) =~ s/\s*$//;
    ( my $op   = substr( $line, 41, 9 )) =~ s/\s*$//;
    ( my $num  = substr ( $line, 50 )) =~ s/\s*$//;
    say qq(User = "$user", File = "$file", DB = "$db", OP = "$op", NUM = "$num");
}

s/\s*$//;修剪字符串右侧的空白区域。

如果您不想使用所有这些子字符串,并且只有第一个字段可能包含空格,那么您可以使用substr拆分第一个字段,split在其他领域:

while ( my $line = <> ) {
    chomp $line;
    ( my $user = substr( $line, 0, 10 ) ) =~ s/\s*$//;
    my ( $file, $db, $op, $num ) = split /\s+/, substr( $line, 12 );
    ....
}

另一种解决方案

  

列是否恒定宽度? ......很好的解决方案unpack也可以使用恒定宽度。 - Kenosis

让我们使用unpack

while ( my $line = <> ) {
    chomp $line;
    my ( $user, $file, $db, $op, $num ) = unpack ("A12A16A13A9A*", $line);
    say qq(User = "$user", File = "$file", DB = "$db", OP = "$op", NUM = "$num");
}

是的,这很容易理解。至少我没有像使用substr那样正确修剪我的字符串。请参阅pack/unpack tutorial

答案 1 :(得分:2)

正如我在你的问题的评论中所描述的那样,只要你能确保两个简单的假设是有效的,你就不需要进行大量复杂的毛茸茸的再生。这些假设是:

  • 对于每对列,至少有两个空格分隔第一列中值的结尾,以及第二列中值的开头;
  • 没有列的值包含两个或更多空格的字符串。

(如果您不能保证对包含两个或更多空格的分隔符进行这些假设,也许您可​​以使用三个或更多,或者四个或更多,&amp; c。您最好使用以下内容来划分列你可以确定永远不会出现任何价值,但如果没有,那么这些规则是你所希望做的最好的。)

考虑到这些假设,您只需split()两个或更多空格的子串上的字符串,如下所示:

while (<>) {
      $_ =~ s@^\s+@@;
      my @fields = split(/\s{2,}/, $_);
      # print your commands, interpolating values from @fields
}

或者,更简单,更可读,你可以做这样的事情:

while (my $line = <STDIN>) {
    # the same leading-space cleanup and split...
    $line =~ s@^\s+@@;
    my @fields = split(/\s{2,}/, $line);

    # ...and then we assign values to a hash with meaningful keys...
    my %values = ('user'        => $fields[0],
                  'application' => $fields[1],
                  'database'    => $fields[2],
                  'permission'  => (lc($fields[3]) eq 'any'
                                      ? 'execany'
                                      : $fields[3]));

    # ...so that our interpolation and printing becomes much more
    # readable.
    print "grant $values{'permission'}"
      . " on database '$values{'application'}'.'$values{'database'}"
      . " to user '$values{'user'}';"
      . "\n";
};

您还可以添加一些有效性检查,即确保给定行中您期望的所有值都存在且格式正确并发出一些有用的通知,或者只是die()直接,如果他们'不是。

答案 2 :(得分:2)

匹配这样的行:

D Smith      Application     Database     Read     2
F J Perl     Foobar          Database2    Write    4
Something    Whatever        Database3    Any      1

进入相关的第1列到第5列,其中第1列可以包含空格,锚点在行尾($):

while (<>) {
    next unless /^\s*(.+?)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\d+)$/;
    my $grant_type = $4;
    $grant_type = 'execute any' if lc $grant_type eq 'any';
    print "grant $grant_type on '$2'.'$3' to '$1'\n";
}

结果:

grant Read on 'Application'.'Database' to 'D Smith'
grant Write on 'Foobar'.'Database2' to 'F J Perl'
grant execute any on 'Whatever'.'Database3' to 'Something'

答案 3 :(得分:0)

鉴于字段之间有两个+空格,以下内容可能会有所帮助:

use strict;
use warnings;

while (<>) {
    my ( $user, $app, $db, $perm ) = grep $_, split /\s{2,}/;
    $perm = 'execute any' if lc $perm eq 'any';

    print "grant $perm on database '$app'.'$db' to user '$user';\n";
}

您可以通过grep ping split的结果来省略初始空格替换。 $perm只有在any之后split才会更改。

答案 4 :(得分:0)

正如你所说,只有第一列包含空格我们可以使用split来拆分列, 并拼接删除最后四个...然后只需使用字符串插值重新构成 第一列 - 不需要复杂的repular表达式,也没有关于fixed的假设 列间距和没有关于双倍间距的假设..可能想要添加更多 有效性检查(确保值有效)

use strict;
use Const::Fast qw(const);
const my $N => 4;

while(<>){
  ## Split the string on spaces...
  chomp;
  my @Q = split;
  next if @Q <= $N;

  ## And remove the last four columns...
  my ($app,$db,$perm,$flag) = splice @Q,-$N,$N;

  ## Sort out name and perm...
  ( my $user = "@Q" ) =~ s{@[^@]+}{}mxs;
  $perm = 'execute any' if 'any' eq lc $perm;

  ## Print out statement... using named variables makes life easier!
  print "grant $perm on database '$app'.'$db' to user '$user';\n";
}