IO-EPP
9 results

 view release on metacpan or  search on metacpan

lib/IO/EPP/Base.pm  view on Meta::CPAN 


    my $ext = $$params{extension} || '';

    if ( $ext ) {
        $ext = "\n  <extension>\n$ext  </extension>";
    }

    my $cltrid = get_cltrid();

    my $body = <<CONTINFO;
$$self{urn}{head}
 <command>
  <info>
   <contact:info $$self{urn}{cont}>
    <contact:id>$$params{cont_id}</contact:id>
   </contact:info>
  </info>$ext
  <clTRID>$cltrid</clTRID>
 </command>
</epp>
CONTINFO

    my $content = $self->req( $body, 'get_contact_info' );

    if ( $content =~ /result code=['"](\d+)['"]/ ) {
        my $rcode = $1 + 0;

        my $msg = '';
        if ( $content =~ /<result.+<msg[^<>]*>(.+)<\/msg>.+\/result>/s ) {
            $msg = $1;
        }

        my $cont;

        # take the main part and disassemble
        if ( $content =~ /<resData>(.+)<\/resData>/s ) {
            $cont = $self->cont_from_xml( $1 );
        }
        else {
            return wantarray ? ( 0, $rcode, $msg ) : 0 ;
        }

        if ( $content =~ /<extension>(.+)<\/extension>/s ) {
            my $ext = $1;

            my $spec_ext = $self->get_contact_ext( $cont, $ext );
        }

        return wantarray ? ( $cont, $rcode, $msg ) : $cont;
    }

    return wantarray ? ( 0, 0, 'empty answer' ) : 0 ;
}

=head2 update_statuses_add

Part of update_* functions

=cut

sub update_statuses_add {
    my ( undef, $type, $statuses ) = @_;

    my $add = '';
    my %sts;

    if ( ref $statuses eq 'HASH' ) {
        %sts = %{$statuses};
    }
    elsif ( ref $statuses eq 'ARRAY' ) {
        $sts{$_} = '+' for @{$statuses};
    }

    foreach my $st ( keys %sts ) {
        if ( !$sts{$st}  or  $sts{$st} eq '+' ) {
            $add .= qq|     <$type:status s="$st"/>\n|;
        }
        else {
            $add .= qq|     <$type:status s="$st">$sts{$st}</$type:status>\n|;
        }
    }

    return $add;
}


=head2 update_statuses_rem

Part of update_* functions

=cut

sub update_statuses_rem {
    my ( undef, $type, $statuses ) = @_;

    my $rem = '';
    my @sts;

    if ( ref $statuses eq 'HASH' ) {
        @sts = keys %{$statuses};
    }
    elsif ( ref $statuses eq 'ARRAY' ) {
        @sts = @{$statuses};
    }

    $rem .= qq|     <$type:status s="$_"/>\n| foreach @sts;

    return $rem;
}

=head2 update_contact

To update contact information

INPUT:

params with keys:

C<cont_id> – contact id

C<add>, C<rem> – only contact statuses can be added or deleted, , such as clientUpdateProhibited

C<chg> – modify data, see fields in L</create_contact>

OUTPUT: see L</simple_request>.

An Example, change data, one type (by default this is C<int>):

    ( $answ, $code, $msg ) = $conn->update_contact(
        {
            cont_id => '123qwerty',
            chg => {
                first_name => 'Test',
                last_name => 'Testov',
                org => 'Private Person',
                addr => 'Vagnera 11-22',
                city => 'Donetsk',
                state => 'Donetskaya',
                postcode => '83061',
                country_code => 'DN',
                phone => '+380.501234567',
                fax => '',
                email => 'reg1010@yandex.com',
                authinfo => 'Q2+qqqqqqqqqqqqqqqqqqqqqqqqqq',
            }
        },
    );

