Net::DRI::Protocol::ResultStatus - Encapsulate Details of an Operation Result (with Standardization on EPP) for Net::DRI

## Domain Registry Interface, Encapsulating result status, standardized on EPP codes
##
## Copyright (c) 2005,2006,2008-2010 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::ResultStatus;

use strict;
use warnings;

use base qw(Class::Accessor::Chained::Fast);
__PACKAGE__->mk_ro_accessors(qw(is_success native_code code message lang next));

use Net::DRI::Exception;
use Net::DRI::Util;

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

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

## We give symbolic names only to codes that are used in some modules
our %EPP_CODES=(
                COMMAND_SUCCESSFUL => 1000,
		COMMAND_SUCCESSFUL_PENDING => 1001, ## needed for async registries when action done correctly on our side
                COMMAND_SUCCESSFUL_END => 1500, ## after logout

                COMMAND_SYNTAX_ERROR => 2001,
                PARAMETER_VALUE_SYNTAX_ERROR => 2005,
                AUTHENTICATION_ERROR => 2200,
                AUTHORIZATION_ERROR => 2201,
                OBJECT_EXISTS   => 2302,
                OBJECT_DOES_NOT_EXIST => 2303,
                COMMAND_FAILED => 2400, ## Internal server error not related to the protocol
                COMMAND_FAILED_CLOSING => 2500, ## Same + connection dropped
		SESSION_LIMIT_EXCEEDED_CLOSING => 2502, ## useful for rate limiting problems

                GENERIC_SUCCESS => 1900, ## these codes are not defined in EPP RFCs, but provide a nice extension
                GENERIC_ERROR   => 2900, ##     19XX for ok (1900=Undefined success), 29XX for errors (2900=Undefined error)
               );

sub new
{
 my ($class,$type,$code,$eppcode,$is_success,$message,$lang,$info)=@_;
 my %s=(
        is_success  => (defined($is_success) && $is_success)? 1 : 0,
        native_code => $code,
        message     => $message || '',
        type        => $type, ## rrp/epp/afnic/etc...
        lang        => $lang || '?',
	'next'	    => undef,
        data        => {},
       );

 $s{code}=_eppcode($type,$code,$eppcode,$s{is_success});
 $s{info}=(defined $info && ref $info eq 'ARRAY')? $info : []; ## should we now put that instead in data->{session}->{registry}->{extra_info} or something like that ?
 bless(\%s,$class);
 return \%s;
}

sub trid
{
 my $self=shift;
 return unless (exists($self->{trid}) && (ref($self->{trid}) eq 'ARRAY'));
 return wantarray()? @{$self->{trid}} : $self->{trid}->[0];
}

sub get_extended_results { return @{shift->{info}}; }

sub get_data
{
 my ($self,$k1,$k2,$k3)=@_;
 if (! defined $k1 || (defined $k3 xor defined $k2)) { Net::DRI::Exception::err_insufficient_parameters('get_data() expects one or three parameters'); }
 my $d=$self->{'data'};

 ## 3 parameters form, walk the whole references tree
 if (defined $k2 && defined $k3)
 {
  if (! exists $d->{$k1})               { return; }
  ($k1,$k2)=Net::DRI::Util::normalize_name($k1,$k2);
  if (! exists $d->{$k1}->{$k2})        { return; }
  if (! exists $d->{$k1}->{$k2}->{$k3}) { return; }
  return $d->{$k1}->{$k2}->{$k3};
 }

 ## 1 parameter form, go directly to leafs if not too much of them (we skip session/exchange + message/info)
 my @k=grep { $_ ne 'session' && $_ ne 'message' } keys %$d;
 if (@k != 1) { return; }
 $d=$d->{$k[0]};
 if ( keys(%$d) != 1 ) { return; }
 ($d)=values %$d;
 if (! exists $d->{$k1}) { return; }
 return $d->{$k1};
}

sub get_data_collection
{
 my ($self,$k1,$k2)=@_;
 my $d=$self->{'data'};

 if (! defined $k1)             { return wantarray ? keys %$d : $d; }
 if (! exists $d->{$k1})        { return; }
 if (! defined $k2)             { return wantarray ? keys %{$d->{$k1}} : $d->{$k1}; }
 ($k1,$k2)=Net::DRI::Util::normalize_name($k1,$k2);
 if (! exists $d->{$k1}->{$k2}) { return; }
 return wantarray ? keys %{$d->{$k1}->{$k2}} : $d->{$k1}->{$k2};
}

sub last { my $self=shift; while ( defined $self->next() ) { $self=$self->next(); } return $self; }

## These methods are not public !
sub _set_trid { my ($self,$v)=@_; $self->{'trid'}=$v; }
sub _add_next { my ($self,$v)=@_; $self->{'next'}=$v; }
sub _add_last { my ($self,$v)=@_; while ( defined $self->next() ) { $self=$self->next(); } $self->{'next'}=$v; }
sub _set_data { my ($self,$v)=@_; $self->{'data'}=$v; }
sub _eppcode
{
 my ($type,$code,$eppcode,$is_success)=@_;
 return $EPP_CODES{GENERIC_ERROR} unless defined($type) && $type && defined($code);
 $eppcode=$code if (!defined($eppcode) && ($type eq 'epp'));
 return $is_success? $EPP_CODES{GENERIC_SUCCESS} : $EPP_CODES{GENERIC_ERROR} unless defined($eppcode);
 return $eppcode if ($eppcode=~m/^\d{4}$/);
 return $EPP_CODES{$eppcode} if exists($EPP_CODES{$eppcode});
 return $EPP_CODES{GENERIC_ERROR};
}

sub new_generic_success { my ($class,$msg,$lang,$ri)=@_;       return $class->new('epp',$EPP_CODES{GENERIC_SUCCESS},undef,1,$msg,$lang,$ri); }
sub new_generic_error   { my ($class,$msg,$lang,$ri)=@_;       return $class->new('epp',$EPP_CODES{GENERIC_ERROR},undef,0,$msg,$lang,$ri); }
sub new_success         { my ($class,$code,$msg,$lang,$ri)=@_; return $class->new('epp',$code,undef,1,$msg,$lang,$ri); }
sub new_error           { my ($class,$code,$msg,$lang,$ri)=@_; return $class->new('epp',$code,undef,0,$msg,$lang,$ri); }

sub as_string
{
 my ($self,$withinfo)=@_;
 my $b=sprintf('%s %d %s',$self->is_success()? 'SUCCESS' : 'ERROR',$self->code(),length $self->message() ? ($self->code() eq $self->native_code()? $self->message() : $self->message().' ['.$self->native_code().']') : '(No message given)');
 if (defined($withinfo) && $withinfo)
 {
  my @i=$self->get_extended_results();
  $b.="\n".join("\n",map { my $rh=$_; join(' ',map { $_.'='.$rh->{$_} } sort(keys(%$rh))) } @i) if @i;
 }
 return $b;
}

sub print      { print shift->as_string(0); }
sub print_full { print shift->as_string(1); }

sub is_pending { return (shift->code()==$EPP_CODES{COMMAND_SUCCESSFUL_PENDING})? 1 : 0; }
sub is_closing { my $c=shift->code(); return ($c==$EPP_CODES{COMMAND_SUCCESSFUL_END} || ($c>=2500 && $c<=2502))? 1 : 0; }

sub is
{
 my ($self,$symcode)=@_;
 return unless (defined $symcode && length $symcode && exists $EPP_CODES{$symcode});
 return ($self->code()==$EPP_CODES{$symcode})? 1 : 0;
}

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