scottk/wlan-lanforge-scripts
1
0
Fork 0
mirror of https://github.com/Telecominfraproject/wlan-lanforge-scripts.git synced 2025-11-01 03:07:56 +00:00
Code Issues Packages Projects Releases Wiki Activity

new testing script; new script library

Browse Source
This commit is contained in:
Jed Reynolds
2018-08-08 10:46:30 -07:00
parent 3b0ffd8d27
commit a1c5833a1a
2 changed files with 132 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

79
LANforge/JsonUtils.pm Normal file
View File

@@ -0,0 +1,79 @@
# JsonUtils
package LANforge::JsonUtils;
use strict;
use warnings;
use diagnostics;
use Carp;
$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
$SIG{ __WARN__ } = sub { Carp::confess( @_ ) };
# Un-buffer output
$| = 1;
use Getopt::Long;
use JSON::XS;
use HTTP::Request;
use LWP;
use LWP::UserAgent;
use JSON;
if (defined $ENV{'DEBUG'}) {
use Data::Dumper;
use diagnostics;
use Carp;
$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
}
our $NL="\n";
our @EXPORT_OK=qw(err logg xpand json_request get_links_from);
sub err {
my $i;
for $i (@_) {
print STDERR "$i";
}
print STDERR $::NL;
}
sub logg {
my $i;
for $i (@_) {
print STDOUT "$i";
}
print STDOUT $::NL;
}
sub xpand {
my ($rrl) = @_;
die("Will not expand a blank URI") if ("" eq $rrl || $rrl =~ m/^\s*$/);
return $rrl if ($rrl =~ /^http/);
return $rrl if ($rrl =~ m{^$main::HostUri/});
return "${main::HostUri}$rrl" if ($rrl =~ m{^/});
return "${main::HostUri}/$rrl";
}
sub json_request {
my ($uri) = @_;
my $url = xpand($uri);
logg("$uri becomes $url\n");
my $req = new HTTP::Request("GET", $url);
$req->header("Accept" => "application/json");
my $response = $::Web->request($req);
return $::Decoder->decode($response->content);
}
sub get_links_from {
my ($rh_glf, $arrayname) = @_;
my $ra_glf2 = $rh_glf->{$arrayname};
my $ra_glf_links2 = [];
for my $rh_glf2 (@$ra_glf2) {
for my $key (keys %$rh_glf2) {
my $v = $rh_glf2->{$key};
next if (!(defined $v->{'_links'}));
push(@$ra_glf_links2, $v->{'_links'});
}
}
#print Dumper($ra_links2);
return $ra_glf_links2;
}
1;

53
json/test_sta_mode.pl Executable file
View File

@@ -0,0 +1,53 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use diagnostics;
use Carp;
$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
$SIG{ __WARN__ } = sub { Carp::confess( @_ ) };
# Un-buffer output
$| = 1;
use Getopt::Long;
use JSON::XS;
use HTTP::Request;
use LWP;
use LWP::UserAgent;
use Data::Dumper;
use JSON;
use lib '/home/lanforge/scripts';
use LANforge::JsonUtils qw(err logg xpand json_request);
package main;
# Default values for ye ole cmd-line args.
our $Resource = 1;
our $quiet = "yes";
our $Host = "localhost";
our $Port = 8080;
our $HostUri = "http://$Host:$Port";
our $Web = LWP::UserAgent->new;
our $Decoder = JSON->new->utf8;
my $usage = qq($0: --host [hostname] # hostname or IP to query
--port [port] # port like 8080
);
##
## M A I N
##
GetOptions
(
'port=i' => \$::Port,
'host=s' => \$::Host,
) || (print($usage) && exit(1));
$HostUri = "http://$Host:$Port";
my $uri = "/port/1/3/sta3100";
my $rh = json_request($uri);
print Dumper($rh);
#