=cut

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

    return ( 0, 0, 'no params' ) unless ref $params;

    return ( 0, 0, 'no cont_id' ) unless $params->{cont_id};

    my ( $add, $rem, $chg ) = ( '', '', '' );

    if ( $$params{add} ) {
        if ( $$params{add}{statuses} ) {
            $add .= $self->update_statuses_add( 'contact', $$params{add}{statuses} );
        }
    }

    $add = "\n    <contact:add>\n$add    </contact:add>" if $add;

    if ( $$params{rem} ) {
        if ( $$params{rem}{statuses} ) {
            $rem .= $self->update_statuses_rem( 'contact', $$params{rem}{statuses} );
        }
    }

    $rem = "\n    <contact:rem>\n$rem    </contact:rem>" if $rem;

    if ( $$params{chg} ) {
        $chg .= $self->cont_to_xml( $$params{chg} );

        $chg =~ s/\n/\n  /g;
    }

    $chg = "\n    <contact:chg>$chg   </contact:chg>" if $chg;

    my $ext = $$params{extension} || '';

    $ext = "\n  <extension>\n$ext  </extension>" if $ext;

    my $cltrid = get_cltrid();

    my $body = <<UPDCONT;
$$self{urn}{head}
 <command>
  <update>
   <contact:update $$self{urn}{cont}>
    <contact:id>$$params{cont_id}</contact:id>$add$rem$chg
   </contact:update>
  </update>$ext
  <clTRID>$cltrid</clTRID>
 </command>
</epp>
UPDCONT

    return $self->simple_request( $body, 'update_contact' );
}


=head2 delete_contact

Delete the specified contact.
Usually this function is not needed because the registry itself deletes unused contacts.

lib/IO/EPP/Base.pm  view on Meta::CPAN 

            $msg = $1;
        }

        my $ns = {};

        # вытягиваем смысловую часть и парсим
        if ( $content =~ /<resData>(.+)<\/resData>/s ) {
            my $rdata = $1;

            $ns = $self->get_ns_info_rdata( $rdata );
        }

        return wantarray ? ( $ns, $rcode, $msg ) : $ns;
    }

    return 0;
}

=head2 update_ns

Change the data of the specified name server

INPUT

params with keys:

C<ns> – name server

C<add>, C<rem> – adding or removing the name server parameters listed below:

C<ips> – IPv4 and IPv6 addresses;

C<statuses> – clientUpdateProhibited and other client*;

C<chg> – change the server name, this is used to move the name server to a different domain.

C<no_empty_chg> – some registries prohibit  passing an empty chg parameter – C<< <host:chg/> >>

C<extension> – extensions for some providers, empty by default

OUTPUT:
see L</simple_request>.

An Example

    my ( $answ, $msg, $conn ) = make_request( 'update_ns', {
        ns => 'ns1.sss.ru.com',
        rem => { ips => [ '2A00:3B00:0:0:0:0:0:25' ] },
        add => { ips => [ '176.99.13.11' ] },
        %conn_params,
    } );

    ( $answ, $msg ) = make_request( 'update_ns', {
        ns => 'ns1.sss.ru.com',
        chg => { new_name => 'ns1.sss.xyz' },
        conn => $conn,
    } );

