File Coverage

blib/lib/DNS/NIOS.pm

Criterion	Covered	Total	%
statement	76	76	100.0
branch	16	22	72.7
condition	15	23	65.2
subroutine	16	16	100.0
pod	4	5	80.0
total	127	142	89.4

#
# This file is part of DNS-NIOS
#
# This software is Copyright (c) 2021 by Christian Segundo.
#
# This is free software, licensed under:
#
#   The Artistic License 2.0 (GPL Compatible)
#
## no critic
package DNS::NIOS;
$DNS::NIOS::VERSION = '0.004';

# ABSTRACT: Perl binding for NIOS
# VERSION
# AUTHORITY

## use critic
use strictures 2;

use Carp qw(croak);
use JSON qw(to_json);
use LWP::UserAgent;
use MIME::Base64 qw(encode_base64);
use URI;
use URI::QueryParam;
use DNS::NIOS::Response;
use Role::Tiny::With;

use Class::Tiny qw( password username wapi_addr traits ),
  {
  wapi_version => 'v2.7',
  scheme       => 'https',
  insecure     => 0,
  timeout      => 10,
  debug        => $ENV{NIOS_DEBUG}
  };

sub BUILD {
  my ( $self, $args ) = @_;

  defined( $self->$_ )
    or croak("$_ is required!")
    for qw(username password wapi_addr); ## no critic (ControlStructures::ProhibitPostfixControls)

  ( ( $self->scheme eq 'http' ) or ( $self->scheme eq 'https' ) )
    or croak( "scheme not supported: " . $self->scheme );

  $self->{base_url} =
      $self->scheme . "://"
    . $self->wapi_addr
    . "/wapi/"
    . $self->wapi_version . "/";

  $self->{ua} = LWP::UserAgent->new( timeout => $self->timeout );
  $self->{ua}->agent( 'NIOS-perl/' . $DNS::NIOS::VERSION );
  $self->{ua}->ssl_opts( verify_hostname => 0, SSL_verify_mode => 0x00 )
    if $self->insecure and $self->scheme eq 'https'; ## no critic (ControlStructures::ProhibitPostfixControls)
  $self->{ua}->default_header( 'Accept'       => 'application/json' );
  $self->{ua}->default_header( 'Content-Type' => 'application/json' );
  $self->{ua}->default_header( 'Authorization' => 'Basic '
      . encode_base64( $self->username . ":" . $self->password ) );

  if ( $self->traits ) {
    foreach ( @{ $self->traits } ) {
      with $_;
    }
  }
}

sub create {
  my ( $self, %args ) = @_;

  defined( $args{$_} )
    or croak("$_ is required!")
    for qw(path payload);

  return $self->__request( 'POST', $args{path},
    ( payload => $args{payload}, params => $args{params} ) );
}

sub update {
  my ( $self, %args ) = @_;

  defined( $args{$_} )
    or croak("$_ is required!")
    for qw(path payload);

  return $self->__request( 'PUT', $args{path},
    ( payload => $args{payload}, params => $args{params} ) );
}

sub get {
  my ( $self, %args ) = @_;

  defined( $args{path} )
    or croak("path is required!");

  return $self->__request( 'GET', $args{path}, ( params => $args{params} ) );
}

sub delete {
  my ( $self, %args ) = @_;

  defined( $args{path} )
    or croak("path is required!");

  return $self->__request( 'DELETE', $args{path}, ( params => $args{params} ) );
}

sub __request {
  my ( $self, $op, $path, %args ) = @_;

  my $payload      = delete $args{payload};
  my $params       = delete $args{params};
  my $query_params = q{};

  grep( /(^\Q$op\E$)/, qw(GET POST PUT DELETE) )
    or die("invalid operation: $op");

  croak("invalid path") unless ( defined $path and length $path );

  if ( $op eq 'PUT' or $op eq 'POST' ) {
    croak("invalid payload") unless keys %{$payload};
  }

  if ( defined $params ) {
    my $u = URI->new( q{}, 'http' );
    $query_params = q{?};
    foreach ( keys %{$params} ) {
      $u->query_param( $_ => $params->{$_} );
    }
    $query_params .= $u->query;
  }

  my $request =
    HTTP::Request->new( $op, $self->{base_url} . $path . $query_params );

  if ( $op eq 'PUT' or $op eq 'POST' ) {
    $request->content( to_json($payload) );
  }

  return DNS::NIOS::Response->new(
    _http_response => $self->{ua}->request($request) );
}

1;

__END__