package Net::XRC::Response;

use strict;
use vars qw($AUTOLOAD);

my %exception = (
    1 => 'PROTOCOL',
    2 => 'UNKNOWN_COMMAND',
    4 => 'IO',
    5 => 'AUTHENTICATION_FAILURE',
    6 => 'SYSTEM_FAILURE',
    7 => 'PERMISSION_DENIED',
    8 => 'ARGUMENT_TYPE_MISMATCH',
   10 => 'UNKNOWN_TYPE',
   11 => 'SYNTAX',
   13 => 'SERIALIZE',
  200 => 'INVALID_ARGUMENT',
  201 => 'EMAIL_SERVICE_ALREADY_SETUP',
  202 => 'WEBMAIL_HOSTNAME_NOT_READY',
  203 => 'EMAIL_DOMAIN_NAME_NOT_READY',
  204 => 'WEBMAIL_HOSTNAME_TAKEN',
  205 => 'EMAIL_DOMAIN_NAME_TAKEN',
  206 => 'ACCOUNT_NAME_TAKEN',
  207 => 'CLIENT_DOES_NOT_EXIST',
  208 => 'INVALID_PASSWORD',
  209 => 'INVALID_ADDRESS',
  210  => 'EMAIL_SERVICE_NOT_READY',
  211 => 'INVALID_WEBMAIL_HOSTNAME',
  212 => 'INVALID_EMAIL_DOMAIN',
  213 => 'USER_DOES_NOT_EXIST',
  214 => 'INVALID_ACCOUNT_NAME',
  215 => 'OFFER_NOT_AVAILABLE',
  216 => 'ALIAS_DOES_NOT_EXIST',
  217 => 'USER_NO_MAILBOX',
  218 => 'EMAIL_SERVICE_NOT_FOUND',
  219 => 'ACCOUNT_NOT_SUSPENDED',
);

my %exception_long = (
    1 => 'EOF while reading metadata, '.
         'a metadata line exceeded 8192 bytes, '.
         'missing a required metadata key-value pair, '.
         'metadata value malformed, or '.
         'missing method name and/or method arguments.',
    2 => 'The method name does not match a known method.',
    4 => 'IO error or premature EOF while parsing method arguments',
    5 => 'Credentials offered in metadata are not valid.',
    6 => 'An internal error in the XRC server. Everyone.net is automatically notified.',
    7 => 'The caller does not have necessary rights.',
    8 => 'One or more of the method arguments was not of the correct type, or the number of arguments to the method was incorrect.',
   10 => 'The name of a complex type is not known.',
   11 => 'An error in the format of the XRC request.',
   13 => 'A value of a complex type was of the wrong type or failed to meet the requirements of the type specification.',
  200 => 'An argument to a method did not meet the requirements of the specification.',
  201 => 'An attempt was made to setup an email service for a client that already has an email service.',
  202 => 'The webmail hostname is not properly configured. See DNS Requirements.',
  203 => 'The email domain is not properly configured. See DNS Requirements.',
  204 => 'The webmail hostname is in use by another client.',
  205 => 'The email domain is in use by another client.',
  206 => 'The username or alias name is in use.',
  207 => 'An operation was attempted on a client that cannot be found.',
  208 => 'The password is not valid. See Name Restrictions.',
  209 => 'An email address was not of legal form.',
  210 => 'The MX records of the email service have not been validated.',
  211 => 'The webmail hostname is not valid. See Name Restrictions.',
  212 => 'The email domain is not valid. See Name Restrictions.',
  213 => 'An operation was attempted on a user that cannot be found.',
  214 => 'The username or alias name is not valid. See Name Restrictions.',
  215 => 'The distributor attempted to apply an offer to a user or client that does not exist, applies to the wrong beneficiary, or does not belong to the distributor.',
  216 => 'An operation was attempted on an alias that cannot be found.',
  217 => 'The user does not have a mailbox.',
  218 => 'The client does not have an email service.',
  219 => 'The user mailbox cannot be purged because the user account is not in suspended mode.',
);

=head1 NAME

Net::XRC::Response - XRC response object

