File Coverage

blib/lib/Mojo/SinaWeibo.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


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