Net::DRI::Protocol::BookMyName::WS::Message - BookMyName Web Services Message for Net::DRI


Net-DRI documentation Contained in the Net-DRI distribution.

Index


Code Index:

NAME

Top

Net::DRI::Protocol::BookMyName::WS::Message - BookMyName Web Services Message for Net::DRI

DESCRIPTION

Top

Please see the README file for details.

SUPPORT

Top

For now, support questions should be sent to:

<netdri@dotandco.com>

Please also see the SUPPORT file in the distribution.

SEE ALSO

Top

<http://www.dotandco.com/services/software/Net-DRI/>

AUTHOR

Top

Patrick Mevzek, <netdri@dotandco.com>

COPYRIGHT

Top


Net-DRI documentation Contained in the Net-DRI distribution.

## Domain Registry Interface, BookMyName Web Services Message
##
## Copyright (c) 2008,2009 Patrick Mevzek <netdri@dotandco.com>. All rights reserved.
##
## This file is part of Net::DRI
##
## Net::DRI is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## See the LICENSE file that comes with this distribution for more details.
#
# 
#
####################################################################################################

package Net::DRI::Protocol::BookMyName::WS::Message;

use strict;
use warnings;

use Net::DRI::Protocol::ResultStatus;

use base qw(Class::Accessor::Chained::Fast Net::DRI::Protocol::Message);
__PACKAGE__->mk_accessors(qw(version method params operation result retcode retval));

our $VERSION=do { my @r=(q$Revision: 1.5 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); };

####################################################################################################

sub new
{
 my $class=shift;
 my $self={errcode => undef, errmsg => undef};
 bless($self,$class);
 my ($trid,$otype,$oaction)=@_;

 $self->params([]); ## default
 return $self;
}

sub as_string
{
 my ($self)=@_;
 my @p=@{$self->params()};
 my @pr;
 foreach my $i (0..$#p)
 {
  push @pr,sprintf 'PARAM%d=%s',$i+1,$p[$i];
 }
 return sprintf "METHOD=%s\n%s\n",$self->method(),join("\n",@pr);
}

sub add_session
{
 my ($self,$sd)=@_;
 my $rp=$self->params();
 unshift(@$rp,$sd->{id},$sd->{pass});
}

sub parse
{
 my ($self,$dr,$rinfo,$otype,$oaction,$sent)=@_; ## $sent is the original message, we could copy its method/params value into this new message
 $self->operation($otype.'_'.$oaction);
 my ($res)=@{$dr->data()}; ## $dr is a Data::Raw object, type=1
 $self->result($res->{retfields}) if exists($res->{retfields});
 $self->retcode($res->{retcode}); ## integer
 $self->retval($res->{retval}); ## integer
}

## See http://api.doc.free.org/revendeur-de-nom-de-domaine
our %CODES=(	domain_info => {	'-1,-1' => 2200,
					'-1,-2' => 2201,
					'-1,-3' => 2003,
					'0,0' => 2303,
				},
		domain_check => {	'-1,-1' => 2200,
					'-1,-2' => 2303,
					'-1,-3' => 2103,
					'-1,-4' => 2303,
					'-1,-5' => 2003,
				},
		account_list_domains =>	{
					'-1,-1' => 2200,
					},
	);

sub is_success { return (shift->retcode()==1)? 1 : 0; }

sub result_status
{
 my $self=shift;
 my ($op,$rc,$rv)=($self->operation(),$self->retcode(),$self->retval());
 my $ok=$self->is_success();

 my $k=$rc.','.$rv;
 my $eppcode=(exists($CODES{$op}) && (ref($CODES{$op}) eq 'HASH') && keys(%{$CODES{$op}}) && exists($CODES{$op}->{$k}))? $CODES{$op}->{$k}  : 'GENERIC_ERROR';
 return Net::DRI::Protocol::ResultStatus->new('bookmyname_ws',100*$rc+$rv,$ok? 'COMMAND_SUCCESSFUL' : $eppcode,$ok,'retcode='.$rc.' retval='.$rv,'en');
}

####################################################################################################
1;