1 files changed, 133 insertions, 0 deletions
diff --git a/lib/Net/Ping903.pm b/lib/Net/Ping903.pm
new file mode 100644
index 0000000..a23f61a
--- /dev/null
+++ b/lib/Net/Ping903.pm
@@ -0,0 +1,133 @@
+package Net::Ping903;
+use strict;
+use warnings;
+use LWP::Ping903;
+use JSON;
+use Carp;
+use HTTP::Status qw(:constants);
+
+my $VERSION = '0.3';
+
+sub new {
+    my $class = shift;
+    my $baseurl = shift;
+    my $ua = new LWP::Ping903(@_);
+    bless { baseurl => $baseurl, ua => $ua }, $class;
+}
+
+sub get_config {
+    my ($self, $param) = @_;
+    my $url = "$self->{baseurl}/config";
+    $url .= '/' . $param if $param;
+    my $resp = $self->{ua}->get($url);
+    $self->response($resp);
+    unless ($resp->is_success) {
+	$self->_set_error;
+	return
+    }
+    if (my $ctype = $resp->header('Content-Type')) { 
+	if ($ctype ne 'application/json') {	
+	    $self->{error} = {	
+		message => 'Unsupported Content-Type in response'
+	    };
+	    return;
+	}
+    } else {
+	$self->{error} = {	
+		message => 'No Content-Type in response'
+	};
+        return;
+    }	
+    return JSON->new->decode($resp->decoded_content);
+}
+
+sub error_message {
+    my $self = shift;
+    if ($self->{error} && exists($self->{error}{message})) {
+	my $msg = $self->{error}{message};
+	if ($self->{error}{index}) {
+	    $msg .= " at #$self->{error}{index}";
+	}
+	return $msg;
+    }
+    if ($self->response) {
+	return $self->response->status_line;
+    }
+}
+
+sub error_index {
+    my $self = shift;
+    return unless $self->{error};
+    return $self->{error}{index};
+}
+
+sub response {
+    my $self = shift;
+    if (@_) {
+	$self->{response} = shift;
+    }
+    return $self->{response};
+}
+
+sub _set_error {
+    my $self = shift;
+
+    my $ctype = $self->response->header('Content-Type');
+    if ($ctype && $ctype eq 'application/json') {
+	$self->{error} = JSON->new->decode($self->response->decoded_content);
+    } elsif ($self->response->code eq HTTP_UNAUTHORIZED) {
+	my $s = $self->response->header('WWW-Authenticate');
+	$s =~ s/Basic realm=//;
+	$s =~ s/^"(.*)"$/$1/;
+	$s =~ s/\\([\\\"])/$1/g;
+	$self->{error} = { message => "$s: not authorized" };
+    } else {
+	$self->{error} = {};
+    }
+}
+
+sub ipadd {
+    my ($self, $ip) = @_;
+    my $resp = $self->{ua}->put("$self->{baseurl}/config/ip-list/$ip");
+    $self->response($resp);
+    if ($resp->is_success) {
+	if ($resp->code != HTTP_CREATED) {
+	    $self->{error} = { message => 'Unexpected response code' };
+        }
+    } else {
+	$self->_set_error
+    }
+    return $resp->is_success;
+}
+
+sub ipdel {
+    my ($self, $ip) = @_;
+    my $resp = $self->{ua}->delete("$self->{baseurl}/config/ip-list/$ip");
+    $self->response($resp);
+    unless ($resp->is_success) {
+	$self->_set_error;
+    }		
+    return $resp->is_success;
+}
+
+sub set_ip_list {
+    my ($self, $lref) = @_;
+
+    my $json_text = JSON->new->encode({
+	'mode' => 'replace',	
+	'ip-list' => $lref
+    });
+    
+    my $resp = $self->{ua}->post("$self->{baseurl}/config/ip-list",
+				 'Content-Type' => 'application/json',
+				 'Content' => $json_text);
+
+    $self->response($resp);
+    unless ($resp->is_success) {
+	$self->_set_error;
+    }		
+    return $resp->is_success;
+}
+    
+1;
+