=cut

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

    return ( 0, 0, 'no ns' ) unless $$params{ns};

    my $add = '';

    if ( $params->{add} ) {
        if ( $params->{add}{ips}  and  ref $params->{add}{ips} ) {
            foreach my $ip ( @{$params->{add}{ips}} ) {
                if ( $ip =~ /^\d+\.\d+\.\d+\.\d+$/ ) {
                    $add .= '     <host:addr ip="v4">'.$ip."</host:addr>\n";
                }
                else {
                    $add .= '     <host:addr ip="v6">'.$ip."</host:addr>\n";
                }
            }
        }

        if ( $params->{add}{statuses} ) {
            $add .= $self->update_statuses_add( 'host', $params->{add}{statuses} );
        }
    }

    if ( $add ) {
        $add = "<host:add>\n$add    </host:add>";
    }
    else {
        $add = '<host:add/>';
    }

    my $rem = '';

    if ( $params->{rem} ) {
        if ( defined $params->{rem}{ips}  and  ref $params->{rem}{ips} ) {
            foreach my $ip ( @{$params->{rem}{ips}} ) {
                if ( $ip =~ /^\d+\.\d+\.\d+\.\d+$/ ) {
                    $rem .= '     <host:addr ip="v4">'.$ip."</host:addr>\n";
                }
                else {
                    $rem .= '     <host:addr ip="v6">'.$ip."</host:addr>\n";
                }
            }
        }

        if ( $params->{rem}{statuses} ) {
            $rem .= $self->update_statuses_rem( 'host', $params->{rem}{statuses} );
        }
    }

    if ( $rem ) {
        $rem = "<host:rem>\n$rem    </host:rem>";
    }
    else {
        $rem = "<host:rem/>";
    }

    my $chg = '';

    if ( $params->{chg} ) {
        if ( $params->{chg}{new_name} ) {

lib/IO/EPP/Base.pm  view on Meta::CPAN 


params with keys:

C<dname> – domain name;

C<period> – the domain renewal period in years, by default, will be prologed for 1 year;

C<exp_date> – current expiration date, without specifying the time;

C<extension> – extensions for some providers, empty by default.

OUTPUT:
see L</simple_request>.

An Example:

    my ( $a, $m ) = make_request( 'renew_domain', { dname => 'datada.net', period => 1, exp_date => '2022-22-22' } );

=cut

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

    return ( 0, 0, 'no params' ) unless $$params{dname} && $$params{exp_date};

    $params->{period} ||= 1;

    my $ext = $params->{extension} || '';

    $ext = "\n  <extension>\n$ext  </extension>" if $ext;

    my $cltrid = get_cltrid();

    my $body = <<RENEWDOM;
$$self{urn}{head}
 <command>
  <renew>
   <domain:renew $$self{urn}{dom}>
    <domain:name>$$params{dname}</domain:name>
    <domain:curExpDate>$$params{exp_date}</domain:curExpDate>
    <domain:period unit="y">$$params{period}</domain:period>
   </domain:renew>
  </renew>$ext
  <clTRID>$cltrid</clTRID>
 </command>
</epp>
RENEWDOM

    return $self->simple_request( $body, 'renew_domain' );
}


=head2 update_domain_add_nss

Part of the update_domain function.

Can be overwritten in a child module, example, in L<IO::EPP::DrsUa>

=cut

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

    my $add = "     <domain:ns>\n";

    foreach my $ns ( @{$$params{add}{nss}} ) {
        $add .= "      <domain:hostObj>$ns</domain:hostObj>\n";
    }

    $add .= "     </domain:ns>\n";

    return $add;
}


=head2 update_domain_rem_nss

Part of the update_domain function.

Can be overwritten in a child module.

=cut

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

    my $rem = "     <domain:ns>\n";

    foreach my $ns ( @{$$params{rem}{nss}} ) {
        $rem .= "      <domain:hostObj>$ns</domain:hostObj>\n";
    }

    $rem .= "     </domain:ns>\n";

    return $rem;
}


=head2 update_domain_ext

Part of the update_domain function.

Can be overwritten in a child module.

In this function this module contains the DNSSEC extension

=cut

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

    my $ext = '';

    my $rem_ds = '';
    if ( $params->{rem}  &&  $params->{rem}{dnssec} ) {
        foreach my $raw ( @{$params->{rem}{dnssec}} ) {
            my $ds = '';
            $ds .= "      <secDNS:keyTag>$$raw{keytag}</secDNS:keyTag>\n"          if $raw->{keytag};
            $ds .= "      <secDNS:alg>$$raw{alg}</secDNS:alg>\n"                   if $raw->{alg};
            $ds .= "      <secDNS:digestType>$$raw{digtype}</secDNS:digestType>\n" if $raw->{digtype};
            $ds .= "      <secDNS:digest>$$raw{digest}</secDNS:digest>\n"          if $raw->{digest};

            $rem_ds .= "     <secDNS:dsData>\n$ds     </secDNS:dsData>\n" if $ds;
        }

        $rem_ds = "    <secDNS:rem>\n$rem_ds    </secDNS:rem>\n" if $rem_ds;
    }

    my $add_ds = '';
    if ( $params->{add}  &&  $params->{add}{dnssec} ) {
        foreach my $raw ( @{$params->{add}{dnssec}} ) {
            my $ds = '';
            $ds .= "      <secDNS:keyTag>$$raw{keytag}</secDNS:keyTag>\n"          if $raw->{keytag};
            $ds .= "      <secDNS:alg>$$raw{alg}</secDNS:alg>\n"                   if $raw->{alg};
            $ds .= "      <secDNS:digestType>$$raw{digtype}</secDNS:digestType>\n" if $raw->{digtype};
            $ds .= "      <secDNS:digest>$$raw{digest}</secDNS:digest>\n"          if $raw->{digest};

            $add_ds .= "     <secDNS:dsData>\n$ds     </secDNS:dsData>\n" if $ds;
        }

        $add_ds = "    <secDNS:add>\n$add_ds    </secDNS:add>\n" if $add_ds;
    }

    if ( $rem_ds || $add_ds ) {
        $ext .= "\n   <secDNS:update $epp_dnssec >\n";
        $ext .= $rem_ds;
        $ext .= $add_ds;
        $ext .= "   </secDNS:update>\n";
    }

    return $ext;
}

