/usr/share/perl5/WWW/CNic/Response.pm is in libwww-cnic-perl 0.38-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 | # Copyright (c) 2011 CentralNic Ltd. All rights reserved. This program is
# free software; you can redistribute it and/or modify it under the same
# terms as Perl itself.
# $Id: Response.pm,v 1.15 2011/05/13 13:31:49 gavin Exp $
package WWW::CNic::Response;
use vars qw($VERSION);
=pod
=head1 NAME
WWW::CNic::Response - base class for WWW::CNic response objects.
=head1 SYNOPSIS
use WWW::CNic;
my $query = WWW::CNic->new( OPTIONS );
my $response = $query->execute();
=head1 DESCRIPTION
This is the base class for all response objects returned by WWW::CNic. Each query type returns a different object, all of which inherit their basic functionality from this module.
This module should never be accessed directly, only through its children.
=head1 METHODS
All the child classes of WWW::CNic::Response inherit the following methods:
$response->is_success();
This returns true if the transaction was completed successfully. If there was a server-side error due to invalid data or a system error, or there was an HTTP error this method will return undef.
$response->is_error();
This is the converse of C<is_success>. It returns true if there was an error.
$response->error();
This returns the error message generated, if any. This can be either a server-side error message or an HTTP error.
$response->message();
This returns the message returned when the transaction was successful.
$response->keys();
This returns an array containing all the keys returned by the server.
$response->response($key);
This returns the value corresponding to C<$key> as returned by the server. This may be a scalar, or a reference to an array or hash, depending on the context.
$response->dump();
This prints a human-readable dump of the data stored in the object to C<STDOUT>. Mainly useful in debugging.
=head1 COPYRIGHT
This module is (c) 2011 CentralNic Ltd. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=head1 SEE ALSO
=over
=item *
http://toolkit.centralnic.com/
=item *
L<WWW::CNic>
=back
=cut
sub new {
my $self = {};
(my $package, $self->{_raw}) = @_;
foreach my $line(split(/\n/, $self->{_raw})) {
chomp($line);
my ($name, $value) = split(/:\s?/, $line, 2);
if ($value =~ /::/) {
if ($value =~ /=/) {
my %values;
foreach my $value(split(/::/, $value)) {
my ($n, $v) = split(/=/, $value, 2);
$v =~ s/^\"?//;
$v =~ s/\"?$//;
$values{$n} = $v;
}
push(@{$self->{_response}{lc($name)}}, \%values);
} else {
my @values = split(/::/, $value);
push(@{$self->{_response}{lc($name)}}, \@values);
}
} else {
push(@{$self->{_response}{lc($name)}}, $value);
}
}
bless($self, $package);
return $self;
}
sub is_success {
my $self = shift;
return 1 if (($self->{_response}{'query-status'}[0] ? $self->{_response}{'query-status'}[0] : $self->{_response}{'status'}[0]) == 0);
return undef;
}
sub is_error {
my $self = shift;
return undef if ($self->is_success());
return 1;
}
sub error {
my $self = shift;
return $self->{_response}{message}[0];
}
sub message {
my $self = shift;
return $self->response('message');
}
sub keys {
my $self = shift;
return CORE::keys(%{$self->{_response}});
}
sub response {
my ($self, $key) = @_;
my $value = $self->{_response}{$key};
if (ref($value) eq 'ARRAY' && scalar(@{$value}) == 1) {
return ${$value}[0];
} else {
return $value;
}
}
sub dump {
my $self = shift;
foreach my $key($self->keys()) {
print $key . (' ' x (19 - length($key))) . ': ' . $self->_expand($self->response($key)) . "\n";
}
return;
}
sub _expand {
my ($self, $ref) = @_;
if (ref($ref) eq 'ARRAY') {
my @values;
foreach my $el(@{$ref}) {
push (@values, $self->_expand($el));
}
return join(', ', @values);
} elsif (ref($ref) eq 'HASH') {
my @values;
foreach my $key(CORE::keys(%{$ref})) {
push(@values, $key.'='.$self->_expand(${$ref}{$key}));
}
return join(', ', @values);
} else {
return $ref;
}
}
1;
|