=head1 SYNOPSIS

  my $response = $xrc->some_method( $and, $args );

  #response meta-data
  my $server = $response->server;
  my $timestamp = $response->server;

  if ( $response->is_success ) {

    my $content = $response->content;
    #...

  } else {

    my $status = $response->status; #error code
    my $error = $response->error; #error message
    #...
  }

=head1 DESCRIPTION

The "Net::XRC::Response" class represents XRC responses.

=cut

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self = {};
  bless($self, $class);

  my $data = shift;

  while ( $data =~ s/^(\w+):\s*(.*)$//m ) { #metadata
    warn "response metadata: $1 => $2\n"
      if $Net::XRC::DEBUG;
    $self->{$1} = $2;
  }

  $self->{'content'} = $self->decode(\$data)
    if $self->is_success;

  $self;
}

sub is_success { 
  my $self = shift;
  ! $self->{'status'};
}

sub error {
  my $self = shift;
  $exception{ $self->{'status'} }. ': '. $exception_long{ $self->{'status'} }.
  ' - '. $self->{'errorDescription'};
}

sub AUTOLOAD {
  my $self = shift;
  $AUTOLOAD =~ s/.*://;
  $self->{$AUTOLOAD};
}
#sub content { $self->{'content'}; }
#sub status { $self->{'status'}; }
#sub errorDescription { $self->{'errorDescription'}; }
#sub server { $self->{'server'}; }
#sub timestamp { $self->{'timestamp'}; }

sub decode {
  my( $self, $s ) = @_;

  warn "starting to parse response: ". $$s
    if $Net::XRC::DEBUG > 1;

  $$s =~ s/^[\s\n]+//g; #trim leading newlines and whitespace

  if ( $$s =~ /^[\-\d]/ ) { #int
    $$s =~ s/^(\-?\d+)// and $1
      or die "can't parse (int) response: ". $$s. "\n";
  } elsif ( $$s =~ /^"/ ) { #string
    $$s =~  s/^"(([^"\\]|\\"|\\\\)+)"//
      or die "can't parse (string) response: ". $$s. "\n";
    my $str = $1;
    $str =~ s(\\")(")g;
    $str =~ s(\\\\)(\\)g;
    $str;
  } elsif ( $$s =~ /^\/[TF]/ ) { #boolean
    $$s =~ s/^\/([TF])//
      or die "can't parse (bool) response: ". $$s. "\n";
    $1 eq 'T' ? 1 : 0;
  } elsif ( $$s =~ s/^\/NULL// ) { #NULL
    undef;
  } elsif ( $$s =~ /^\{/ ) { #bytes
    $$s =~ s/^\{(\d+)\}//
      or die "can't parse (bytes) response: ". $$s. "\n";
    substr($$s, 0, $1, '');
  } elsif ( $$s =~ /^\(/ ) { #list
    $$s =~ s/^\([\s\n]*//
      or die "can't parse (list) reponse: ". $$s. "\n";
    my @list = ();
    until ( $$s =~ s/^[\s\n]*\)// ) {
      push @list, $self->decode($s);
      die "unterminated list\n" if $s =~ /^[\s\n]*$/;
    }
    \@list;
  } elsif ( $$s =~ /^:/ ) { #complex
    $$s =~ s/^:(\w+)[\s\n]*//
      or die "can't parse (complex) response: ". $$s. "\n";
    my %hash = ( '_type' => $1 );
    until ( $$s =~ s/^[\s\n]*\)// ) {
      $$s =~ s/^[\s\n]*(\w+)//
        or die "can't parse ($hash{_type}) response: ". $$s. "\n";
      $hash{$1} = $self->decode($s);
      die "unterminated $hash{_type}\n" if $s =~ /^[\s\n]*$/;
    }
    \%hash;
  } else {
    die "can't parse response: ". $$s. "\n";
  }

}

=head1 BUGS

Needs better documentation.

=head1 SEE ALSO

L<Net::XRC>,
Everyone.net XRC Remote API documentation (XRC-1.0.5.html or later)

=head1 AUTHOR

Ivan Kohler E<lt>ivan-xrc@420.amE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005 Ivan Kohler

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;