From 1138dffc100d7ae51ac15587ef4e4b7dd99c8350 Mon Sep 17 00:00:00 2001 From: Ben Greear Date: Fri, 6 Oct 2017 15:44:06 -0700 Subject: [PATCH] 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 | 226 +++++++++++++++++++++++++++------------- lf_wifi_rest_example.pl | 8 +- show-port-from-json.pl | 47 ++++++--- 3 files changed, 188 insertions(+), 93 deletions(-) mode change 100755 => 100644 show-port-from-json.pl diff --git a/LANforge/GuiJson.pm b/LANforge/GuiJson.pm index ee08eb83..651b5cbf 100644 --- a/LANforge/GuiJson.pm +++ b/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 -=cut -sub GuiResponseToArray { - my $response = shift; - my $ra_data = decode_json($response); - return $ra_data; + +sub new { + my $this = { + 'url' => undef, + 'handler' => undef, + 'uri' => undef, + '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 -=head1 GetHeaderMap -GuiJson::GenHeaderMap expects a reference to a header array like -{ 'header' => ['a', 'b', 'c']} -=cut -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' ) { - if( defined $r_header->{'header'}) { - $ra_header = $r_header->{'header'}; - } - } +sub Request { + my $self = shift; + $self->{'url'} = shift; + if (!defined $self->{'url'}) { + die("Request wants url; example 'http://localhost:8080/PortTab')"); + } + my $json = JSON->new; + my $ra_data = $json->decode(`curl -s $self->{'url'}`); + #print "---------------------------------------------------------------------\n"; + #print Dumper($ra_data); + #print "---------------------------------------------------------------------\n"; - my $rh_headermap = {}; - if (!defined $ra_header) { - print STDERR "GetHeaderMap: arg1 needs to be an array of header names, you get an empty hash\n"; - return $rh_headermap; + $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 (@$ra_header) { - $rh_headermap->{$headername} = $index; + for my $headername (@{$self->{'header'}}) { + $self->{'headermap'}->{$headername} = $index; $index++; } - return $rh_headermap; +} + +sub GetHeaderMap { + my $self = shift; + return $self->{'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'}}) { - $value = $ra_port->[ $rh_headers->{$header_name}]; + for my $ra_port (@{$self->{'data'}}) { + $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}]); - my $record_name = @$ra_record[$rh_headers->{$header_name}]; + next if (! defined @$ra_record[$self->HeaderIdx($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); } diff --git a/lf_wifi_rest_example.pl b/lf_wifi_rest_example.pl index 641c97c2..1bd93faf 100755 --- a/lf_wifi_rest_example.pl +++ b/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 $ports_data = GuiResponseToHash($port_tab); -#my $ports_data = decode_json($port_tab); -#print Dumper($ports_data); +my $gjson = new LANforge::GuiJson(); +$gjson->Request("http://localhost:8080/PortTab"); # 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 diff --git a/show-port-from-json.pl b/show-port-from-json.pl old mode 100755 new mode 100644 index 32fb65f2..9a28ec29 --- a/show-port-from-json.pl +++ b/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"]); -#print "Records matching Port:\n"; -#print Dumper($ra_matches); +my $gjson = new LANforge::GuiJson(); +$gjson->Request("http://localhost:8080/PortTab"); 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 $ra_fields = GetFields($ra_resp_map, 'Device', \@port_names, \@field_names); +my @field_names = ("Device", "bps TX", "bps RX"); +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