Perl：使用 while 将文件加载到哈希中

Question

在我的last question 中，我询问了在我的 Perl 脚本中存储文本文件数据的正确方法，解决方案是使用 AoH。

反正我的实现好像不完整：

#!/usr/bin/perl

use strict;
use warnings;

# Open netstat output
my $netstat_dump = "tmp/netstat-output.txt";
open (my $fh, "<", $netstat_dump) or die "Could not open file '$netstat_dump': $!";

# Store data in an hash
my %hash;
while(<$fh>) {
  chomp;
  my ($Protocol, $RecvQ, $SendQ, $LocalAddress, $ForeignAddress, $State, $PID) = split(/\s+/);
  # Exclude $RecvQ and $SendQ
  $hash{$PID} = [$Protocol, $LocalAddress, $ForeignAddress, $State $PID];
}
close $fh;
print Dumper \%hash;

第一个问题是我在$PID 上得到未初始化的值错误，即使$PID 在上面的行中声明。

第二个脚本的问题是它从输入文件中加载最后一个字母并将它们放在自己的行中：

$VAR1 = {
...
'6907/thin' => [
                           'tcp',
                           '127.0.0.1:3001',
                           '0.0.0.0:*',
                           'LISTEN',
                           '6907/thin'
                         ],
          '' => [
                  'udp6',
                  ':::49698',
                  ':::*',
                  '31664/dhclient',
                  ''
                ],
          'r' => [
                   'udp6',
                   ':::45016',
                   ':::*',
                   '651/avahi-daemon:',
                   'r'
                 ]
        };

'' => 和 'r' => 来自输入文件，如下所示：

