1 |
package Ermyth; |
2 |
|
3 |
use strict; |
4 |
use warnings FATAL => 'all'; |
5 |
use utf8; |
6 |
|
7 |
my $rcsid = '$Id: Ermyth.pm,v 1.3 2007-07-25 00:37:23 pippijn Exp $'; |
8 |
|
9 |
use Carp; |
10 |
use JSON::RPC::Client; |
11 |
use Ermyth::Accessor; |
12 |
|
13 |
acc_rw "authcookie"; |
14 |
acc_rw "ip"; |
15 |
acc_rw "user"; |
16 |
|
17 |
our $VERSION = "1.02"; |
18 |
|
19 |
=head1 Ermyth |
20 |
|
21 |
A Perl JSON Remote Procedure Call interface for Ermyth. |
22 |
|
23 |
=cut |
24 |
|
25 |
sub new { |
26 |
my ($class, $args) = @_; |
27 |
my $self = bless { |
28 |
rpc => new JSON::RPC::Client, |
29 |
uri => delete $args->{uri} || croak "You need to provide an URI", |
30 |
%$args |
31 |
}, $class; |
32 |
|
33 |
$self |
34 |
} |
35 |
|
36 |
sub login { |
37 |
my ($self, $user, $password) = @_; |
38 |
|
39 |
my $obj = { |
40 |
method => "ermyth.login", |
41 |
params => [$user, $password, $self->ip], |
42 |
}; |
43 |
|
44 |
my $res = $self->{rpc}->call ($self->{uri}, $obj); |
45 |
|
46 |
if ($res) { |
47 |
return Ermyth::Error->new ($res) |
48 |
if $res->is_error; |
49 |
$self->authcookie ($res->result->{result}); |
50 |
$self->user ($user); |
51 |
} else { |
52 |
return Ermyth::HTTPError->new ($self->{rpc}->status_line); |
53 |
} |
54 |
|
55 |
$self->authcookie |
56 |
} |
57 |
|
58 |
sub logout { |
59 |
my ($self) = @_; |
60 |
|
61 |
my $obj = { |
62 |
method => "ermyth.logout", |
63 |
params => [$self->authcookie, $self->user], |
64 |
}; |
65 |
|
66 |
my $res = $self->{rpc}->call ($self->{uri}, $obj); |
67 |
|
68 |
if ($res) { |
69 |
return Ermyth::Error->new ($res) |
70 |
if $res->is_error; |
71 |
$self->authcookie (undef); |
72 |
$self->user (undef); |
73 |
$self->ip (undef); |
74 |
} else { |
75 |
return Ermyth::HTTPError->new ($self->{rpc}->status_line); |
76 |
} |
77 |
|
78 |
1 |
79 |
} |
80 |
|
81 |
sub command { |
82 |
my ($self, $svs, @args) = @_; |
83 |
|
84 |
my $obj = { |
85 |
method => "ermyth.command", |
86 |
params => [$self->authcookie, $self->user, $self->ip, $svs->name, @args], |
87 |
}; |
88 |
|
89 |
my $res = $self->{rpc}->call ($self->{uri}, $obj); |
90 |
|
91 |
if ($res) { |
92 |
return Ermyth::Error->new ($res) |
93 |
if $res->is_error; |
94 |
return $res->result->{result} |
95 |
if $res->result; |
96 |
return; |
97 |
} else { |
98 |
return Ermyth::HTTPError->new ($self->{rpc}->status_line); |
99 |
} |
100 |
} |
101 |
|
102 |
regservice "ChanServ"; |
103 |
regservice "GameServ"; |
104 |
regservice "MemoServ"; |
105 |
regservice "NickServ"; |
106 |
regservice "OperServ"; |
107 |
|
108 |
|
109 |
package Ermyth::Error; |
110 |
|
111 |
use strict; |
112 |
use warnings; |
113 |
use utf8; |
114 |
|
115 |
use Ermyth::Accessor; |
116 |
|
117 |
acc_ro "message"; |
118 |
acc_ro "code"; |
119 |
|
120 |
sub new { |
121 |
my ($class, $args) = @_; |
122 |
|
123 |
bless { |
124 |
message => $args->error_message, |
125 |
code => $args->{content}->{error}->{code}, |
126 |
}, $class |
127 |
} |
128 |
|
129 |
|
130 |
package Ermyth::HTTPError; |
131 |
|
132 |
use strict; |
133 |
use warnings; |
134 |
use utf8; |
135 |
|
136 |
use Ermyth::Accessor; |
137 |
|
138 |
acc_ro "message"; |
139 |
acc_ro "code"; |
140 |
|
141 |
sub new { |
142 |
my ($class, $error) = @_; |
143 |
|
144 |
my ($code, $text) = $error =~ /(\d+) (.+)/; |
145 |
|
146 |
bless { |
147 |
message => $text, |
148 |
code => $code, |
149 |
}, $class |
150 |
} |
151 |
|
152 |
=head1 AUTHOR |
153 |
|
154 |
Copyright E<xa9> 2007 Pippijn van Steenhoven |
155 |
|
156 |
=head1 LICENSE |
157 |
|
158 |
This library is free software, you can redistribute it and/or modify |
159 |
it under the same terms as Perl itself. |
160 |
|
161 |
=cut |
162 |
|
163 |
1 |