File Coverage

blib/lib/Mojo/SinaWeibo.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Mojo::SinaWeibo;
2             $Mojo::SinaWeibo::VERSION = "1.4";
3 1     1   18119 use Mojo::Base 'Mojo::EventEmitter';
  1         8900  
  1         8  
4 1     1   2110 use Mojo::JSON qw(encode_json decode_json);
  1         98044  
  1         102  
5 1     1   12 use Mojo::Util qw(b64_encode dumper sha1_sum url_escape url_unescape encode decode);
  1         8  
  1         125  
6 1     1   849 use Mojo::URL;
  1         9177  
  1         11  
7 1     1   462 use Crypt::RSA::ES::PKCS1v15;
  0            
  0            
8             use Crypt::RSA::Key::Public;
9             use POSIX;
10             use Carp;
11             use Time::HiRes qw();
12             use List::Util qw(first);
13             use Mojo::IOLoop;
14             use File::Temp qw/tempfile/;
15             use Encode::Locale ;
16             use Fcntl ':flock';
17              
18             has 'user';
19             has 'pwd';
20             has ua_debug => 0;
21             has log_level => 'info'; #debug|info|warn|error|fatal
22             has log_path => undef;
23              
24             has max_timeout_count => 3;
25             has timeout => 10;
26             has timeout_count => 0;
27              
28             has log => sub{
29             require Mojo::Log;
30             no warnings 'redefine';
31             *Mojo::Log::append = sub{
32             my ($self, $msg) = @_;
33             return unless my $handle = $self->handle;
34             flock $handle, LOCK_EX;
35             $handle->print(encode("console_out", $msg)) or croak "Can't write to log: $!";
36             flock $handle, LOCK_UN;
37             };
38             Mojo::Log->new(path=>$_[0]->log_path,level=>$_[0]->log_level,format=>sub{
39             my ($time, $level, @lines) = @_;
40             my $title="";
41             if(ref $lines[0] eq "HASH"){
42             my $opt = shift @lines;
43             $time = $opt->{"time"} if defined $opt->{"time"};
44             $title = (defined $opt->{"title"})?$opt->{title} . " ":"";
45             $level = $opt->{level} if defined $opt->{"level"};
46             }
47             @lines = split /\n/,join "",@lines;
48             my $return = "";
49             $time = POSIX::strftime('[%y/%m/%d %H:%M:%S]',localtime($time));
50             for(@lines){
51             $return .=
52             $time
53             . " "
54             . "[$level]"
55             . " "
56             . $title
57             . $_
58             . "\n";
59             }
60             return $return;
61             });
62             };
63             has ua => sub {
64             local $ENV{MOJO_USERAGENT_DEBUG} = 0;
65             require Mojo::UserAgent;
66             Mojo::UserAgent->new(
67             request_timeout => 30,
68             inactivity_timeout => 30,
69             max_redirects => 7,
70             transactor => Mojo::UserAgent::Transactor->new(
71             name => 'Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062'
72             ),
73             );
74             };
75              
76             has 'nick';
77             has login_type => "rsa";#wsse
78             has api_form => "HTML";#HTML|JSON
79             has login_state => "invalid";
80             has 'need_pin' => 0;
81             has rsa => sub {Crypt::RSA::ES::PKCS1v15->new};
82             has 'servertime';
83             has 'pcid';
84             has 'pubkey';
85             has 'nonce';
86             has 'rsakv';
87             has 'exectime';
88             has 'verifycode';
89             has 'uid';
90             has 'home';
91             has 'showpin';
92             has 'ticket';
93             has 'im_msg_id' => 0;
94             has 'im_ack' => -1;
95             has 'im';
96             has 'im_clientid';
97             has 'im_channel';
98             has 'im_server';
99             has 'im_connect_interval' => 0;
100             has 'im_xiaoice_uid' => 5175429989;
101             has 'im_client_lag_data' => sub{[]};
102             has 'im_server_lag_data' => sub{[]};
103             has 'im_ready' => 0;
104             has im_user => sub {[]};
105             has 'im_api_server';
106              
107             sub search_im_user{
108             my $s = shift;
109             my %p = @_;
110             return if 0 == grep {defined $p{$_}} keys %p;
111             if(wantarray){
112             return grep {my $f = $_;(first {$p{$_} ne $f->{$_}} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$s->im_user};
113             }
114             else{
115             return first {my $f = $_;(first {$p{$_} ne $f->{$_}} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$s->im_user};
116             }
117             }
118             sub add_im_user{
119             my $s = shift;
120             my $user = shift;
121             $s->die("不支持的数据类型") if ref $user ne "HASH";
122             $s->die("不支持的数据类型") if not exists $user->{uid} ;
123             $s->die("不支持的数据类型") if not exists $user->{nick} ;
124             my $nocheck = shift;
125             if(@{$s->im_user} == 0){
126             push @{$s->im_user},$user;
127             return $s;
128             }
129             if($nocheck){
130             push @{$s->im_user},$user;
131             return $s;
132             }
133             my $u = $s->search_im_user(uid => $user->{uid});
134             if(defined $u){
135             $u = $user;
136             }
137             else{#new user
138             push @{$s->im_user},$user;
139             }
140             return $s;
141             }
142              
143             sub auth {
144             my $s = shift;
145             return $s if $s->login_state eq "success";
146             $s->prelogin();
147             $s->login();
148             if($s->login_state eq "success"){
149             $s->timeout_count(0);
150             return $s
151             }
152             $s->fatal("授权失败,程序处于离线状态");
153             $s->login_state("stop");
154             }
155             sub login {
156             my $s = shift;
157             $s->info("正在登录...");
158             my $api = 'http://login.sina.com.cn/sso/login.php';
159             my $sp = "";
160             if($s->login_type eq "rsa"){
161             $s->debug("登录使用rsa加密算法");
162             my $public = Crypt::RSA::Key::Public->new;
163             $public->n("0x" . $s->pubkey);
164             $public->e("0x10001");
165             $sp =
166             lc join "",unpack "H*",
167             $s->rsa->encrypt(
168             Key=>$public,
169             Message=>$s->servertime . "\t" . $s->nonce . "\n" . $s->pwd
170             );
171             }
172             elsif($s->login_type eq "wsse"){
173             $s->debug("登录使用wsse加密算法");
174             $sp = sha1_sum( "" . sha1_sum(sha1_sum($s->pwd)) . $s->servertime . $s->nonce );
175             }
176             my $post = {
177             entry => "weibo",
178             gateway => 1,
179             from => "",
180             savestate => 7,
181             useticket => 1,
182             pagerefer => '',
183             vsnf => 1,
184             service => "miniblog",
185             pwencode => ($s->login_type eq "rsa"?"rsa2":"wsse"),
186             encoding => "UTF-8",
187             prelt => $s->exectime,
188             url => 'http://weibo.com/ajaxlogin.php?framelogin=1&callback=parent.sinaSSOController.feedBackUrlCallBack',
189             returntype => ($s->api_form eq "JSON"?"TEXT":"META"),
190             servertime => $s->servertime,
191             nonce => $s->nonce,
192             rsakv => $s->rsakv,
193             su => b64_encode(url_escape($s->user),""),
194             sp => $sp,
195             };
196              
197             $post->{door} = $s->verifycode if $s->need_pin;
198             $post->{pcid} = $s->pcid if $s->need_pin;
199             $post->{sr} = "1366*768" if $s->need_pin;
200              
201             my $tx = $s->ua->post($api . '?client=ssologin.js%28v1.4.18%29' ,form=>$post);
202             if($s->ua_debug){
203             print $tx->req->to_string,"\n";
204             print $tx->res->to_string,"\n";
205             }
206             return unless $tx->success;
207             my ($retcode,$reason,$feedbackurl,$json);
208             if($post->{returntype} eq "META"){
209             return unless $tx->res->body =~/location.replace\(['"](.*?)['"]\)/;
210             $feedbackurl = Mojo::URL->new($1);
211             $retcode = $feedbackurl->query->param("retcode");
212             $reason = decode("gb2312",url_unescape($feedbackurl->query->param("reason"))) if defined $feedbackurl->query->param("reason");
213             }
214             elsif($post->{returntype} eq "TEXT"){
215             $json = decode_json($tx->res->body);
216             $retcode = $json->{retcode};
217             $reason = $json->{reason} if exists $json->{reason};
218             }
219             if($retcode == 0){
220             if($post->{returntype} eq "TEXT"){
221             $s->ticket($json->{ticket})
222             ->uid($json->{uid})
223             ->home("http://weibo.com/u/$json->{uid}/home")
224             ->nick($json->{nick})
225             ->login_state("success");
226             $s->info("登录成功");
227             }
228             elsif($post->{returntype} eq "META"){
229             $s->ticket($feedbackurl->query->param("ticket"));
230             if($tx->res->body=~/sinaSSOController\.setCrossDomainUrlList\((.*?)\)/){
231             my $json = decode_json($1);
232             my $i=0;
233             $s->debug("处理跨域访问域名列表...");
234             for (@{ $json->{arrURL} }){
235             my $url = Mojo::URL->new($_);
236             $url->query->merge(
237             callback => "sinaSSOController.doCrossDomainCallBack",
238             scriptId => "ssoscript$i",
239             client => 'ssologin.js(v1.4.18)',
240             _ => $s->time(),
241             );
242             my $tx = $s->ua->get($url->to_string);
243             if($s->ua_debug){
244             print $tx->req->to_string,"\n";
245             print $tx->res->to_string,"\n";
246             }
247             $i++;
248             }
249             }
250             my $tx = $s->ua->get($feedbackurl->to_string);
251             if($s->ua_debug){
252             print $tx->req->to_string,"\n";
253             print $tx->res->to_string,"\n";
254             }
255             return unless $tx->success;
256             return unless $tx->res->body =~/parent\.sinaSSOController\.feedBackUrlCallBack\((.*?)\)/;
257             $s->debug("获取登录回调参数...");
258             my $json = decode_json($1);
259             return unless $json->{result};
260             $s->uid($json->{userinfo}{uniqueid})->home("http://weibo.com/u/$json->{userinfo}{uniqueid}/home");
261             $s->debug("进行首页跳转...");
262             if(defined $json->{redirect}){
263             my $tx = $s->ua->get($json->{redirect}) ;
264             return unless $tx->success;
265             $s->login_state("success");
266             $s->info("登录成功");
267             }
268             else{
269             my $tx = $s->ua->get("http://weibo.com/" . $json->{userinfo}{userdomain});
270             return unless $tx->success;
271             $s->login_state("success");
272             $s->info("登录成功");
273             }
274             }
275             }
276             elsif($retcode ==4049){
277             $s->get_pin() && $s->login();
278             }
279             else{
280             $s->error($reason?"登录失败: $retcode($reason)":"登录失败: $retcode");
281             return;
282             }
283             }
284              
285             sub get_im_info{
286             my $s = shift;
287             return +{channel=>$s->im_channel,server=>$s->im_server} if (defined $s->im_channel and $s->im_server);
288             my $api = "http://nas.im.api.weibo.com/im/webim.jsp";
289             my $callback = "IM_" . $s->time();
290             my $query_string = {
291             uid => $s->uid,
292             returntype => "json",
293             v => "1.1",
294             callback => $callback,
295             __rnd => $s->time(),
296             };
297             $s->debug("获取私信服务器地址...");
298             my $tx = $s->ua->get($api,{Referer=>$s->home},form=>$query_string);
299             if($s->ua_debug){
300             print $tx->req->to_string,"\n";
301             print $tx->res->to_string,"\n";
302             }
303             return unless $tx->success;
304             return unless $tx->res->body=~/\Q$callback\E\((.*?)\)/;
305             my $json = decode_json($1);
306             $json->{server} =~s#^http#ws#;
307             $json->{server} =~s#/$##;
308             $s->debug("私信服务器地址[ " . $json->{server} . $json->{channel} . " ]");
309             $json->{server} .= "/im";
310             $s->im_server($json->{server})->im_channel($json->{channel});
311             return {channel=>$json->{channel},server=>$json->{server}};
312             }
313              
314              
315             sub get_pin{
316             my $s = shift;
317             $s->info("正在获取验证码图片...");
318             my $api = 'http://login.sina.com.cn/cgi/pin.php';
319             my $query_string = {
320             r => POSIX::floor(rand() * (10**8)),
321             s => 0,
322             p => $s->pcid,
323             };
324             my $tx = $s->ua->get($api,form=>$query_string);
325             if($s->ua_debug){
326             print $tx->req->to_string,"\n";
327             print $tx->res->headers->to_string,"\n";
328             }
329             return unless $tx->success;
330             my ($fh, $filename) = tempfile("sinaweibo_img_verfiy_XXXX",SUFFIX =>".png",TMPDIR => 1);
331             binmode $fh;
332             print $fh $tx->res->body;
333             close $fh;
334             my $filename_for_console = decode("locale_fs",$filename);
335             my $info = $s->log->format->(CORE::time,"info","请输入图片验证码 [ $filename_for_console ]: ");
336             chomp $info;
337             $s->log->append($info);
338             my $input;
339             chomp($input=);
340             $s->verifycode($input)->need_pin(1);
341             return 1;
342             }
343              
344              
345             sub prelogin{
346             my $s = shift;
347             $s->info("准备登录微博帐号[ ".$s->user." ]");
348             my $api = 'http://login.sina.com.cn/sso/prelogin.php';
349             my $query_string = {
350             entry => 'weibo',
351             client => 'ssologin.js(v1.4.18)',
352             callback => 'sinaSSOController.preloginCallBack',
353             su => 'TGVuZGZhdGluZyU0MHNpbmEuY29t',
354             rsakt => 'mod',
355             checkpin => '1',
356             _ => $s->time(),
357             };
358             my $tx = $s->ua->get($api,form=>$query_string);
359             if($s->ua_debug){
360             print $tx->req->to_string,"\n";
361             print $tx->res->to_string,"\n";
362             }
363             return unless $tx->success;
364             return unless $tx->res->body =~ /^sinaSSOController\.preloginCallBack\((.*)\)$/;
365             my $json = decode_json($1);
366             return if $json->{retcode}!=0;
367             for (qw(servertime pcid pubkey nonce rsakv exectime showpin)){
368             $s->$_($json->{$_}) if exists $json->{$_};
369             }
370             }
371              
372             sub gen_im_msg_id {
373             my $s = shift;
374             my $last_id = $s->im_msg_id;
375             $s->im_msg_id(++$last_id);
376             return $last_id;
377             }
378             sub gen_im_ack{
379             my $s = shift;
380             my $last_ack = $s->im_ack;
381             if($last_ack == -1){
382             $s->im_ack(0);
383             return $last_ack;
384             }
385             else{
386             $s->im_ack(++$last_ack);
387             return $last_ack;
388             }
389             }
390              
391             sub time{
392             my $s = shift;
393             return int(Time::HiRes::time * 1000);
394             }
395             sub gmtime_string {
396             my $s = shift;
397             my $time = shift;
398             $time = CORE::time unless defined $time;
399             my @DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
400             my @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
401             my %MoY;
402             @MoY{@MoY} = (1..12);
403             my ($sec, $min, $hour, $mday, $mon, $year, $wday) = CORE::gmtime($time);
404             sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
405             $DoW[$wday],
406             $mday, $MoY[$mon], $year+1900,
407             $hour, $min, $sec);
408             }
409              
410             sub gen_im_msg{
411             my $s = shift;
412             my $type = shift;
413             my $msg = {};
414             if($type eq "handshake"){
415             $msg =
416             {
417             version => "1.0",
418             minimumVersion => "0.9",
419             channel => "/meta/handshake",
420             supportedConnectionTypes=> ["websocket",],#"callback-polling"],
421             advice => {timeout=>60000,interval=>0},
422             id => $s->gen_im_msg_id,
423             ext => {ack => Mojo::JSON->true,timesync=>{tc=>$s->time,l=>0,o=>0}},
424             timestamp => $s->gmtime_string,
425             };
426             }
427             elsif($type eq "connect"){
428             $msg =
429             {
430             channel => "/meta/connect",
431             connectionType => "websocket",
432             clientId => $s->im_clientid,
433             id => $s->gen_im_msg_id(),
434             ext => {ack => $s->gen_im_ack(),timesync=>{tc=>$s->time,l=>0,o=>0}},
435             timestamp => $s->gmtime_string,
436             };
437             $msg->{advice} = {timeout=>0,} if $msg->{ext}{ack} == -1;
438             }
439             elsif($type eq "subscribe"){
440             my %p = @_;
441             $msg =
442             {
443             channel => "/meta/subscribe",
444             subscription => $p{channel},
445             id => $s->gen_im_msg_id,
446             clientId => $s->im_clientid,
447             ext => {timesync=>{tc=>$s->time,l=>0,o=>0}},
448             timestamp => $s->gmtime_string,
449             };
450             }
451             elsif($type eq "cmd"){
452             my %p = @_;
453             my $data ={};
454             $data = {cmd=>"recents"} if $p{cmd} eq "recents";
455             $data = {cmd=>"usersetting",subcmd=>"get",seq=>"get"} if $p{cmd} eq "usersetting";
456             if($p{cmd} eq "msg"){
457             $data = {cmd=>"msg",uid=>$p{uid},msg=>$p{msg}} ;
458             }
459             $msg =
460             {
461             channel => "/im/req",
462             data => $data,
463             id => $s->gen_im_msg_id,
464             clientId => $s->im_clientid,
465             timestamp => $s->gmtime_string,
466             };
467             }
468             return $msg;
469             }
470             sub parse_im_msg{
471             my $s = shift;
472             my $msg = shift;
473             print encode_json($msg),"\n" if $s->ua_debug;
474             for my $m(@{$msg}){
475             if($m->{channel} eq '/meta/handshake'){
476             $s->debug("收到服务器握手消息");
477             return unless first {$_ eq "websocket"} @{$m->{supportedConnectionTypes}};
478             return unless $m->{successful};
479             $s->debug("服务器握手成功");
480             $s->im_clientid($m->{clientId});
481             $s->im_send($s->gen_im_msg("subscribe",channel=>$s->im_channel));
482             $s->im_send($s->gen_im_msg("connect"));
483             }
484             elsif($m->{channel} eq "/meta/connect"){
485             $s->debug("收到服务器心跳响应 ack: ".$m->{ext}{ack});
486             return unless $m->{successful};
487             if(exists $m->{advice} and exists $m->{advice}{interval}){
488             $s->im_connect_interval($m->{advice}{interval}/1000);
489             }
490             $s->timer( $s->im_connect_interval,sub{
491             my $msg = $s->gen_im_msg("connect");
492             if(exists $m->{ext}{timesync}){
493             my $i = $s->time;
494             my $k = ($i -$m->{ext}{timesync}{tc} - $m->{ext}{timesync}{p})/2;
495             my $l = $m->{ext}{timesync}{ts} - $m->{ext}{timesync}{ts} - $k;
496             push @{$s->im_client_lag_data},$k;
497             push @{$s->im_server_lag_data},$l;
498             if(10<@{$s->im_server_lag_data}){
499             shift @{$s->im_server_lag_data};shift @{$s->im_client_lag_data};
500             }
501             my $n=0;
502             my $o=0;
503             for(my $p=0;$p<@{$s->im_server_lag_data};$p++){
504             $n+=$s->im_client_lag_data->[$p];
505             $o+=$s->im_server_lag_data->[$p];
506             }
507              
508             my $g = int($n/@{$s->im_server_lag_data});my $h=int($o/@{$s->im_server_lag_data});
509             $msg->{ext}{timesync}{l} = $g;
510             $msg->{ext}{timesync}{o} = $h;
511             }
512             $s->im_send($msg);
513             });
514             }
515             elsif($m->{channel} eq "/meta/subscribe"){
516             return unless $m->{successful};
517             $s->debug("收到服务器订阅响应消息");
518             if(@{$s->im_user} == 0){
519             $s->im_send($s->gen_im_msg("cmd",cmd=>"usersetting"));
520             $s->im_send($s->gen_im_msg("cmd",cmd=>"recents"));
521             }
522             else{
523             $s->im_ready(1);
524             $s->debug("私信服务器状态准备就绪");
525             $s->emit("im_ready");
526             }
527             }
528             elsif($m->{channel} eq "/im/req"){
529             next unless $m->{successful};
530             }
531             elsif($m->{channel} eq $s->im_channel){
532             return unless exists $m->{data}{type};
533             if($m->{data}{type} eq "recents"){
534             $s->im_user([ map {{uid=>$_->[0],nick=>$_->[1]}} @{$m->{data}{recents}} ]);
535             if(!$s->im_ready){
536             $s->im_ready(1);
537             $s->debug("私信服务器状态准备就绪");
538             $s->emit("im_ready");
539             }
540             }
541              
542             elsif( $m->{data}{type} eq "msg"){
543             for(@{$m->{data}{items}}){
544             my($uid,$msg,$time) = @$_[0..2];
545             my $u = $s->search_im_user(uid=>$uid);
546             my $nick = defined $u?$u->{nick}:"未知昵称";
547             $s->emit("receive_message",{uid=>$uid,nick=>$nick,content=>$msg,'time'=>int($time/1000)},{is_success=>1,code=>200,msg=>"正常响应"});
548             $s->emit_one("answer_message",{uid=>$uid,nick=>$nick,content=>$msg,'time'=>int($time/1000)},{is_success=>1,code=>200,msg=>"正常响应"});
549             }
550             }
551            
552             elsif($m->{data}{type} eq "synchroniz" ){
553             return unless exists $m->{data}{syncData};
554             my $syncdata = decode_json(encode("utf8",$m->{data}{syncData}));
555             return unless exists $syncdata->{msg};
556             return unless exists $syncdata->{uid};
557             my $time = exists $syncdata->{'time'}?int($syncdata->{'time'}/1000):CORE::time;
558             my($uid,$msg) = ($syncdata->{uid}, $syncdata->{msg});
559             my $u = $s->search_im_user(uid=>$uid);
560             my $nick = defined $u?$u->{nick}:"未知昵称";
561             $s->emit("send_message",{uid=>$uid,nick=>$nick,content=>$msg,'time'=>$time});
562             }
563             }
564             }
565            
566             }
567              
568             sub im_init{
569             my $s = shift;
570             return if $s->im_ready;
571             $s->im_msg_id(0)
572             ->im_ack(-1)
573             ->im_ready(0)
574             ->im(undef)
575             ->im_clientid(undef)
576             ->im_connect_interval(0);
577             my $im_info = $s->get_im_info();
578             return unless defined $im_info;
579             $s->ua->websocket($im_info->{server},sub{
580             my ($ua, $tx) = @_;
581             $s->error("Websocket服务器连接失败") and return unless $tx->is_websocket;
582             $s->im($tx);
583             $s->im->on(finish => sub {
584             my ($tx, $code, $reason) = @_;
585             $s->debug("WebSocket服务器关闭($code)");
586             $s->im_ready(0);
587             $s->debug("私信服务器状态失效");
588             });
589             $s->im->on(json=>sub{
590             my ($tx, $msg) = @_;
591             $s->parse_im_msg($msg);
592             });
593             if($s->im->is_established){
594             $s->debug("Websocket服务器连接成功");
595             $s->im_send($s->gen_im_msg("handshake"));
596             }
597             });
598             }
599              
600             sub im_speek{
601             my $s = shift;
602             my $uid = shift;
603             my $content = shift;
604             my $callback = pop;
605             $content = decode("utf8",$content) if defined $content;
606             if($s->login_state eq "stop"){
607             $callback->(undef,{is_success=>0,code=>503,msg=>encode("utf8","响应超时")});
608             return;
609             }
610             $s->auth() if $s->login_state eq "invalid";
611             #timeout handle
612             my $cb = {
613             cb=>sub{
614             #Mojo::IOLoop->remove($id);
615             $callback->(@_) if ref $callback eq "CODE";
616             },
617             status => 'wait',
618             };
619             $s->timer($s->timeout,sub{$s->emit(im_timeout=>$cb);});
620             if($s->im_ready){
621             my $msg = $s->gen_im_msg("cmd",cmd=>"msg",uid=>$uid,msg=>$content);
622             $s->im_send($msg,$cb);
623            
624             }
625             else{
626             $s->once(im_ready=>sub{
627             my $s = shift;
628             return if $cb->{status} eq "abort";
629             my $msg = $s->gen_im_msg("cmd",cmd=>"msg",uid=>$uid,msg=>$content);
630             $s->im_send($msg,$cb);
631             });
632             $s->im_init();
633             }
634              
635             }
636              
637             sub ask_xiaoice{
638             my $s = shift;
639             my $uid = $s->im_xiaoice_uid;
640             my $content = shift;
641             my $callback = pop;
642             $s->im_speek($uid,$content,$callback);
643             }
644             sub im_send{
645             my $s= shift;
646             my $msg = shift;
647             my $cb = shift;
648             if($msg->{channel} eq "/im/req" and $msg->{data}{cmd} eq "msg" and ref $cb->{cb} eq "CODE"){
649             $s->once(answer_message=>sub{
650             my $s = shift;
651             return if $cb->{status} eq "abort";
652             my($msg,$status) = @_;
653             if(defined $msg){
654             $msg->{nick} = encode("utf8",$msg->{nick});
655             $msg->{content} = encode("utf8",$msg->{content});
656             }
657             $status->{msg} = encode("utf8",$status->{msg});
658             $cb->{cb}->($msg,$status);
659             $cb->{status} = "done";
660             });
661             #push @{$s->im_send_callback},$cb;
662             };
663             $s->im->send({json=>[$msg]},sub{
664             print encode_json($msg),"\n" if $s->ua_debug;
665             $s->debug("发送usersetting消息") if ($msg->{channel} eq "/im/req" and $msg->{data}{cmd} eq "usersetting");
666             $s->debug("发送recents消息") if ($msg->{channel} eq "/im/req" and $msg->{data}{cmd} eq "recents");
667             $s->debug("发送握手消息") if $msg->{channel} eq "/meta/handshake";
668             $s->debug("发送心跳消息 ack: " . $msg->{ext}{ack}) if $msg->{channel} eq "/meta/connect";
669             $s->debug("发送订阅消息") if $msg->{channel} eq "/meta/subscribe";
670             if($msg->{channel} eq "/im/req" and $msg->{data}{cmd} eq "msg"){
671             my $u=$s->search_im_user(uid=>$msg->{data}{uid});
672             $s->emit("send_message"=>{
673             uid=>$msg->{data}{uid},
674             nick=>(defined $u?$u->{nick}:"未知昵称"),
675             'time'=>CORE::time,
676             content=>$msg->{data}{msg},
677             })
678             }
679             });
680             }
681             sub run{
682             my $s = shift;
683             my %p = @_ if @_>1 and @_%2==0;
684             $s->on(im_timeout=>sub{
685             my $s = shift;
686             my $cb = shift;
687             return if $cb->{status} eq "done";
688             $s->warn("私信消息响应超时,放弃等待");
689             $cb->{status} = 'abort';
690             $cb->{cb}->(undef,{is_success=>0,code=>503,msg=>encode("utf8","响应超时")}) if ref $cb->{cb} eq "CODE";
691             my $count = $s->timeout_count;
692             $s->timeout_count(++$count);
693             if($s->timeout_count >= $s->max_timeout_count){
694             $s->im_ready(0);
695             $s->login_state("invalid");
696             $s->emit("invalid");
697             }
698             });
699             $s->on(receive_message=>sub{
700             my $s = shift;
701             my $msg = shift;
702             return if ref $msg ne "HASH";
703             $s->info({level=>"私信消息",'time'=>$msg->{'time'},title=>"$msg->{nick} :"},$msg->{content});
704             });
705             $s->on(send_message=>sub{
706             my $s = shift;
707             my $msg = shift;
708             return if ref $msg ne "HASH";
709             $s->info({level=>"私信消息",'time'=>$msg->{'time'},title=>"我->$msg->{nick} :"},$msg->{content});
710             });
711              
712             $s->on(invalid=>sub{
713             my $s = shift;
714             $s->warn("程序当前状态不可用,尝试重新授权");
715             $s->auth();
716             });
717              
718             if(exists $p{enable_api_server} and $p{enable_api_server} ==1){
719             package Mojo::SinaWeibo::Openxiaoice;
720             use Encode;
721             use Mojolicious::Lite;
722             any [qw(GET POST)] => '/openxiaoice/ask' => sub{
723             my $c = shift;
724             my $q = encode("utf8",$c->param("q"));
725             $c->render_later;
726             $s->ask_xiaoice($q,sub{
727             my($msg,$status) = @_;
728             if($status->{is_success}){
729             $c->render(json=>{code=>1,answer=>decode("utf8",$msg->{content})});
730             }
731             else{
732             $c->render(json=>{code=>0,answer=>undef,reason=>decode("utf8",$status->{msg})});
733             }
734             });
735             };
736             any '/*whatever' => sub{whatever=>'',$_[0]->render(text => "request error",status=>403)};
737             package Mojo::SinaWeibo;
738             require Mojo::SinaWeibo::Server;
739             my $data = [{host=>$p{host}||"0.0.0.0",port=>$p{port}||3000}] ;
740             my $server = Mojo::SinaWeibo::Server->new();
741             $s->im_api_server($server);
742             $server->app($server->build_app("Mojo::SinaWeibo::Openxiaoice"));
743             $server->app->secrets("hello world");
744             $server->app->log($s->log);
745             $server->listen($data) if ref $data eq "ARRAY" ;
746             $server->start;
747             }
748              
749             Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
750             }
751              
752             sub emit_one{
753             my ($s, $name) = (shift, shift);
754             if (my $e = $s->{events}{$name}) {
755             my $cb = shift @$e;
756             $s->$cb(@_);
757             }
758             return $s;
759             }
760             sub timer{
761             my $s = shift;
762             Mojo::IOLoop->timer(@_);
763             }
764             sub recurring{
765             my $s = shift;
766             Mojo::IOLoop->recurring(@_);
767             }
768              
769             sub die{
770             my $s = shift;
771             local $SIG{__DIE__} = sub{$s->log->fatal(@_);exit -1};
772             Carp::confess(@_);
773             }
774             sub info{
775             my $s = shift;
776             $s->log->info(@_);
777             $s;
778             }
779             sub warn{
780             my $s = shift;
781             $s->log->warn(@_);
782             $s;
783             }
784             sub error{
785             my $s = shift;
786             $s->log->error(@_);
787             $s;
788             }
789             sub fatal{
790             my $s = shift;
791             $s->log->fatal(@_);
792             $s;
793             }
794             sub debug{
795             my $s = shift;
796             $s->log->debug(@_);
797             $s;
798             }
799             1;