diff options
Diffstat (limited to 'lib/Net/XRC/Response.pm')
| -rw-r--r-- | lib/Net/XRC/Response.pm | 224 |
1 files changed, 224 insertions, 0 deletions
diff --git a/lib/Net/XRC/Response.pm b/lib/Net/XRC/Response.pm new file mode 100644 index 0000000..98d225a --- /dev/null +++ b/lib/Net/XRC/Response.pm @@ -0,0 +1,224 @@ +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; |