summaryrefslogtreecommitdiff
path: root/lib/Net/XRC
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Net/XRC')
-rw-r--r--lib/Net/XRC/Data.pm34
-rw-r--r--lib/Net/XRC/Data/boolean.pm13
-rw-r--r--lib/Net/XRC/Data/bytes.pm12
-rw-r--r--lib/Net/XRC/Data/complex.pm22
-rw-r--r--lib/Net/XRC/Data/int.pm12
-rw-r--r--lib/Net/XRC/Data/list.pm20
-rw-r--r--lib/Net/XRC/Data/null.pm12
-rw-r--r--lib/Net/XRC/Data/string.pm15
-rw-r--r--lib/Net/XRC/Response.pm224
9 files changed, 364 insertions, 0 deletions
diff --git a/lib/Net/XRC/Data.pm b/lib/Net/XRC/Data.pm
new file mode 100644
index 0000000..6f26400
--- /dev/null
+++ b/lib/Net/XRC/Data.pm
@@ -0,0 +1,34 @@
+package Net::XRC::Data;
+
+use strict;
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $data = shift;
+ my $self = ref($data) ? $data : \$data;
+ warn "$proto->($self [$data])\n"
+ if $Net::XRC::DEBUG > 1;
+
+ if ( $class eq 'Net::XRC::Data' ) { #take a guess
+ if ( ref($self) eq 'HASH' ) {
+ $class .= '::complex';
+ } elsif ( ref($self) eq 'ARRAY' ) {
+ $class .= '::list';
+ } elsif ( !defined($$self) ) {
+ $class .= '::null';
+
+ # now just guess... no good way to distinguish
+ # (bool and bytes are never guessed)
+ } elsif ( $$self =~ /^-?\d+$/ ) {
+ $class .= '::int';
+ } else {
+ $class .= '::string';
+ }
+ eval "use $class;";
+ die $@ if $@;
+ }
+ bless($self, $class);
+}
+
+1;
diff --git a/lib/Net/XRC/Data/boolean.pm b/lib/Net/XRC/Data/boolean.pm
new file mode 100644
index 0000000..7587cf1
--- /dev/null
+++ b/lib/Net/XRC/Data/boolean.pm
@@ -0,0 +1,13 @@
+package Net::XRC::Data::boolean;
+
+use strict;
+use vars qw(@ISA);
+use Net::XRC::Data;
+
+@ISA = qw(Net::XRC::Data);
+
+sub encode {
+ my $self = shift;
+ $$self ? '/T' : '/F';
+}
+
diff --git a/lib/Net/XRC/Data/bytes.pm b/lib/Net/XRC/Data/bytes.pm
new file mode 100644
index 0000000..ccf02a1
--- /dev/null
+++ b/lib/Net/XRC/Data/bytes.pm
@@ -0,0 +1,12 @@
+package Net::XRC::Data::bytes;
+
+use strict;
+use vars qw(@ISA);
+use Net::XRC::Data;
+
+@ISA = qw(Net::XRC::Data);
+
+sub encode {
+ my $self = shift;
+ '{'. length($$self). '}'. $$self;
+}
diff --git a/lib/Net/XRC/Data/complex.pm b/lib/Net/XRC/Data/complex.pm
new file mode 100644
index 0000000..5c0e5b6
--- /dev/null
+++ b/lib/Net/XRC/Data/complex.pm
@@ -0,0 +1,22 @@
+package Net::XRC::Data::complex;
+
+use strict;
+use vars qw(@ISA);
+use Net::XRC::Data;
+
+@ISA = qw(Net::XRC::Data);
+
+sub encode {
+ my $self = shift;
+ my %hash = %$self;
+ my $typename = delete $hash{_type};
+ ":$typename(". join("\n", map {
+ "$_ ".
+ isa( $hash{$_}, 'Net::XRC::Data' )
+ ? $hash{$_}->encode
+ : Net::XRC::Data->new($hash{$_})->encode
+ }
+ keys %hash
+ ).
+ ")";
+}
diff --git a/lib/Net/XRC/Data/int.pm b/lib/Net/XRC/Data/int.pm
new file mode 100644
index 0000000..7150872
--- /dev/null
+++ b/lib/Net/XRC/Data/int.pm
@@ -0,0 +1,12 @@
+package Net::XRC::Data::int;
+
+use strict;
+use vars qw(@ISA);
+use Net::XRC::Data;
+
+@ISA = qw(Net::XRC::Data);
+
+sub encode {
+ my $self = shift;
+ $$self;
+}
diff --git a/lib/Net/XRC/Data/list.pm b/lib/Net/XRC/Data/list.pm
new file mode 100644
index 0000000..093a2fd
--- /dev/null
+++ b/lib/Net/XRC/Data/list.pm
@@ -0,0 +1,20 @@
+package Net::XRC::Data::list;
+
+use strict;
+use vars qw(@ISA);
+use Net::XRC::Data;
+
+@ISA = qw(Net::XRC::Data);
+
+sub encode {
+ my $self = shift;
+ '('. join(' ', map {
+ ref($_) =~ /^Net::XRC::Data/
+ ? $_->encode
+ : Net::XRC::Data->new($_)->encode
+ }
+ @$self
+ ).
+ ')';
+}
+
diff --git a/lib/Net/XRC/Data/null.pm b/lib/Net/XRC/Data/null.pm
new file mode 100644
index 0000000..adf597e
--- /dev/null
+++ b/lib/Net/XRC/Data/null.pm
@@ -0,0 +1,12 @@
+package Net::XRC::Data::null;
+
+use strict;
+use vars qw(@ISA);
+use Net::XRC::Data;
+
+@ISA = qw(Net::XRC::Data);
+
+sub encode {
+ my $self = shift;
+ '/NULL';
+}
diff --git a/lib/Net/XRC/Data/string.pm b/lib/Net/XRC/Data/string.pm
new file mode 100644
index 0000000..df27b03
--- /dev/null
+++ b/lib/Net/XRC/Data/string.pm
@@ -0,0 +1,15 @@
+package Net::XRC::Data::string;
+
+use strict;
+use vars qw(@ISA);
+use Net::XRC::Data;
+
+@ISA = qw(Net::XRC::Data);
+
+sub encode {
+ my $self = shift;
+ my $string = $$self;
+ $string =~ s/(["\\])/\\$1/g;
+ qq("$string");
+}
+
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;
generated by cgit v1.2.1 (git 2.18.0) at 2025-08-22 07:51:55 +0000