Fix parsing FreeBSD memory details

ChangeLog

@@ -9,6 +9,8 @@ Revision history for Rex
  - Fix parsing free memory on Solaris
  - Fix shared variable lockfile on Solaris
  - Prefer GNU tools on Solaris
+ - Fix parsing FreeBSD memory details
+ - Recognize laundry memory on FreeBSD
 
  [DOCUMENTATION]
 

lib/Rex/Hardware/Memory.pm

@@ -135,37 +135,32 @@ sub get {
     my $mem_str   = i_run "top -d1 | grep Mem:", fail_ok => 1;
     my $total_mem = sysctl("hw.physmem");
 
-    my (
-      $active, $a_ent, $inactive, $i_ent, $wired, $w_ent,
-      $cache,  $c_ent, $buf,      $b_ent, $free,  $f_ent
-      )
-      = ( $mem_str =~
-        m/(\d+)([a-z])[^\d]+(\d+)([a-z])[^\d]+(\d+)([a-z])[^\d]+(\d+)([a-z])[^\d]+(\d+)([a-z])[^\d]+(\d+)([a-z])/i
-      );
+    my $memory_details = __parse_top_output($mem_str);
 
-    if ( !$active ) {
-      (
-        $active, $a_ent, $inactive, $i_ent, $wired,
-        $w_ent,  $buf,   $b_ent,    $free,  $f_ent
-        )
-        = ( $mem_str =~
-          m/(\d+)([a-z])[^\d]+(\d+)([a-z])[^\d]+(\d+)([a-z])[^\d]+(\d+)([a-z])[^\d]+(\d+)([a-z])/i
-        );
-    }
+    for my $stat (qw(active inactive wired laundry cache buf free)) {
 
-    &$convert( $active,   $a_ent );
-    &$convert( $inactive, $i_ent );
-    &$convert( $wired,    $w_ent ) if ($wired);
-    &$convert( $cache,    $c_ent ) if ($cache);
-    &$convert( $buf,      $b_ent ) if ($buf);
-    &$convert( $free,     $f_ent );
+      if ( exists $memory_details->{$stat} ) {
+
+        my ( $value, $unit ) = $memory_details->{$stat} =~ qr{(\d+)([KMG])}msx;
+
+        $memory_details->{$stat} = $value;
+
+        &$convert( $memory_details->{$stat}, $unit );
+      }
+      else {
+        $memory_details->{$stat} = 0;
+      }
+    }
 
     $data = {
-      total   => $total_mem,
-      used    => $active + $inactive + $wired,
-      free    => $free,
-      cached  => $cache,
-      buffers => $buf,
+      total => $total_mem,
+      used  => $memory_details->{active} +
+        $memory_details->{inactive} +
+        $memory_details->{wired} +
+        $memory_details->{laundry},
+      free    => $memory_details->{free},
+      cached  => $memory_details->{cache},
+      buffers => $memory_details->{buf},
     };
   }
   elsif ( $os eq "OpenWrt" ) {
@@ -234,4 +229,28 @@ sub get {
   return $data;
 }
 
+sub __parse_top_output {
+  my $top_output = shift;
+
+  my @matches = $top_output =~ m{
+        \d+   # one or more digits
+        [KMG] # unit
+        [ ]   # space
+        \w+   # memory use type
+    }gmsx;
+
+  @matches = map { split qr{[ ]}msx } @matches;
+
+  if ( $matches[0] =~ qr{\d}msx ) {
+    @matches = reverse @matches;
+  }
+
+  my %top_memory_data = @matches;
+
+  %top_memory_data =
+    map { lc $_ => $top_memory_data{$_} } keys %top_memory_data;
+
+  return \%top_memory_data;
+}
+
 1;

t/hardware/memory.t

@@ -0,0 +1,62 @@
+#!/usr/bin/env perl
+
+use v5.12.5;
+use warnings;
+
+our $VERSION = '9999.99.99_99'; # VERSION
+
+use Test::More;
+use Test::Warnings;
+use Test::Deep;
+
+use Rex::Hardware::Memory;
+
+$::QUIET = 1;
+
+my @test_cases = (
+  {
+    name             => 'FreeBSD sample 4 elements',
+    top_output       => 'Mem: 12M Active, 34M Inact, 56M Wired, 78M Free',
+    expected_results => {
+      active => '12M',
+      inact  => '34M',
+      wired  => '56M',
+      free   => '78M',
+    },
+  },
+  {
+    name       => 'FreeBSD sample 5 elements',
+    top_output =>
+      'Mem: 123K Active, 456M Inact, 789M Wired, 1011K Buf, 1213M Free',
+    expected_results => {
+      active => '123K',
+      inact  => '456M',
+      wired  => '789M',
+      buf    => '1011K',
+      free   => '1213M',
+    },
+  },
+  {
+    name       => 'FreeBSD sample 6 elements',
+    top_output =>
+      'Mem: 1415K Active, 1617M Inact, 1819M Laundry, 2021K Wired, 2223M Buf, 2425M Free',
+    expected_results => {
+      active  => '1415K',
+      inact   => '1617M',
+      laundry => '1819M',
+      wired   => '2021K',
+      buf     => '2223M',
+      free    => '2425M',
+    },
+  },
+);
+
+plan tests => 1 + scalar @test_cases;
+
+for my $case (@test_cases) {
+  cmp_deeply(
+    Rex::Hardware::Memory::__parse_top_output( $case->{top_output} ),
+    $case->{expected_results},
+    $case->{name}
+  );
+}