scottk/wlan-lanforge-scripts
1
0
Fork 0
mirror of https://github.com/Telecominfraproject/wlan-lanforge-scripts.git synced 2025-10-28 17:32:35 +00:00
Code Issues Packages Projects Releases Wiki Activity

Use an OO framework for the GuiJson library module.

Browse Source 
Jed's changes, with a tweak to the lf_wifi_reset_example.pl to use
the new OO methods.
This commit is contained in:
Ben Greear
2017-10-06 15:44:06 -07:00
parent a2df72bdcc
commit 1138dffc10
3 changed files with 188 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files

226
LANforge/GuiJson.pm
View File

@@ -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);
}

8
lf_wifi_rest_example.pl
View File

@@ -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

47
show-port-from-json.pl Executable file → Normal file
View File

@@ -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