diff --git a/LANforge/JsonUtils.pm b/LANforge/JsonUtils.pm new file mode 100644 index 00000000..642a1562 --- /dev/null +++ b/LANforge/JsonUtils.pm @@ -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; \ No newline at end of file diff --git a/json/test_sta_mode.pl b/json/test_sta_mode.pl new file mode 100755 index 00000000..6ba5b78d --- /dev/null +++ b/json/test_sta_mode.pl @@ -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); + + +# \ No newline at end of file