view release on metacpan or  search on metacpan

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

            $info->{fax} = [ $rdata =~ /<registrar:fax>([^<>]+)<\/registrar:fax>/g ];

            my @emails = $rdata =~ /(<registrar:email type="[^"]+">[^<>]+<\/registrar:email>)/g;

            foreach my $e ( @emails ) {
                if ( $e =~ /registrar:email type="([^"]+)">([^<>]+)<\/registrar:email/ ) {
                    $info->{emails}{$1} = $2;
                }
            }

            if ( $rdata =~ /<registrar:www>([^<>]+)<\/registrar:www>/ ) {
                $info->{www} = $1;
            }

            if ( $rdata =~ /<registrar:whois>([^<>]+)<\/registrar:whois>/ ) {
                $info->{whois} = $1;
            }

            $info->{ips} = [ $rdata =~ /<registrar:addr ip="v\d">([0-9A-Fa-f.:]+)<\/registrar:addr>/g ];

            my %dt = %IO::EPP::Base::dt;
            foreach my $k ( keys %dt ) {
                if ( $rdata =~ /<registrar:$k>([^<>]+)<\/registrar:$k>/ ) {
                    $info->{$dt{$k}} = $1;

                    $info->{$dt{$k}} =~ s/T/ /;
                    $info->{$dt{$k}} =~ s/\.\d+Z$//;
                }
            }
        }

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

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


=head2 update_registrar

Changing Registrar data: white IP, email, whois data

INPUT:

key of params:

C<add> or C<rem>:

C<ips> -- arrayref of ipv4 or ipv6 address,

C<emails> - hashref where keys - email type, values - email

C<chg>:

C<www> - new web url

C<whois> - new whois url

=cut

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

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

    my $cltrid = $self->get_cltrid();

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

        if ( defined $params->{add}{emails}  and  ref $params->{add}{emails} ) {
            foreach my $type ( @{$params->{add}{emails}} ) {
                $add .= qq|     <registrar:emailtype="$type">| . $$params{add}{emails}{$type} . "</registrar:email>\n";
            }
        }
    }

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

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

        if ( defined $params->{rem}{emails}  and  ref $params->{rem}{emails} ) {
            foreach my $type ( @{$params->{rem}{emails}} ) {
                $rem .= qq|     <registrar:emailtype="$type">| . $$params{rem}{emails}{$type} . "</registrar:email>\n";
            }
        }
    }

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