=head2 update_domain

To update domain data: contact ids, authinfo, nss, statuses.

INPUT:

params with keys:

C<dname> – domain name

C<add>, C<rem> – hashes for adding and deleting data:

C<admin_id>, C<tech_id>, C<billing_id> – contact IDs;

C<nss> – list with name servers;

C<statuses> – various client* statuses;

C<dnssec> – DNSSEC extension parameters.

C<chg> – hash for changeable data:

C<reg_id> – registrant contact id;

C<authinfo> – new key for domain;

OUTPUT:
see L</simple_request>.

Examples:

    my ( $a, $m, $c ) = make_request( 'update_domain', {
        dname => 'example.com',
        chg => { authinfo => 'fnjkfrekrejkfrenkfrenjkfren' },
        rem => { nss => [ 'ns1.qqfklnqq.com', 'ns2.qqfklnqq.com' ] },
        add => { nss => [ 'ns1.web.name', 'ns2.web.name' ] },
        %conn_params,
    } );

    ( $a, $m ) = make_request( 'update_domain', {
        dname => 'example.com',
        rem => { statuses => [ 'clientUpdateProhibited','clientDeleteProhibited' ] },
        add => { statuses => [ 'clientHold'  ] },
        conn => $c,
    } );

=cut

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

    return ( 0, 0, 'no params' ) unless ref $params;

    return ( 0, 0, 'no dname' ) unless $params->{dname};

    my $nm = 'update_domain';

    my $add = '';
    if ( ref $$params{add} ) {
        if ( $$params{add}{nss}  &&  ref $$params{add}{nss}  &&  scalar( @{$$params{add}{nss}} ) ) {
            $add .= $self->update_domain_add_nss( $params );

            $nm .= '_add_ns';
        }

        foreach my $t ( 'admin', 'billing', 'tech' ) {
            if ( $$params{add}{$t.'_id'} ) {
                $$params{add}{$t.'_id'} = [ $$params{add}{$t.'_id'} ] unless ref $$params{add}{$t.'_id'};

                foreach my $c ( @{$$params{add}{$t.'_id'}} ) {
                    $add .= qq|     <domain:contact type="$t">$c</domain:contact>\n|;
                }
            }
        }

        if ( $params->{add}{statuses} ) {
            $add .= $self->update_statuses_add( 'domain', $params->{add}{statuses} );

            $nm .= '_add_status';
        }
    }

    if ( $add ) {
        $add = "<domain:add>\n$add    </domain:add>";
    }
    else {
        $add = '<domain:add/>';
    }

    my $chg = '';
    if ( ref $$params{chg} ) {
        if ( $$params{chg}{reg_id} ) {
            $chg .= '     <domain:registrant>' . $$params{chg}{reg_id} . "</domain:registrant>\n";

            $nm .= '_chg_cont';
        }

        if ( $$params{chg}{authinfo} ) {
            $chg .= "     <domain:authInfo>\n      <domain:pw>".$$params{chg}{authinfo}."</domain:pw>\n     </domain:authInfo>\n";

            $nm .= '_chg_key';
        }

        if ( $params->{chg}{descr} ) {
            $params->{chg}{descr} = [ $params->{chg}{descr} ] unless ref $params->{chg}{descr};

            $chg .= "     <domain:description>$_</domain:description>\n" foreach @{$params->{chg}{descr}};

            $nm .= '_chg_descr';



( run in 0.518 second using v1.01-cache-2.11-cpan-e1769b4cff6 )