Use an OO framework for the GuiJson library module.

Jed's changes, with a tweak to the lf_wifi_reset_example.pl to use
the new OO methods.

LANforge/GuiJson.pm

@@ -2,7 +2,8 @@ package LANforge::GuiJson;
 use strict;
 use warnings;
 use JSON;
-use base 'Exporter';
+#use base 'Exporter';
+use Scalar::Util 'blessed';
 
 if (defined $ENV{'DEBUG'}) {
    use Data::Dumper;
@@ -13,23 +14,30 @@ if (defined $ENV{'DEBUG'}) {
 
 our $NL="\n";
 
-our @EXPORT_OK=qw(GetHeaderMap GuiResponseToArray GuiResponseToHash GetRecordsMatching GetFields);
+our @EXPORT_OK=qw(new);
 our $refs_example = q( \@portnames or ["sta1", "sta2"] not ("sta1", "sta2"));
-=pod
+
-=head1 GuiResponseToArray
+sub new {
-=cut
+  my $this = {
-sub GuiResponseToArray {
+    'url'       => undef,
-   my $response = shift;
+    'handler'   => undef,
-   my $ra_data = decode_json($response);
+    'uri'       => undef,
-   return $ra_data;
+    'header'    => undef,
+    'data'      => undef,
+    'headermap' => {},
+  };  # Create an anonymous hash, and #self points to it.
+
+  bless $this;       # Connect the hash to the package Cocoa.
+  return $this;     # Return the reference to the hash.
 }
 
 =pod
 =head1 GuiResponseToHash
 =cut
 sub GuiResponseToHash {
+   my $self = shift;
    my $response = shift;
-   my $ra_data = decode_json($response);
+   my $ra_data = JSON::decode($response);
    my $rh_data = {};
    $rh_data->{'handler'} = $ra_data->[0]->{'handler'};
    $rh_data->{'uri'} = $ra_data->[1]->{'uri'};
@@ -39,38 +47,50 @@ sub GuiResponseToHash {
    return $rh_data;
 }
 
-=pod
+sub Request {
-=head1 GetHeaderMap
+  my $self = shift;
-GuiJson::GenHeaderMap expects a reference to a header array like
+  $self->{'url'} = shift;
-{ 'header' => ['a', 'b', 'c']}
+  if (!defined $self->{'url'}) {
-=cut
+    die("Request wants url; example 'http://localhost:8080/PortTab')");
-sub GetHeaderMap {
-   my $r_header = shift;
-   my $ra_header = undef;
-   #if (defined $ENV{'DEBUG'}) {
-   #   print "DEBUGGING a:".ref($r_header)."\n";
-   #   print Dumper($r_header);
-   #}
-   if (ref($r_header) eq 'ARRAY') {
-      $ra_header = $r_header;
   }
-   elsif (ref($r_header) eq 'HASH' ) {
+  my $json = JSON->new;
-      if( defined $r_header->{'header'}) {
+  my $ra_data = $json->decode(`curl -s $self->{'url'}`);
-         $ra_header = $r_header->{'header'};
+  #print "---------------------------------------------------------------------\n";
+  #print Dumper($ra_data);
+  #print "---------------------------------------------------------------------\n";
+
+  $self->{'handler'} = @$ra_data[0]->{'handler'};
+  die("GuiJson response missing 'handler'") if (!defined $self->{'handler'});
+
+  $self->{'uri'}     = @$ra_data[1]->{'uri'};
+  die("GuiJson response missing 'uri'") if (!defined $self->{'uri'});
+
+  $self->{'header'}  = @$ra_data[2]->{'header'};
+  die("GuiJson response missing 'header'") if (!defined $self->{'header'});
+
+  $self->{'data'}    = @$ra_data[3]->{'data'};
+  die("GuiJson response missing 'data'") if (!defined $self->{'data'});
+
+  $self->MakeHeaderMap();
+} # ~Request
+
+sub MakeHeaderMap {
+   my $self = shift;
+   $self->{'headermap'} = {};
+   if (!defined $self->{'header'}) {
+     print STDERR Dumper($self);
+      die("MakeHeaderMap: self->{'header'} unset\n");
+   }
+   my $index = 0;
+   for my $headername (@{$self->{'header'}}) {
+      $self->{'headermap'}->{$headername} = $index;
+      $index++;
    }
 }
 
-   my $rh_headermap = {};
+sub GetHeaderMap {
-   if (!defined $ra_header) {
+  my $self = shift;
-      print STDERR "GetHeaderMap: arg1 needs to be an array of header names, you get an empty hash\n";
+  return $self->{'headermap'};
-      return $rh_headermap;
-   }
-   my $index = 0;
-   for my $headername (@$ra_header) {
-      $rh_headermap->{$headername} = $index;
-      $index++;
-   }
-   return $rh_headermap;
 }
 
 =pod
@@ -79,77 +99,134 @@ GetRecordsMatching expects results of GetGuiResponseToHash and a list of port EI
 $ra_ports = GetRecordsMatching($rh_data, $header_name, $value)
 =cut
 sub GetRecordsMatching {
-   my $rh_resp_map = shift;
+   my $self = shift;
    my $header_name = shift;
    my $ra_needles = shift;
    my $ra_results = [];
-   if (!defined $rh_resp_map || ref($rh_resp_map) ne 'HASH') {
+
-      print STDERR "GetRecordsMatching wants arg1: json data structure\n";
-      return $ra_results;
-   }
    if (!defined $header_name || $header_name eq '') {
-      print STDERR "GetRecordsMatching wants arg2: header name\n";
+      print STDERR "GetRecordsMatching wants arg1: header name\n";
       return $ra_results;
    }
-   my $rh_headers = GetHeaderMap($rh_resp_map);
+
-   if (!defined $rh_headers->{$header_name}) {
-      print STDERR "GetRecordsMatching cannot find header named <$header_name>\n";
-      return $ra_results;
-   }
-   #print "GetRecordsMatching arg3 is ".ref($ra_needles)."\n";
    if (!defined $ra_needles || ref($ra_needles) ne 'ARRAY') {
       print Dumper($ra_needles);
       my $example = q( \@portnames or ["sta1", "sta2"] not ("sta1", "sta2"));
       print STDERR "GetRecordsMatching wants arg3: list values to match against <$header_name>.\nPass array references, eg:\n$example\n";
       return $ra_results;
    }
-   #print STDERR Dumper($ra_needles);
-   #print Dumper($rh_headers);
 
    my $value = undef;
    my @matches = undef;
-   for my $ra_port (@{$rh_resp_map->{'data'}}) {
+   for my $ra_port (@{$self->{'data'}}) {
-      $value = $ra_port->[ $rh_headers->{$header_name}];
+      $value = $ra_port->[ $self->HeaderIdx($header_name)];
       #print "$header_name: $value\n";
       @matches = grep { /$value/ } @$ra_needles;
       if (@matches) {
          push(@$ra_results, $ra_port);
       }
    }
-
    return $ra_results;
+} # ~GetRecordsMatching
+
+=pod
+=head1 HeaderTrans
+HeaderTrans($name) is used to resolve header regex to a field
+name. HeaderTrans uses $headermap keys if they match exactly,
+even if the $name passed in looks like a regex. Field names
+Not found in $self->headertrans hash are then resolved as
+regexes using grep { /$name/ } @fieldnames. Only the first
+match is cached.
+
+$fieldname = HeaderIdx( "No CX (us)")
+  # plain return 'No CX (us)'
+
+$idx = HeaderIdx( "No CX.*")
+  # regex evaluated only if 'No CX.*' doesn't exist
+  # as a literal key in $self->headertrans
+=cut
+sub HeaderTrans {
+  my $self = shift;
+  my $headername = shift;
+  my %headermap = %{$self->{'headermap'}};
+  $self->{'headertrans'} = {}
+    if (!defined $self->{'headertrans'});
+
+  if (!defined $headername || "$headername" eq "") {
+    die("HeaderTrans: Header name is empty or unset, bye\n");
+    return -1;
   }
+  my %headertrans = %{$self->{'headertrans'}};
+
+  if (defined $headertrans{$headername}) {
+    return $headertrans{$headername};
+  }
+  if (defined $headermap{$headername}) {
+    $headertrans{$headername} = $headername;
+    return $headername;
+  }
+  # look for regex matches next
+  my @matches = grep { /$headername/ } keys %{$self->{'headermap'}};
+  if (@matches < 1) {
+    print STDERR "HeaderTrans: Headermap name <$headername> unmached, you get -1.\n";
+    $headertrans{$headername} = -1;
+    return -1;
+  }
+  my $a = $matches[0];
+  $headertrans{$headername} = $a;
+  if (@matches > 1) {
+    print STDERR "Headermap name <$headername> has multiple matches, you get $a.\n";
+  }
+  return $a;
+}
+
+=pod
+=head1 HeaderIdx
+HeaderIdx($name) is used to resolve header name to index in
+array holding record data. HeaderIdx uses HeaderTrans() to
+map names ore regexes to resolved field names and only do
+regex lookups once per pattern.
+$idx = HeaderIdx( "Alias")   # plain name
+$idx = HeaderIdx( "No CX.*") # regex
+=cut
+sub HeaderIdx {
+  my $self = shift;
+  my $headername = shift;
+  my %headermap = %{$self->{'headermap'}};
+
+  if (!defined $headername || "$headername" eq "") {
+    die("Header name is empty or unset, bye\n");
+    return -1;
+  }
+  my $key = $self->HeaderTrans($headername);
+
+  if (defined $headermap{$key}) {
+    return $headermap{$key};
+  }
+  print STDERR "headermap{$key} undefined, you get -1\n";
+  return -1;
+} # ~HeaderIdx
 
 =pod
 =head1 GetFields
 Returns matching fields from a record;
 $ra_needles are an array of strings to match to select records
 $ra_field_names are field names to return from those records
-$rh = GetFields($rh_response_map, $header_name, $ra_needles, $ra_field_names)
+$rh = GetFields($header_name, $ra_needles, $ra_field_names)
 =cut
 sub GetFields {
-  my $rh_resp_map = shift;
+  my $self = shift;
   my $header_name = shift;
   my $ra_needles = shift;
   my $ra_field_names = shift;
   my $ra_records = [];
   my $rh_field_values = {};
 
-  if (!defined $rh_resp_map || ref($rh_resp_map) ne 'HASH') {
-     print STDERR "GetFields wants arg1: json data structure\n";
-     return $rh_field_values;
-  }
   if (!defined $header_name || $header_name eq '') {
      print STDERR "GetFields wants arg2: header name\n";
      return $rh_field_values;
   }
-  my $rh_headers = GetHeaderMap($rh_resp_map);
-  #print "Header names: ". Dumper($rh_headers);
 
-  if (!defined $rh_headers->{$header_name}) {
-     print STDERR "GetFields cannot find header named <$header_name>\n";
-     return $rh_field_values;
-  }
   if (!defined $ra_needles || ref($ra_needles) ne 'ARRAY') {
      print Dumper($ra_needles);
 
@@ -162,28 +239,27 @@ sub GetFields {
      return $rh_field_values;
   }
 
-  $ra_records = GetRecordsMatching($rh_resp_map, $header_name, $ra_needles);
+  $ra_records = $self->GetRecordsMatching($header_name, $ra_needles);
   return $rh_field_values if (@$ra_records < 1);
 
   for my $ra_record (@$ra_records) {
     next if (@$ra_record < 1);
-    next if (! defined @$ra_record[$rh_headers->{$header_name}]);
+    next if (! defined @$ra_record[$self->HeaderIdx($header_name)]);
-    my $record_name = @$ra_record[$rh_headers->{$header_name}];
+    my $record_name = @$ra_record[$self->HeaderIdx($header_name)];
     next if (!defined $record_name || "$record_name" eq "");
     #print "record name[$record_name]\n";
-
     #print Dumper($ra_record);
     my $rh_record_vals = {};
     $rh_field_values->{$record_name} = $rh_record_vals;
     #print Dumper($ra_field_names);
 
     for my $field_name (@$ra_field_names) {
-      next if (!defined $rh_headers->{$field_name});
-      my $field_idx = $rh_headers->{$field_name};
       next if (!defined $field_name || "$field_name" eq "");
-      next if (!defined @$ra_record[$rh_headers->{$field_name}]);
+      my $xl_name = $self->HeaderTrans($field_name);
+      my $field_idx = $self->HeaderIdx($xl_name);
+      next if (!defined @$ra_record[$field_idx]);
       #print "Field Name $field_name [".@$ra_record[$field_idx]."] ";
-      $rh_record_vals->{$field_name} = @$ra_record[$field_idx];
+      $rh_record_vals->{$xl_name} = @$ra_record[$field_idx];
     }
     #print Dumper($rh_record_vals);
   }

lf_wifi_rest_example.pl

@@ -500,15 +500,13 @@ sleep(2);
 #
 
 # Get a JSON dump of all rows and columns on the LANforge GUI Ports Tab.
-my $port_tab = `curl -sq http://localhost:8080/PortTab`;
+my $gjson = new LANforge::GuiJson();
-my $ports_data = GuiResponseToHash($port_tab);
+$gjson->Request("http://localhost:8080/PortTab");
-#my $ports_data = decode_json($port_tab);
-#print Dumper($ports_data);
 
 # Grab data for these fields for all of our ports in use in this test.
 my @field_names = ("bps TX", "bps RX", "TX-Rate", "RX-Rate", "AP", "Channel", "CX Time.*");
 my @port_names = (@stations, $upstream);
-my $ra_fields = GetFields($ports_data, 'Device', \@port_names, \@field_names);
+my $ra_fields = $gjson->GetFields('Device', \@port_names, \@field_names);
 
 # And print out the JSON data on the console.  This is just an example, you may
 # instead wish to grab different data and graph it and/or poke it into some long-term

show-port-from-json.pl

@@ -3,27 +3,48 @@
 use strict;
 use warnings;
 use diagnostics;
-use JSON;
+#use JSON;
 use Data::Dumper;
-use LANforge::GuiJson qw(GuiResponseToHash GetHeaderMap GetRecordsMatching GetFields);
+use LANforge::GuiJson;
+#GuiResponseToHash GetHeaderMap GetRecordsMatching GetFields
 package main;
 
-my $respdata=`curl -s http://localhost:8080/PortTab`;
-#my $ra_ports_data = decode_json($respdata);
-my $ra_resp_map = GuiResponseToHash($respdata);
-my $ra_header = GetHeaderMap($ra_resp_map->{'header'});
-#print Dumper($ra_header);
 
-my $ra_matches = GetRecordsMatching($ra_resp_map, 'Port', ["eth0", "wlan0"]);
+my $gjson = new LANforge::GuiJson();
-#print "Records matching Port:\n";
+$gjson->Request("http://localhost:8080/PortTab");
-#print Dumper($ra_matches);
 
 my @port_names = ("eth0", "wlan0");
-$ra_matches = GetRecordsMatching($ra_resp_map, 'Device', \@port_names);
+my $ra_matches = $gjson->GetRecordsMatching('Alias', \@port_names);
+#print "Records matching Alias (eth0, wlan0):\n";
+#print Dumper($ra_matches);
+
+$ra_matches = $gjson->GetRecordsMatching('Device', \@port_names);
 #print "Records matching Port:\n";
 #print Dumper($ra_matches);
 
-my @field_names = ("bps TX", "bps RX");
+my @field_names = ("Device", "bps TX", "bps RX");
-my $ra_fields = GetFields($ra_resp_map, 'Device', \@port_names, \@field_names);
+my $ra_fields = $gjson->GetFields('Device', \@port_names, \@field_names);
 print "Fields (".join(", ", @field_names).") from records matching Device (".join(", ", @port_names)."):\n";
 print Dumper($ra_fields);
+
+@field_names = ("Alias", "RX-.*", "No CX.*");
+$ra_fields = $gjson->GetFields('Device', \@port_names, \@field_names);
+print "Fields (".join(", ", @field_names).") from records matching Device (".join(", ", @port_names)."):\n";
+print Dumper($ra_fields);
+
+
+=pod
+10:57 < greearb> lets just do regex since we may have funny spaces or other characters in column headers
+10:59 < greearb> GetFields wants arg1: json data structure
+10:59 < greearb> Fields (bps TX, bps RX, TX-Rate, RX-Rate, AP, Channel, CX Time.*) from records matching Device (sta010, sta011, sta012, sta013, sta014,
+                 eth5):
+10:59 < greearb> $VAR1 = {};
+10:59 < greearb> my $port_tab = `curl -sq http://localhost:8080/PortTab`;
+10:59 < greearb> my $ports_data = decode_json($port_tab);
+10:59 < greearb> #print Dumper($ports_data);
+10:59 < greearb> my @field_names = ("bps TX", "bps RX", "TX-Rate", "RX-Rate", "AP", "Channel", "CX Time.*");
+10:59 < greearb> my @port_names = (@stations, $upstream);
+10:59 < greearb> my $ra_fields = GetFields($ports_data, 'Device', \@port_names, \@field_names);
+10:59 < greearb> print "Fields (".join(", ", @field_names).") from records matching Device (".join(", ", @port_names)."):\n";
+10:59 < greearb> print Dumper($ra_fields);
+=cut