File Coverage

blib/lib/IO/EPP/CoCCA.pm

Criterion	Covered	Total	%
statement	12	48	25.0
branch	0	12	0.0
condition	0	17	0.0
subroutine	4	9	44.4
pod	5	5	100.0
total	21	91	23.0

package IO::EPP::CoCCA;

=encoding utf8

=head1 NAME

IO::EPP::CoCCA

=head1 SYNOPSIS

    use IO::EPP::CoCCA;

    # Parameters for IO::Socket::SSL
    my %sock_params = (
        PeerHost        => 'registry.rusnames.net',
        PeerPort        => 700,
        # without certificate
        Timeout         => 30,
    );

    # Create object, get greeting and call login()
    my $conn = IO::EPP::CoCCA->new( {
        user => 'login',
        pass => 'xxxx',
        sock_params => \%sock_params,
        test_mode => 0, # real connect
    } );

    # Check domain
    my ( $answ, $code, $msg ) = $conn->check_domains( { domains => [ 'xn--d1acufc.xn--p1acf' ] } );

    # Call logout() and destroy object
    undef $conn;

=head1 DESCRIPTION

Module for work with  .РУС/.xn--p1acf, .CX, ... tlds. All list see on https://cocca.org.nz/#five

Frontends:
https://rusnames.com/
https://cocca.org.nz/

Backend:
https://secure.coccaregistry.net/

CoCCA features:

- not show authinfo in domain:info

=cut

use IO::EPP::Base;
use parent qw( IO::EPP::Base );

use strict;
use warnings;


my $rgp_ext = 'xmlns:rgp="urn:ietf:params:xml:ns:rgp-1.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:ietf:params:xml:ns:rgp-1.0 rgp-1.0.xsd"';


sub make_request {
    my ( $action, $params ) = @_;

    my ( $self, $code, $msg, $answ );

    unless ( $params->{conn} ) {
        $params->{sock_params}{PeerHost} ||= 'registry.rusnames.net'; # .РУС / .xn--p1acf
        $params->{sock_params}{PeerPort} ||= 700;

        ( $self, $code, $msg ) = __PACKAGE__->new( $params );

        unless ( $code  and  $code == 1000 ) {
            goto END_MR;
        }
    }
    else {
        $self = $params->{conn};
    }


    $self->{critical_error} = '';

    if ( $self->can( $action ) ) {
        ( $answ, $code, $msg ) = $self->$action( $params );
    }
    else {
        $msg = "undefined command <$action>, request cancelled";
        $code = 0;
    }


END_MR:

    $msg .= '; ' . $self->{critical_error} if $self->{critical_error};

    my $full_answ = "code: $code\nmsg: $msg";

    $answ = {} unless $answ && ref $answ;

    $answ->{code} = $code;
    $answ->{msg}  = $msg;

    return wantarray ? ( $answ, $full_answ, $self ) : $answ;
}

=head1 METHODS

Next, those functions are redefined in which the provider has additions to the EPP

=head2 login

Ext params for login,

INPUT: new password for change

=cut

sub login {
    my ( $self, $pw ) = @_;

    my $svcs = '
    urn:ietf:params:xml:ns:contact-1.0
    urn:ietf:params:xml:ns:domain-1.0
    urn:ietf:params:xml:ns:host-1.0';
    my $extension = '
     urn:ietf:params:xml:ns:rgp-1.0
     https://production.coccaregistry.net/cocca-ip-verification-1.1
     https://production.coccaregistry.net/cocca-contact-proxy-1.0
     https://production.coccaregistry.net/cocca-contact-proxy-create-update-1.0
     https://production.coccaregistry.net/cocca-reseller-1.0
     urn:ietf:params:xml:ns:secDNS-1.1
     urn:ietf:params:xml:ns:fee-0.8';

    return $self->SUPER::login( $pw, $svcs, $extension );
}



sub create_domain {
    my ( $self, $params ) = @_;

    $params->{authinfo} ||= IO::EPP::Base::gen_pw();

    $params->{extension} =
'
    RUB
    '.$params->{price}.'
   ';

    return $self->SUPER::create_domain( $params );
}

=head2 restore_domain

Domain redemption

INPUT:
params key C -- name of the domain to be redeemed

OUTPUT:
see L.

=cut

sub restore_domain {
    my ( $self, $params ) = @_;

    $params->{extension} =
"

   ";

    return $self->SUPER::update_domain( $params );
}


=head2 confirmations_restore_domain

Confirmation of domain redemption

INPUT:
C   -- whois before delete, can set 'none';
C  -- whois on now, can set 'none';
C   -- date-time of domain deletion in UTC;
C  -- date-time of sending the redemption request in UTC.

Fields already filled in:
C -- the reason for the redemption;
C -- write that this is all for the client, not for us;
C     -- can be without additions.

=cut

sub confirmations_restore_domain {
    my ( $self, $params ) = @_;

    $params->{pre_data} ||= 'none';
    $params->{post_data} ||= 'none';

    $params->{extension} = <



          $$params{pre_data}
          $$params{post_data}
          $$params{del_time}
          $$params{rest_time}
          Customer forgot to renew.
          I agree that the Domain Name has not been restored in order to assume the rights to use or sell the name to myself or for any third party.
          I agree that the information provided in this Restore Report is true to the best of my knowledge, and acknowledge that intentionally supplying false information in the Restore Report shall constitute an incurable material breach of the Registry-Registrar Agreement.




RGPEXT

    return $self->SUPER::update_domain( $params );
}


1;

__END__