wlan-lanforge-scripts/LANforge/JsonUtils.pm

# 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";
use Exporter 'import';
our @EXPORT_OK=qw(err logg xpand json_request get_links_from get_thru json_post get_port_names);

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);
   if ($response->code != 200) {
      err("Status ".$response->code.": ".$response->content."\n");
      if ($response->content =~ /(Can't connect|Connection refused)/) {
         exit(1);
      }
      return {};
   }
   #print Dumper($response);
   return $::Decoder->decode($response->content);
}

sub json_post {
   my ($uri, $rh_data) = @_;
   my $url = xpand($uri);
   my $req = HTTP::Request->new("POST" => $url);
   $req->header('Accept' => 'application/json');
   $req->header('Content-Type' => 'application/json; charset=UTF-8');
   $req->content(encode_json($rh_data));
   #print Dumper($req);
   my $response = $::Web->request($req);
   #print Dumper($response);
   if ($response->code != 200) {
      err("Status ".$response->code.": ".$response->content."\n");
      if ($response->content =~ /(Can't connect|Connection refused)/) {
         exit(1);
      }
      return {};
   }
   return $::Decoder->decode($response->content);
}

sub get_port_names {
   my ($rh_gpn, $arrayname) = @_;
   my $ra_gpn2 = $rh_gpn->{$arrayname};
   my $ra_gpn_links2 = [];
   #print Dumper($ra_gpn2);
   for my $rh_gpn2 (@$ra_gpn2) {
      #print Dumper($rh_gpn2);
      for my $key (keys %$rh_gpn2) {
         my $v = $rh_gpn2->{$key};
         next if (!(defined $v->{'_links'}));
         my $rh_i = {
            'uri' => $v->{'_links'},
            'alias' => $v->{'alias'}
         };
         push(@$ra_gpn_links2, $rh_i);
      }
   }
   #print Dumper($ra_links2);
   return $ra_gpn_links2;
}

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

# eg get_thru( 'interface', 'device' )
sub get_thru {
   my ($inner, $key, $rh_top) = @_;
   if (!(defined $rh_top->{$inner})) {
      print Dumper($rh_top);
      return -1;
   }
   my $rh_inner = $rh_top->{$inner};
   return $rh_inner->{$key};
}
1;