view release on metacpan or  search on metacpan

lib/Domain/Register/DomainShare.pm  view on Meta::CPAN

    $self->{_client} = REST::Client->new({ host => 'https://api.domainshare.tk', timeout => 10 });
    
    return $self;
}

sub ping {
    my ($self) = @_;
    $self->_make_request('ping', undef, [], {});
}

sub availability_check {
    my ($self, $args) = @_;
    $self->_make_request('availability_check', undef, ['email', 'password', 'domainname'], $args);
}

sub register {
    my ($self, $args) = @_;
    $self->_make_request('register', 'registration', ['email', 'password', 'domainname', 'enduseremail'], $args);
}

sub renew {
    my ($self, $args) = @_;
    $self->_make_request('renew', undef, ['email', 'password', 'domainname'], $args);
}

sub host_registration {
    my ($self, $args) = @_;
    $self->_make_request('host_registration', undef, ['email', 'password', 'hostname', 'ipaddress'], $args);
}

sub host_removal {
    my ($self, $args) = @_;
    $self->_make_request('host_removal', undef, ['email', 'password', 'hostname'], $args);
}

sub host_list {
    my ($self, $args) = @_;
    $self->_make_request('host_list', undef, ['email', 'password', 'domainname'], $args);
}

sub modify {
    my ($self, $args) = @_;
    $self->_make_request('modify', undef, ['email', 'password', 'domainname'], $args);
}

sub resend_email {
    my ($self, $args) = @_;
    $self->_make_request('resend_email', undef, ['email', 'password', 'domainname'], $args);
}

sub domain_deactivate {
    my ($self, $args) = @_;
    $self->_make_request('domain_deactivate', undef, ['email', 'password', 'domainname', 'reason'], $args);
}

sub domain_reactivate {
    my ($self, $args) = @_;
    $self->_make_request('domain_reactivate', undef, ['email', 'password', 'domainname'], $args);
}

sub update_parking {
    my ($self, $args) = @_;
    $self->_make_request('update_parking', undef, ['email', 'password', 'domainname'], $args);
}


sub _make_request {
    my ($self, $name, $xmlname, $fields, $args) = @_;
    $xmlname ||= $name;

    my ($status, $errors) = check_mandatory_fields($args, @$fields);
    return ($status, $errors) unless ($status);
    $self->{_client}->POST("/$name", prepare_post_body($args) );

    print $self->{_client}->responseContent() if $::DotTKDebug;
    my $xc = XMLin($self->{_client}->responseContent());

    return parse_server_reply($xc, $xmlname);
}

sub prepare_post_body {
  my ($args) = @_;
  join ( '&', map {
    my $key = $_;
    if (ref $args->{$key} eq 'ARRAY') {
      my @a = map { URI::Escape::uri_escape($key) . '=' . URI::Escape::uri_escape($_) } @{$args->{$key}};
    } else {
      URI::Escape::uri_escape($key) . '=' . URI::Escape::uri_escape($args->{$_});
    }
    ;
  } (keys %$args));
  #join ( '&', (map { URI::Escape::uri_escape($_) . '=' . URI::Escape::uri_escape($args->{$_}) } keys %$args));
}

sub check_mandatory_fields
{
  my ( $args, @names) = @_;
  for my $name (@names) {
    if ((!defined($args->{$name})) || (length($args->{$name}) == 0)) {
      return (0, { type => "Input error", reason => "$name is mandatory"} );
    }
  }
  return (1, undef);
}

sub parse_server_reply
{
  my ($xc, $namespace) = @_;
  if ($xc->{status} eq 'OK') {
    return (1, values_for($xc, $namespace));
  } else {
    return (0, { type => "Server Error", reason => $xc->{reason} });
  }
}

sub values_for
{
  my ($xc, $namespace) = @_;
  $xc->{"partner_$namespace"};
}