view release on metacpan or  search on metacpan

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

    return $in_data;
}


sub new {
    my ( $package, $params ) = @_;

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

    my $sock_params   = delete $params->{sock_params};

    my $test = delete $params->{test_mode};

    $self = bless {
        sock           => 'https', # no session
        user           => delete $params->{user},
        pass           => delete $params->{pass}, # !!! Send login and password with each request
        url            => $sock_params->{PeerHost},
        local_ip       => $sock_params->{LocalAddr},
        timeout        => $sock_params->{Timeout},
        tld            => $params->{tld} || '',
        server         => delete $params->{server},
        log_name       => delete $params->{log_name},
        log_fn         => delete $params->{log_fn},
        no_log         => delete $params->{no_log} || 0,
        test           => $test,
        critical_error => undef,
    }, $package;

    $self->set_urn();

    $self->set_log_vars( $params );

    $self->epp_log( "Connect to $$sock_params{PeerHost}\n" );

    return wantarray ? ( $self, '1000', 'ok' ) : $self;
}


sub set_urn {
    $_[0]->{urn} = {
        head => '', # !!!
        cont => $IO::EPP::Base::epp_cont_urn,
        host => $IO::EPP::Base::epp_host_urn,
        dom  => $IO::EPP::Base::epp_dom_urn,
    };
}


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

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

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

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


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

    $params->{company} =~ s/&/&/g
        if $params->{company};

    $params->{need_name} = 1;

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

=head2 create_domain

Since September 7, 2010, for Kazakhstan domains, you need to fill in data on the location of the server equipment
on which the site is located, accessible by this domain name.
The server equipment should be located on the territory of Kazakhstan.

C<server_loc> -- hashref with parameters:

C<srvloc_state> -- server location area or region;
C<srvloc_city>  -- city;
C<srvloc_street> -- address in the city.

=cut

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

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

    if ( $params->{server_loc} ) {
        my $server_loc = delete $params->{server_loc};

        $params->{extension} =
'   <srvloc:create xmlns:srvloc="urn:kaznic:params:xml:ns:srvloc-1.0" xsi:schemaLocation="urn:kaznic:params:xml:ns:srvloc-1.0 srvloc-1.0.xsd">
    <srvloc:street>'.$server_loc->{srvloc_street}.'</srvloc:street>
    <srvloc:city>'.$server_loc->{srvloc_city}.'</srvloc:city>
    <srvloc:sp>'.$server_loc->{srvloc_state}.'</srvloc:sp>
   </srvloc:create>';
    }

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


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

    $params->{authinfo} =~ s/&/&amp;/g;
    $params->{authinfo} =~ s/</&lt;/g;
    $params->{authinfo} =~ s/>/&gt;/g;

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

=head2 update_domain

See L</create_domain> for C<server_loc> parameters.

=cut

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

    if ( $params->{server_loc} ) {
        my $server_loc = delete $params->{server_loc};

        $params->{extension} =
'   <srvloc:create xmlns:srvloc="urn:kaznic:params:xml:ns:srvloc-1.0" xsi:schemaLocation="urn:kaznic:params:xml:ns:srvloc-1.0 srvloc-1.0.xsd">
    <srvloc:street>'.$server_loc->{srvloc_street}.'</srvloc:street>
    <srvloc:city>'.$server_loc->{srvloc_city}.'</srvloc:city>
    <srvloc:sp>'.$server_loc->{srvloc_state}.'</srvloc:sp>
   </srvloc:create>';
    }

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

=head2 logout

For replace IO::EPP::Base::logout.

Do nothing.

=cut

sub logout {
    my ( $self ) = @_;

    $self->epp_log( "</logout>" );

    delete $self->{sock};
    delete $self->{user};
    delete $self->{pass};

    return ( undef, '1500', 'ok' );
}


sub DESTROY {
    my ( $self ) = @_;

    local ($!, $@, $^E, $?); # Protection against action-at-distance

    $self->logout();

    if ( $self->{log_fh} ) {
        close $self->{log_fh};

        delete $self->{log_fh};
    }
}

1;

__END__

=pod

=head1 AUTHORS

Vadim Likhota <vadiml@cpan.org>