view release on metacpan or  search on metacpan

lib/DNS/NIOS.pm  view on Meta::CPAN

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