File Coverage

blib/lib/IO/EPP/TCI.pm

Criterion	Covered	Total	%
statement	12	104	11.5
branch	0	42	0.0
condition	0	16	0.0
subroutine	4	11	36.3
pod	6	7	85.7
total	22	180	12.2

package IO::EPP::TCI;

=encoding utf8

=head1 NAME

IO::EPP::TCI

=head1 SYNOPSIS

    use IO::EPP::TCI;

    # Parameters for IO::Socket::SSL
    my %sock_params = (
        PeerHost        => 'uap.tcinet.ru',
        PeerPort        => 8130, # .дети 8130, .tatar 8131
        SSL_key_file    => 'key_file.pem',
        SSL_cert_file   => 'cert_file.pem',
        Timeout         => 30,
    );

    # Create object, get greeting and call login()
    my $conn = IO::EPP::TCI->new( {
        user => 'XXX-DETI',
        pass => 'XXXXXXXX',
        sock_params => \%sock_params,
        server => 'afilias', # or pir, ...
        test_mode => 0, # real connect
    } );

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

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

=head1 DESCRIPTION

Work with normal TCI EPP API

.дети/.xn--d1acj3b documents:
L, L

.tatar documents:
L, L

=cut

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

use strict;
use warnings;

my $cont_ext =
'xmlns:contact="http://www.tcinet.ru/epp/tci-contact-ext-1.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://www.tcinet.ru/epp/tci-contact-ext-1.0 tci-contact-ext-1.0.xsd"';

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

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

    unless ( $params->{conn} ) {
        $params->{sock_params}{PeerHost} ||= 'uap.tcinet.ru';
        $params->{sock_params}{PeerPort} ||= 8130; #  .дети, for .tatar need 8131

        ( $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

Further overlap functions where the provider has features

=head2 login

Ext params for login,

INPUT: new password for change

=cut

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

    my $svcs = '
    urn:ietf:params:xml:ns:epp-1.0
    urn:ietf:params:xml:ns:eppcom-1.0
    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 = '
     http://www.tcinet.ru/epp/tci-contact-ext-1.0
     http://www.tcinet.ru/epp/tci-domain-ext-1.0
     urn:ietf:params:xml:ns:launch-1.0
     urn:ietf:params:xml:ns:secDNS-1.1
     urn:ietf:params:xml:ns:rgp-1.0
     http://www.tcinet.ru/epp/tci-billing-1.0';

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


sub contact_ext {
    my ( undef, $params ) = @_;

    my $ext = '';

    if ( $params->{birthday} ) {
        $ext .= "   \n";

        foreach my $f ( 'birthday', 'passport', 'TIN' ) {
            $ext .= "    $$params{$f}\n" if $$params{$f};
        }

        $ext .= "   ";
    }

    if ( $params->{legal} ) {
        $ext .= "   \n";
        foreach my $type ( 'int', 'loc' ) {
            $ext .= qq|    \n|;

            $$params{legal}{$type}{addr} = [ $$params{legal}{$type}{addr} ] unless ref $$params{legal}{$type}{addr};

            foreach my $s ( @{$$params{legal}{$type}{addr}} ) {
                $ext .= "     $s\n";
            }

            $ext .= "     $$params{legal}{$type}{city}\n";
            $ext .= ( $$params{legal}{$type}{'state'} ? "     $$params{legal}{$type}{state}\n"  : "     \n" );
            $ext .= ( $$params{legal}{$type}{postcode} ? "     $$params{legal}{$type}{postcode}\n"  : "     \n" );
            $ext .= "     $$params{legal}{$type}{country_code}\n";

            $ext .= "    \n";
        }
        $ext .= "    $$params{TIN}\n";
        $ext .= "   ";
    }

    return $ext;
}


=head2 create_contact

When registering a contact, you must specify both int type data and loc type data, and if the domain owner has passport data in Cyrillic,
then loc type data must be entered in Cyrillic.
This is mandatory for citizens and legal entities of Russia, Ukraine, Belarus and other countries that have the Cyrillic alphabet.

In addition, the owner must provide additional information.

For individuals:

C -- date of birth;

C -- passport series and number, by whom and when it was issued;

C -- TIN for individual entrepreneurs.

For legal entities:

hashref C, that contains the legal address, it also needs to specify two types: C and C, consisting of the fields C, C, C, C, C.

You also need to specify the C field.

An Example:

Individuals:

    my %cont = (
        int => {
            first_name => 'Igor',
            patronymic => 'Igorevich',
            last_name  => 'Igorev',
            org        => '',
            addr       => 'Igoreva str, 129',
            city       => 'Igorevsk',
            state      => 'Ogorevskaya obl.',
            postcode   => '699001',
            country_code => 'RU',
        },
        loc => {
            first_name => 'Игорь',
            patronymic => 'Игоревич',
            last_name  => 'Игорев',
            org        => '',
            addr       => 'ул. Игорева, 129',
            city       => 'Игоревск',
            state      => 'Игоревская обл.',
            postcode   => '699001',
            country_code => 'RU',
        },
        birthday => '1909-01-14',
        passport => '11.11.2011, выдан Отделом УФМС России по Игоревской области в г.Игоревске, 2211 446622',
        phone      => '+7.9012345678',
        fax        => '',
        email      => '[e-mail]',
        TIN        => '',
    };

    my ( $answ, $msg, $conn ) = make_request( 'create_contact',  \%cont );

Legal entities:

    my %cont = (
        int => {
            first_name => 'Igor',
            patronymic => 'Igorevich',
            last_name  => 'Igorev',
            org        => 'Igor and Co',
            addr       => 'Igoreva str, 129',
            city       => 'Igorevsk',
            state      => 'Igorevskaya obl.',
            postcode   => '699001',
            country_code => 'RU',
        },
        loc => {
            first_name => 'Игорь',
            patronymic => 'Игоревич',
            last_name  => 'Игорев',
            org        => 'Игорь и Ко',
            addr       => 'ул. Игорева, 129',
            city       => 'Игоревск',
            state      => 'Игоревская обл.',
            postcode   => '699001',
            country_code => 'RU',
        },
        legal => {
            int => {
                addr       => 'Company str, 1',
                city       => 'Igorevsk',
                state      => 'Igorevskaya obl.',
                postcode   => '699002',
                country_code => 'RU',
            },
            loc => {
                addr       => 'ул. Компаний, 1',
                city       => 'Игоревск',
                state      => 'Игоревская обл.',
                postcode   => '699002',
                country_code => 'RU',
            }
        }
    };

    my ( $answ, $code, $msg ) = $conn->create_contact( \%cont );

=cut

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

    $params->{cont_id} ||= IO::EPP::Base::gen_id( 16 );

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

    my $extension = $self->contact_ext( $params );

    if ( $extension ) {
        $params->{extension} = "   \n$extension   \n";
    }

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


sub get_contact_ext {
    my ( undef, $ext ) = @_;

    my %cont;

    if ( $ext =~ m|]+tci-contact-ext-1[^<>]+>(.+?)|s ) {
        my $data = $1;

        if ( $data =~ m|(.+)|s ) {
            my $person_data = $1;

            my @rows = $person_data =~ m|([^<>]+)|gs;

            foreach my $row ( @rows ) {
                if ( $row =~ m|([^<>]+)| ) {
                    $cont{$1} = $2;
                }
            }
        }

        if ( $data =~ m|(.+)|s ) {
            my $org_data = $1;

            ( $cont{TIN} ) = $org_data =~ /([^<>]+)<\/contact:TIN>/;

            my @atypes = ( 'int', 'loc' );
            foreach my $atype ( @atypes ) {
                my ( $postal ) = $org_data =~ m|(.+?)|s;

                next unless $postal;

                $cont{legal}{$atype}{addr} = join(' ', $postal =~ /([^<>]*)<\/contact:street>/ );

                ( $cont{legal}{$atype}{city} ) = $postal =~ /([^<>]*)<\/contact:city>/;

                ( $cont{legal}{$atype}{'state'} ) = $postal =~ /([^<>]*)<\/contact:sp>/;

                ( $cont{legal}{$atype}{postcode} ) = $postal =~ /([^<>]*)<\/contact:pc>/;

                ( $cont{legal}{$atype}{country_code} ) = $postal =~ /([A-Z]+)<\/contact:cc>/;
            }
        }
    }

    return \%cont;
}


=head2 create_domain

Has an optional C field.

For .дети tld automatically adds the idn extension with lang C.

=cut

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

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

    my $extension = '';

    if ( $params->{dname} =~ /\.xn--80adxhks$/ ) {
        # .москва support RU lang only
        $extension .= qq|   \n|;
        $extension .=   "    ru-RU\n";
        $extension .=   "   \n";
    }

    $params->{extension} = $extension if $extension;

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

=head2 get_domain_spec_ext

Processes the additional description field.

=cut

sub get_domain_spec_ext {
    my ( undef, $ext ) = @_;

    my %info;

    if ( $ext =~ m|]+tci-domain-ext-1[^<>]+>(.+?)|s ) {
        my $tciinfo = $1;

        ( $info{descr} ) = $tciinfo =~ m|([^<>]+)|;
    }

    return \%info;
}


1;

__END__