view release on metacpan or  search on metacpan

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

    my @atypes = ( 'int', 'loc' );
    foreach my $atype ( @atypes ) {
        my ( $postal ) = $rdata =~ /<postalInfo type="$atype">(.+?)<\/postalInfo>/;

        next unless $postal;

        ( $cont{$atype}{name} ) = $postal =~ /<name>([^<>]+)<\/name>/;

        ( $cont{$atype}{company} ) = $rdata =~ /<org>([^<>]*)<\/org>/;

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

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

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

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

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

    ( $cont{phone} ) = $rdata =~ /<voice[^<>]*>([0-9+.]*)<\/voice>/;

    ( $cont{fax} ) = $rdata =~ /<fax[^<>]*>([0-9+.]*)<\/fax>/;

    ( $cont{email} ) = $rdata =~ /<email>([^<>]+)<\/email>/;

    # <status s="linked"/>
    my @ss = $rdata =~ /<status s="([^"]+)"\/>/g;
    $cont{statuses}{$_} = '+' for @ss;

    if ( $rdata =~ /<authInfo><pw>(.+?)<\/pw>/ ) {
        $cont{authinfo} = $1;
    }

    my ( $visible ) = $rdata =~ /<contact:disclose flag=['"](\d)['"]>/;
    $cont{pp_flag} = $visible ? 0 : 1;

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

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

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

    return \%cont;
}


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

    if ( $params->{chg} ) {
        $params->{chg}{need_name} = 1;
        $params->{chg}{authinfo}  = IO::EPP::Base::gen_pw( 12 );
    }

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

sub get_ns_info_rdata {
    my ( undef, $rdata ) = @_;

    my %ns;

    ( $ns{name} ) = $rdata =~ /<name>([^<>]+)<\/name>/;
    $ns{name} = lc $ns{name};

    ( $ns{roid} ) = $rdata =~ /<roid>([^<>]+)<\/roid>/;

    # <host:status s="ok"/>
    my @ss = $rdata =~ /<status s="([^"]+)"\s*\/>/g;
    $ns{statuses}{$_} = '+' for @ss;

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

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

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

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

    return \%ns;
}


sub check_domains_rdata {
    my ( undef, $rdata ) = @_;

    my @aa = $rdata =~ /<cd>(<name avail="[a-z]+">[^<>]+<\/name>(?:<reason>[^<>]+<\/reason>)?)<\/cd>/sg;

    my %domlist;
    foreach my $a ( @aa ) {
        if ( $a =~ /<name avail="(true|false)">([^<>]+)<\/name>/ ) {
            my $dm = lc($2);
            $domlist{$dm} = { avail => ( $1 eq 'true' ? 1 : 0 ) }; # no utf8, puny only

            if ( $a =~ /<reason>([^<>]+)<\/reason>/ ) {
                $domlist{$dm}{reason} = $1;