tcp        0      0 0.0.0.0:3790            0.0.0.0:*               LISTEN      7550/nginx.conf 
tcp        0      0 127.0.1.1:53            0.0.0.0:*               LISTEN      1271/dnsmasq    
tcp        0      0 127.0.0.1:631           0.0.0.0:*               LISTEN      24202/cupsd     
tcp        0      0 127.0.0.1:5432          0.0.0.0:*               LISTEN      11222/postgres  
tcp        0      0 127.0.0.1:3001          0.0.0.0:*               LISTEN      6907/thin server (1
tcp        0      0 127.0.0.1:50505         0.0.0.0:*               LISTEN      6874/prosvc     
tcp        0      0 127.0.0.1:7337          0.0.0.0:*               LISTEN      6823/postgres.bin
tcp6       0      0 ::1:631                 :::*                    LISTEN      24202/cupsd     
udp        0      0 0.0.0.0:46096           0.0.0.0:*                           651/avahi-daemon: r
udp        0      0 0.0.0.0:5353            0.0.0.0:*                           651/avahi-daemon: r
udp        0      0 127.0.1.1:53            0.0.0.0:*                           1271/dnsmasq    
udp        0      0 0.0.0.0:68              0.0.0.0:*                           31664/dhclient  
udp        0      0 0.0.0.0:631             0.0.0.0:*                           912/cups-browsed
udp        0      0 0.0.0.0:37620           0.0.0.0:*                           31664/dhclient  
udp6       0      0 :::5353                 :::*                                651/avahi-daemon: r
udp6       0      0 :::45016                :::*                                651/avahi-daemon: r
udp6       0      0 :::49698                :::*                                31664/dhclient 

这也让我觉得我的哈希函数没有解析整个文件并在某处中断。

Answer 1

当你分割一行时，例如：

udp        0      0 0.0.0.0:37620           0.0.0.0:*                           31664/dhclient 

在空白处你得到 5 个元素，而不是 6 个。这是因为状态列中没有字符串，并且 PID 被分配给 $State。

同样，

udp        0      0 0.0.0.0:5353            0.0.0.0:*                           651/avahi-daemon: r

将 pid 存储为第 5 个元素（状态），将 'r' 存储为第 6 个（pid），因为 PID 中的冒号和 r 之间存在空格。

您可能想考虑使用unpack 来拆分固定宽度的字段。请注意，如果输入根据内容具有不同的列宽，则需要确定列宽以使用 unpack。

请参阅tutorial 了解相关操作方法。

Answer 2

有时拆分效果不如您可能收到的数据的完整规范。有时你需要一个正则表达式。特别是因为您有一个可能存在也可能不存在的字段。 （“听”）

同样，您也很难将 PID 与进程信息分开。

这是我的正则表达式：

my $netstat_regex
    = qr{
    \A                # The beginning of input
    ( \w+ )           # the proto
    \s+
    (?: \d+ \s+ ){2}  # we don't care about these
    (                 # Open capture
        [[:xdigit:]:.]+?               
        :
        (?: \d+ )
    )                 # Close capture
    \s+
    (                 # Open capture
        [[:xdigit:]:.]+?               
        :
        (?: \d+ | \* )
    )                 # Close capture
    \s+
    (?: LISTEN \s+ )? # It might not be a listen socket. 
    ( \d+ )           # Nothing but the PID
    /
    ( .*\S )          # All the other process data (trimmed)
    }x;

然后我这样处理：

my %records;

while ( <$fh> ) { 
    my %rec;
    @rec{ qw<proto local remote PID data> } = m/$netstat_regex/;
    if ( %rec ) { 
        $records{ $rec{PID} } = \%rec;
    }
    else {
        print "Error processing input line #$.:\n$_\n";
    }    
}

请注意，我还有一些代码可以向我展示不符合我的模式的内容，以便我可以在必要时对其进行改进。我不完全信任输入。

漂亮整洁的转储：

%records: {
            11222 => {
                       PID => '11222',
                       data => 'postgres',
                       local => '127.0.0.1:5432',
                       proto => 'tcp',
                       remote => '0.0.0.0:*'
                     },
            1271 => {
                      PID => '1271',
                      data => 'dnsmasq',
                      local => '127.0.1.1:53',
                      proto => 'udp',
                      remote => '0.0.0.0:*'
                    },
            24202 => {
                       PID => '24202',
                       data => 'cupsd',
                       local => '::1:631',
                       proto => 'tcp6',
                       remote => ':::*'
                     },
            31664 => {
                       PID => '31664',
                       data => 'dhclient',
                       local => ':::49698',
                       proto => 'udp6',
                       remote => ':::*'
                     },
            651 => {
                     PID => '651',
                     data => 'avahi-daemon: r',
                     local => ':::45016',
                     proto => 'udp6',
                     remote => ':::*'
                   },
            6823 => {
                      PID => '6823',
                      data => 'postgres.bin',
                      local => '127.0.0.1:7337',
                      proto => 'tcp',
                      remote => '0.0.0.0:*'
                    },
            6874 => {
                      PID => '6874',
                      data => 'prosvc',
                      local => '127.0.0.1:50505',
                      proto => 'tcp',
                      remote => '0.0.0.0:*'
                    },
            6907 => {
                      PID => '6907',
                      data => 'thin server (1',
                      local => '127.0.0.1:3001',
                      proto => 'tcp',
                      remote => '0.0.0.0:*'
                    },
            7550 => {
                      PID => '7550',
                      data => 'nginx.conf',
                      local => '0.0.0.0:3790',
                      proto => 'tcp',
                      remote => '0.0.0.0:*'
                    },
            912 => {
                     PID => '912',
                     data => 'cups-browsed',
                     local => '0.0.0.0:631',
                     proto => 'udp',
                     remote => '0.0.0.0:*'
                   }
          }

Answer 3

如果您的输入包含制表符，您可以改为在 /\t/ 上拆分。 \s+ 匹配任何空格，即一个选项卡和两个选项卡，因此“空列”被跳过。

不过，修复仍然不会散列输入中的所有行。哈希键必须是唯一的，但输入包含一些 PID 不止一次（1271/dnsmasq 24202/cupsd 31664/dhclient 2 次和651/avahi-daemon: r 4 次）。你可以改用 HoAoA 来解决这个问题：

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

use Data::Dumper;

my $netstat_dump = 'input.txt';
open my $FH, '<', $netstat_dump or die "Could not open file '$netstat_dump': $!";

my %hash;
while (<$FH>) {
    chomp;
    my ($Protocol, $RecvQ, $SendQ, $LocalAddress, $ForeignAddress, $State, $PID)
         = split /\t/;
    push @{ $hash{$PID} }, [ $Protocol, $LocalAddress, $ForeignAddress, $State, $PID ];
}
close $FH;
print Dumper \%hash;

Answer 4

您可以删除split() 之前的状态列，这样每一行都有相同的列数，

# assuming that state is always upper case followed by spaces and digit(s)
$State = s/\b([A-Z]+)(?=\s+\d)// ? $1 : "";

Answer 5

您可能想使用或查看一些相关 CPAN 模块的源代码，以了解作者如何解决类似问题：eg Parse::Netstat、Regexp::Common、等 em>。