File Coverage

blib/lib/IO/EPP/Flexireg.pm

Criterion	Covered	Total	%
statement	12	126	9.5
branch	0	48	0.0
condition	0	25	0.0
subroutine	4	14	28.5
pod	7	10	70.0
total	23	223	10.3

package IO::EPP::Flexireg;

=encoding utf8

=head1 NAME

IO::EPP::Flexireg

=head1 SYNOPSIS

    use IO::EPP::Flexireg;

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

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

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

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

=head1 DESCRIPTION

Module work with Flexireg tlds: .moscow, .москва, ru.net and 3lvl.ru/su

Frontend:
https://faitid.org/

Backend:
http://flexireg.net/


Documentaion:

moscow, москва
L,
L

ru.net+
L


=cut

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

use strict;
use warnings;

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

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

    unless ( $params->{conn} ) {
        $params->{sock_params}{PeerHost} ||= 'epp.flexireg.net';
        $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

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: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
     urn:ietf:params:xml:ns:fee-0.11
     urn:ietf:params:xml:ns:idn-1.0
     urn:ietf:params:xml:ns:launch-1.0
     urn:ietf:params:xml:ns:rgp-1.0
     urn:ietf:params:xml:ns:secDNS-1.1';

    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

For moscow/москва:

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} = qq|   \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

Domains ru.net+ tlds have only the registrant, without the administrator and other contacts

=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";
    }

    if ( $params->{price}  or  $params->{fee} ) {
        my $price = $params->{price} || $params->{fee};
        # Russian Ruble only
        $extension .= qq|   \n|;
        $extension .=   "    RUB\n";
        $extension .=   "    $price\n";
        $extension .=   "   \n";
    }

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

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


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

    my %info;

    if ( $ext =~ /(.+?)<\/idn:data>/s ) {
        my $idn = $1;

        ( $info{uname} ) = $idn =~ /([^<>]+)<\/idn:uname>/;
    }

    return \%info;
}


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

    my $extension = '';

    if ( $params->{price}  or  $params->{fee} ) {
        my $price = $params->{price} || $params->{fee};
        # Russian Ruble only
        $extension .= qq|   \n|;
        $extension .=   "    RUB\n";
        $extension .=   "    $price\n";
        $extension .=   "   \n";
    }

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

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


=head2 restore_domain

first call for restore_domain

=cut

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

    $params->{extension} = qq|

   |;

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


=head2 confirmations_restore_domain

Second call for restore_domain

=over 4

=item C

whois before delete;

=item C

whois on now;

=item C

delete domain date-time, see. upd_date in domain:info before call restore_domain;

=item C

restore request call datetime in UTC;

=item C

restore reason,

variants: C, C, C;

=item C

need to write what it is for the client;

=item C

can and without other.

=back

=cut

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

    $params->{extension} = <



          $$params{pre_data}
          $$params{post_data}
          $$params{del_time}
          $$params{rest_time}
          $$params{reason}
          $$params{statement}




RGPEXT

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


1;


__END__