这是我的问题：
我有五列的文本文件。最后一个总是有个位数。在前三种情况下，背后鞭笞是违法的。空格可能显示在第一列中。我删除了第一列中最后一个@之后的所有内容。列之间用空格隔开。我可以将列宽设置为几乎任何我想要的值，从而可以控制列之间的间距。
所以，我可能有这样的东西：
D Smith Application Database Read 2
我有代码可以将其转换为：
grant read on database 'Application'.'Database' to 'D Smith';
这是我创建的Regex代码，用于分隔每个字段，避免混淆第一个字段中的任何空格和分隔间距。
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";
}
我这么做是因为我想不出一种方法来区分字段之间的空间和第一个字段中可能出现的空间。有更好的方法吗？这足够快，但并不优雅。
列的宽度是恒定的吗？如果是，跳过正则表达式，只需使用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来拆分第一个字段，并拆分其余字段：
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那样对字符串进行右修剪。请参阅打包/解包教程。
正如我在对您的问题的评论中所描述的，只要您能够确保两个简单的假设是有效的，就不需要大量复杂的多毛正则表达式。这些假设是：
- 对于每一对列，至少有两个空格将第一列中的值的末尾和第二列中值的开头分隔开
- 没有列的值包含两个或多个空格的字符串
给定这些假设，您只需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()。
要匹配这样的行：
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'
如果字段之间有两个以上的空格，那么以下内容可能会有所帮助：
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";
}
您可以通过greppingsplit的结果来省略初始空间替换。仅当CCD_ 10在CCD_ 12之后是CCD_。
正如您所说，只有第一列包含空格，我们可以使用split来分解列，然后拼接去除最后四个。。。然后只需使用字符串插值来重新构成第一列-不需要复杂的排斥表达式，不需要对固定列间距，没有关于双倍间距的假设。。可能想再添加一些有效性检查(确保值有效)
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";
}