line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mojo::Webqq; |
2
|
1
|
|
|
1
|
|
67588
|
use strict; |
|
1
|
|
|
|
|
11
|
|
|
1
|
|
|
|
|
27
|
|
3
|
1
|
|
|
1
|
|
6
|
use Carp (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
40
|
|
4
|
|
|
|
|
|
|
$Mojo::Webqq::VERSION = "2.2.5"; |
5
|
1
|
|
|
1
|
|
395
|
use Mojo::Webqq::Base 'Mojo::EventEmitter'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
6
|
|
6
|
1
|
|
|
1
|
|
525
|
use Mojo::Webqq::Log; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
9
|
|
7
|
1
|
|
|
1
|
|
666
|
use Mojo::Webqq::Cache; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
38
|
|
8
|
1
|
|
|
1
|
|
9
|
use Time::HiRes qw(gettimeofday); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
7
|
|
9
|
1
|
|
|
1
|
|
190
|
use File::Spec (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
10
|
1
|
|
|
1
|
|
5
|
use base qw(Mojo::Webqq::Model Mojo::Webqq::Client Mojo::Webqq::Plugin Mojo::Webqq::Request Mojo::Webqq::Util Mojo::Webqq::Model::Ext); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
553
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
has domain => 'w.qq.com'; |
13
|
|
|
|
|
|
|
has account => sub{ $ENV{MOJO_WEBQQ_ACCOUNT} || 'default'}; |
14
|
|
|
|
|
|
|
has start_time => time; |
15
|
|
|
|
|
|
|
has pwd => undef; |
16
|
|
|
|
|
|
|
has security => 0; |
17
|
|
|
|
|
|
|
has mode => 'online'; #online|away|busy|silent|hidden|offline|callme, |
18
|
|
|
|
|
|
|
has type => 'smartqq'; #smartqq |
19
|
|
|
|
|
|
|
has login_type => 'qrlogin'; #qrlogin|login |
20
|
|
|
|
|
|
|
has http_debug => sub{$ENV{MOJO_WEBQQ_HTTP_DEBUG} || 0 }; |
21
|
|
|
|
|
|
|
has ua_debug => sub{$_[0]->http_debug}; |
22
|
|
|
|
|
|
|
has ua_debug_req_body => sub{$_[0]->ua_debug}; |
23
|
|
|
|
|
|
|
has ua_debug_res_body => sub{$_[0]->ua_debug}; |
24
|
|
|
|
|
|
|
has ua_connect_timeout => 10; |
25
|
|
|
|
|
|
|
has ua_request_timeout => 120; |
26
|
|
|
|
|
|
|
has ua_inactivity_timeout => 120; |
27
|
|
|
|
|
|
|
has model_update_timeout => 15;#sub{$_[0]->ua_request_timeout}; |
28
|
|
|
|
|
|
|
has log_level => 'info'; #debug|info|msg|warn|error|fatal |
29
|
|
|
|
|
|
|
has log_path => undef; |
30
|
|
|
|
|
|
|
has log_encoding => undef; #utf8|gbk|... |
31
|
|
|
|
|
|
|
has log_head => undef; |
32
|
|
|
|
|
|
|
has log_unicode => 0; |
33
|
|
|
|
|
|
|
has log_console => 1; |
34
|
|
|
|
|
|
|
has send_interval => 3; #全局发送消息间隔时间 |
35
|
|
|
|
|
|
|
has check_account => 0; #是否检查预设账号与实际登录账号是否匹配 |
36
|
|
|
|
|
|
|
has disable_color => ($^O eq 'MSWin32' ? 1 : 0); #是否禁用终端打印颜色 |
37
|
|
|
|
|
|
|
has ignore_send_retcode => sub{[1202,100100]}; #对发送消息返回这些状态码不认为发送失败,不重试 |
38
|
|
|
|
|
|
|
has ignore_poll_retcode => sub{[102,109,110,1202,100012]}; #对接收消息返回这些状态码不认为接收失败,不重新登录 |
39
|
|
|
|
|
|
|
has ignore_poll_http_code => sub{[504,502]}; #忽略接收消息请求返回的502/504状态码,因为并不影响消息接收,以免引起恐慌 |
40
|
|
|
|
|
|
|
has ignore_unknown_id => 1; #其他设备上自己发送的消息,在webqq上会以接受消息的形式再次接收到,id还未知,是否忽略掉这种消息 |
41
|
|
|
|
|
|
|
has allow_message_sync => 0; #是否允许同步来自其他设备登录账号发送的消息,由于webqq自身发送消息后也会收到服务端重复的消息,且没办法和来自其他设备的消息区分,会导致出现一些不期望的结果,比如某些插件会陷入死循环等,因此默认不开启消息同步,如果你只是用来api发送消息或者irc聊天,则开启此选项,可以同步来自其他设备的消息,体验会更好一些 |
42
|
|
|
|
|
|
|
has json_codec_mode => 0; #0表示使用from_json/to_json 1表示使用decode_json/encode_json |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
has default_send_real_comp_sign => 0; #设为真值则不对发送出的<>进行转化。 |
45
|
|
|
|
|
|
|
# 然而这样便只能送出<>。 |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
has group_member_card_cut_length => 21; #群名片截取长度 |
48
|
|
|
|
|
|
|
has group_member_card_ext_only => 0; #群名片信息是否只从扩展接口中获取,这样能够获取到完整的群名片,但并不是100%可靠 |
49
|
|
|
|
|
|
|
has group_member_use_fullcard => 0; #使用完整的群名片。 |
50
|
|
|
|
|
|
|
has group_member_use_friend_markname => 1; #使用备注名(如果存在)。 |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
#原始信息中包含id/name/card |
53
|
|
|
|
|
|
|
#扩展信息中包含uid/name/card |
54
|
|
|
|
|
|
|
#二者没办法直接建立关联,只能够通过 name+card 相同时认为是匹配同一个用户,并非严谨,但大部分情况下可以满足要求 |
55
|
|
|
|
|
|
|
#group_member_identify_callback提供了对name和card进行自定义处理 |
56
|
|
|
|
|
|
|
#传递给group_member_identify_callback的参数是群成员的 ($name,$card) |
57
|
|
|
|
|
|
|
#默认 group_member_identify_callback 不设置,相当于sub { my($name,$card)=@_; return $name . $card}; |
58
|
|
|
|
|
|
|
has group_member_identify_callback => undef; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
has notice_api => 'https://raw.githubusercontent.com/sjdy521/Mojo-Webqq/master/NOTICE'; |
61
|
|
|
|
|
|
|
has is_fetch_notice => 1; #是否启动时获取公告 |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
has is_init_friend => 1; #是否在首次登录时初始化好友信息 |
64
|
|
|
|
|
|
|
has is_init_group => 1; #是否在首次登录时初始化群组信息 |
65
|
|
|
|
|
|
|
has is_init_discuss => 1; #是否在首次登录时初始化讨论组信息 |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
has is_update_user => 0; #是否定期更新个人信息 |
68
|
|
|
|
|
|
|
has is_update_group => 1; #是否定期更新群组信息 |
69
|
|
|
|
|
|
|
has is_update_group_member => 1; #是否定期更新群成员信息 |
70
|
|
|
|
|
|
|
has is_update_group_member_ext => 0; #是否定期更新群成员扩展信息 |
71
|
|
|
|
|
|
|
has is_update_friend => 1; #是否定期更新好友信息 |
72
|
|
|
|
|
|
|
has is_update_discuss => 1; #是否定期更新讨论组信息 |
73
|
|
|
|
|
|
|
has update_interval => 600; #定期更新的时间间隔 |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
has encrypt_method => "perl"; #perl|js |
76
|
|
|
|
|
|
|
has tmpdir => sub {$ENV{MOJO_WEBQQ_TMPDIR} || File::Spec->tmpdir();}; |
77
|
|
|
|
|
|
|
has pic_dir => sub {$_[0]->tmpdir}; |
78
|
|
|
|
|
|
|
has cookie_path => sub {File::Spec->catfile($_[0]->tmpdir,join('','mojo_webqq_cookie_',$_[0]->account || 'default','.dat'))}; |
79
|
|
|
|
|
|
|
has verifycode_path => sub {File::Spec->catfile($_[0]->tmpdir,join('','mojo_webqq_verifycode_',$_[0]->account || 'default','.jpg'))}; |
80
|
|
|
|
|
|
|
has qrcode_path => sub {File::Spec->catfile($_[0]->tmpdir,join('','mojo_webqq_qrcode_',$_[0]->account || 'default','.png'))}; |
81
|
|
|
|
|
|
|
has pid_path => sub {File::Spec->catfile($_[0]->tmpdir,join('','mojo_webqq_pid_',$_[0]->account || 'default','.pid'))}; |
82
|
|
|
|
|
|
|
has state_path => sub {File::Spec->catfile($_[0]->tmpdir,join('','mojo_webqq_state_',$_[0]->account || 'default','.json'))}; |
83
|
|
|
|
|
|
|
has ioloop => sub {Mojo::IOLoop->singleton}; |
84
|
|
|
|
|
|
|
has keep_cookie => 1; |
85
|
|
|
|
|
|
|
has msg_ttl => 3; |
86
|
|
|
|
|
|
|
has controller_pid => sub{$ENV{MOJO_WEBQQ_CONTROLLER_PID}}; |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
has version => $Mojo::Webqq::VERSION; |
89
|
|
|
|
|
|
|
has user => sub {+{}}; |
90
|
|
|
|
|
|
|
has friend => sub {[]}; |
91
|
|
|
|
|
|
|
has group => sub {[]}; |
92
|
|
|
|
|
|
|
has discuss => sub {[]}; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
has plugins => sub{+{}}; |
95
|
|
|
|
|
|
|
has log => sub{ |
96
|
|
|
|
|
|
|
Mojo::Webqq::Log->new( |
97
|
|
|
|
|
|
|
encoding => $_[0]->log_encoding, |
98
|
|
|
|
|
|
|
unicode_support => $_[0]->log_unicode, |
99
|
|
|
|
|
|
|
path => $_[0]->log_path, |
100
|
|
|
|
|
|
|
level => $_[0]->log_level, |
101
|
|
|
|
|
|
|
head => $_[0]->log_head, |
102
|
|
|
|
|
|
|
disable_color => $_[0]->disable_color, |
103
|
|
|
|
|
|
|
console_output => $_[0]->log_console, |
104
|
|
|
|
|
|
|
) |
105
|
|
|
|
|
|
|
}; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
has sess_sig_cache => sub {Mojo::Webqq::Cache->new}; |
108
|
|
|
|
|
|
|
has id_to_qq_cache => sub {Mojo::Webqq::Cache->new}; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
has is_stop => 0; |
111
|
|
|
|
|
|
|
has is_ready => 0; |
112
|
|
|
|
|
|
|
has is_polling => 0; |
113
|
|
|
|
|
|
|
has ua_retry_times => 5; |
114
|
|
|
|
|
|
|
has is_first_login => -1; |
115
|
|
|
|
|
|
|
has login_state => "init";#init|relogin|success|scaning|confirming |
116
|
|
|
|
|
|
|
has qrcode_upload_url => undef; |
117
|
|
|
|
|
|
|
has qrcode_count => 0; |
118
|
|
|
|
|
|
|
has qrcode_count_max => 10; |
119
|
|
|
|
|
|
|
has send_failure_count => 0; |
120
|
|
|
|
|
|
|
has send_failure_count_max => 5; |
121
|
|
|
|
|
|
|
has poll_failure_count => 0; |
122
|
|
|
|
|
|
|
has poll_failure_count_max => 3; |
123
|
|
|
|
|
|
|
has poll_connection_id => undef; |
124
|
|
|
|
|
|
|
has message_queue => sub { $_[0]->gen_message_queue }; |
125
|
|
|
|
|
|
|
has ua => sub { |
126
|
|
|
|
|
|
|
my $self = shift; |
127
|
|
|
|
|
|
|
require Mojo::UserAgent; |
128
|
|
|
|
|
|
|
require Mojo::UserAgent::Proxy; |
129
|
|
|
|
|
|
|
#local $ENV{MOJO_USERAGENT_DEBUG} = $_[0]->ua_debug; |
130
|
|
|
|
|
|
|
require Storable if $self->keep_cookie; |
131
|
|
|
|
|
|
|
my $transactor = Mojo::UserAgent::Transactor->new( |
132
|
|
|
|
|
|
|
name => 'Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062' |
133
|
|
|
|
|
|
|
); |
134
|
|
|
|
|
|
|
my $default_form_generator = $transactor->generators->{form}; |
135
|
|
|
|
|
|
|
$transactor->add_generator(form => sub{ |
136
|
|
|
|
|
|
|
#my ($self, $tx, $form, %options) = @_; |
137
|
|
|
|
|
|
|
$self->reform($_[2],unicode=>1,recursive=>1,filter=>sub{ |
138
|
|
|
|
|
|
|
my($type,$deep,$key) = @_; |
139
|
|
|
|
|
|
|
return 1 if $type ne 'HASH'; |
140
|
|
|
|
|
|
|
return 1 if $deep == 0; |
141
|
|
|
|
|
|
|
return 0 if $deep == 1 and $key =~ /^filename|file|content$/; |
142
|
|
|
|
|
|
|
return 1; |
143
|
|
|
|
|
|
|
}); |
144
|
|
|
|
|
|
|
$default_form_generator->(@_); |
145
|
|
|
|
|
|
|
}); |
146
|
|
|
|
|
|
|
$transactor->add_generator(json=>sub{ |
147
|
|
|
|
|
|
|
$_[1]->req->body($self->to_json($_[2]))->headers->content_type('application/json'); |
148
|
|
|
|
|
|
|
return $_[1]; |
149
|
|
|
|
|
|
|
}); |
150
|
|
|
|
|
|
|
Mojo::UserAgent->new( |
151
|
|
|
|
|
|
|
proxy => sub{ my $proxy = Mojo::UserAgent::Proxy->new;$proxy->detect;$proxy}->(), |
152
|
|
|
|
|
|
|
max_redirects => 7, |
153
|
|
|
|
|
|
|
connect_timeout => $self->ua_connect_timeout, |
154
|
|
|
|
|
|
|
request_timeout => $self->ua_request_timeout, |
155
|
|
|
|
|
|
|
inactivity_timeout => $self->ua_inactivity_timeout, |
156
|
|
|
|
|
|
|
transactor => $transactor, |
157
|
|
|
|
|
|
|
); |
158
|
|
|
|
|
|
|
}; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
has is_need_img_verifycode => 0; |
161
|
|
|
|
|
|
|
has send_msg_id => sub { |
162
|
|
|
|
|
|
|
my ( $second, $microsecond ) = gettimeofday; |
163
|
|
|
|
|
|
|
my $send_msg_id = $second * 1000 + $microsecond; |
164
|
|
|
|
|
|
|
$send_msg_id = ( $send_msg_id - $send_msg_id % 1000 ) / 1000; |
165
|
|
|
|
|
|
|
$send_msg_id = ( $send_msg_id % 10000 ) * 10000; |
166
|
|
|
|
|
|
|
$send_msg_id; |
167
|
|
|
|
|
|
|
}; |
168
|
|
|
|
|
|
|
has uid => undef; |
169
|
|
|
|
|
|
|
has clientid => 53999199; |
170
|
|
|
|
|
|
|
has psessionid => undef; |
171
|
|
|
|
|
|
|
has ptwebqq => undef; |
172
|
|
|
|
|
|
|
has skey => undef; |
173
|
|
|
|
|
|
|
has vfwebqq => undef; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
has passwd_sig => ''; |
176
|
|
|
|
|
|
|
has verifycode => undef; |
177
|
|
|
|
|
|
|
has pt_verifysession => undef, |
178
|
|
|
|
|
|
|
has ptvfsession => undef; |
179
|
|
|
|
|
|
|
has md5_salt => undef; |
180
|
|
|
|
|
|
|
has cap_cd => undef; |
181
|
|
|
|
|
|
|
has isRandSalt => 0; |
182
|
|
|
|
|
|
|
has rc => 1; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
has api_check_sig => undef; |
185
|
|
|
|
|
|
|
has pt_login_sig => undef; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
has csrf_token => undef; |
188
|
|
|
|
|
|
|
has model_ext => undef; |
189
|
|
|
|
|
|
|
#{user=>0,friend=>0,friend_ext=>0,group=>0,group_ext=>0,discuss=>0} |
190
|
|
|
|
|
|
|
has model_status => sub {+{}}; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
sub state { |
193
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
194
|
0
|
0
|
|
|
|
|
$self->{state} = 'init' if not defined $self->{state}; |
195
|
0
|
0
|
0
|
|
|
|
if(@_ == 0){#get |
|
|
0
|
|
|
|
|
|
196
|
0
|
|
|
|
|
|
return $self->{state}; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
elsif($_[0] and $_[0] ne $self->{state}){#set |
199
|
0
|
|
|
|
|
|
my($old,$new) = ($self->{state},$_[0]); |
200
|
0
|
|
|
|
|
|
$self->{state} = $new; |
201
|
0
|
|
|
|
|
|
$self->emit(state_change=>$old,$new); |
202
|
|
|
|
|
|
|
} |
203
|
0
|
|
|
|
|
|
$self; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
sub on { |
206
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
207
|
0
|
|
|
|
|
|
my @return; |
208
|
0
|
|
|
|
|
|
while(@_){ |
209
|
0
|
|
|
|
|
|
my($event,$callback) = (shift,shift); |
210
|
0
|
|
|
|
|
|
push @return,$self->SUPER::on($event,$callback); |
211
|
|
|
|
|
|
|
} |
212
|
0
|
0
|
|
|
|
|
return wantarray?@return:$return[0]; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
sub emit { |
215
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
216
|
0
|
|
|
|
|
|
$self->SUPER::emit(@_); |
217
|
0
|
|
|
|
|
|
$self->SUPER::emit(all_event=>@_); |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
sub wait_once { |
220
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
221
|
0
|
|
|
|
|
|
my($timeout,$timeout_callback,$event,$event_callback)=@_; |
222
|
0
|
|
|
|
|
|
my ($timer_id, $subscribe_id); |
223
|
|
|
|
|
|
|
$timer_id = $self->timer($timeout,sub{ |
224
|
0
|
|
|
0
|
|
|
$self->unsubscribe($event,$subscribe_id); |
225
|
0
|
0
|
|
|
|
|
$timeout_callback->(@_) if ref $timeout_callback eq "CODE"; |
226
|
0
|
|
|
|
|
|
}); |
227
|
|
|
|
|
|
|
$subscribe_id = $self->once($event=>sub{ |
228
|
0
|
|
|
0
|
|
|
$self->ioloop->remove($timer_id); |
229
|
0
|
0
|
|
|
|
|
$event_callback->(@_) if ref $event_callback eq "CODE"; |
230
|
0
|
|
|
|
|
|
}); |
231
|
0
|
|
|
|
|
|
$self; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub wait { |
235
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
236
|
0
|
|
|
|
|
|
my($timeout,$timeout_callback,$event,$event_callback)=@_; |
237
|
0
|
|
|
|
|
|
my ($timer_id, $subscribe_id); |
238
|
|
|
|
|
|
|
$timer_id = $self->timer($timeout,sub{ |
239
|
0
|
|
|
0
|
|
|
$self->unsubscribe($event,$subscribe_id); |
240
|
0
|
0
|
|
|
|
|
$timeout_callback->(@_) if ref $timeout_callback eq "CODE";; |
241
|
0
|
|
|
|
|
|
}); |
242
|
|
|
|
|
|
|
$subscribe_id = $self->on($event=>sub{ |
243
|
0
|
0
|
|
0
|
|
|
my $ret = ref $event_callback eq "CODE"?$event_callback->(@_):0; |
244
|
0
|
0
|
|
|
|
|
if($ret){ $self->ioloop->remove($timer_id);$self->unsubscribe($event,$subscribe_id); } |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
245
|
0
|
|
|
|
|
|
}); |
246
|
0
|
|
|
|
|
|
$self; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub new { |
251
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
252
|
0
|
|
|
|
|
|
my $self = $class->Mojo::Base::new(@_); |
253
|
0
|
|
|
|
|
|
for my $env(keys %ENV){ |
254
|
0
|
0
|
|
|
|
|
if($env=~/^MOJO_WEBQQ_([A-Z_]+)$/){ |
255
|
0
|
|
|
|
|
|
my $attr = lc $1; |
256
|
0
|
0
|
|
|
|
|
next if $attr =~ /^plugin_/; |
257
|
0
|
0
|
|
|
|
|
$self->$attr($ENV{$env}) if $self->can($attr); |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
} |
260
|
0
|
|
|
|
|
|
$self->info("当前正在使用 Mojo-Webqq v" . $self->version); |
261
|
|
|
|
|
|
|
#$self->warn("当前版本与1.x.x版本不兼容,改动详情参见更新日志"); |
262
|
|
|
|
|
|
|
$self->ioloop->reactor->on(error=>sub{ |
263
|
0
|
|
|
0
|
|
|
my ($reactor, $err) = @_; |
264
|
0
|
|
|
|
|
|
$self->error("reactor error: " . Carp::longmess($err)); |
265
|
0
|
|
|
|
|
|
}); |
266
|
0
|
|
|
0
|
|
|
local $SIG{__WARN__} = sub{$self->warn(Carp::longmess @_);}; |
|
0
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
$self->on(error=>sub{ |
268
|
0
|
|
|
0
|
|
|
my ($self, $err) = @_; |
269
|
0
|
|
|
|
|
|
$self->error(Carp::longmess($err)); |
270
|
0
|
|
|
|
|
|
}); |
271
|
0
|
|
|
|
|
|
$self->check_pid(); |
272
|
0
|
|
|
|
|
|
$self->check_controller(1); |
273
|
0
|
|
|
|
|
|
$self->load_cookie(); |
274
|
0
|
|
|
|
|
|
$self->save_state(); |
275
|
0
|
|
|
|
|
|
$SIG{CHLD} = 'IGNORE'; |
276
|
|
|
|
|
|
|
$SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub{ |
277
|
0
|
0
|
0
|
0
|
|
|
if($^O ne 'MSWin32' and $_[0] eq 'INT' and !-t){ |
|
|
|
0
|
|
|
|
|
278
|
0
|
|
|
|
|
|
$self->warn("后台程序捕获到信号[$_[0]],已将其忽略,程序继续运行"); |
279
|
0
|
|
|
|
|
|
return; |
280
|
|
|
|
|
|
|
} |
281
|
0
|
|
|
|
|
|
$self->info("捕获到停止信号[$_[0]],准备停止..."); |
282
|
0
|
|
|
|
|
|
$self->stop(); |
283
|
0
|
|
|
|
|
|
}; |
284
|
|
|
|
|
|
|
$self->on(stop=>sub{ |
285
|
0
|
|
|
0
|
|
|
my $self = shift; |
286
|
0
|
|
|
|
|
|
$self->clean_qrcode(); |
287
|
0
|
|
|
|
|
|
$self->clean_pid(); |
288
|
0
|
|
|
|
|
|
}); |
289
|
|
|
|
|
|
|
$self->on(state_change=>sub{ |
290
|
0
|
|
|
0
|
|
|
my $self = shift; |
291
|
0
|
|
|
|
|
|
$self->save_state(@_); |
292
|
0
|
|
|
|
|
|
}); |
293
|
|
|
|
|
|
|
$self->on(qrcode_expire=>sub{ |
294
|
0
|
|
|
0
|
|
|
my($self) = @_; |
295
|
0
|
|
|
|
|
|
my $count = $self->qrcode_count; |
296
|
0
|
|
|
|
|
|
$self->qrcode_count(++$count); |
297
|
0
|
0
|
|
|
|
|
if($self->qrcode_count >= $self->qrcode_count_max){ |
298
|
0
|
|
|
|
|
|
$self->stop(); |
299
|
|
|
|
|
|
|
} |
300
|
0
|
|
|
|
|
|
}); |
301
|
|
|
|
|
|
|
$self->on(model_update=>sub{ |
302
|
0
|
|
|
0
|
|
|
my($self,$type,$status)=@_; |
303
|
0
|
|
|
|
|
|
$self->model_status->{$type} = $status; |
304
|
0
|
0
|
|
|
|
|
$self->emit("model_update_fail") if $self->get_model_status == 0; |
305
|
0
|
|
|
|
|
|
}); |
306
|
|
|
|
|
|
|
$self->on(model_update_fail=>sub{ |
307
|
0
|
|
|
0
|
|
|
my $self = shift; |
308
|
0
|
|
|
|
|
|
$self->info("检测到登录状态失效(1),尝试重新登录"); |
309
|
0
|
|
|
|
|
|
$self->relogin(); |
310
|
0
|
|
|
|
|
|
}); |
311
|
|
|
|
|
|
|
$self->on(before_send_message=>sub{ |
312
|
0
|
|
|
0
|
|
|
my($self,$msg) = @_; |
313
|
0
|
0
|
0
|
|
|
|
if ($msg->send_real_comp_sign |
314
|
|
|
|
|
|
|
// $self->default_send_real_comp_sign) { |
315
|
0
|
|
|
|
|
|
return; |
316
|
|
|
|
|
|
|
} |
317
|
0
|
|
|
|
|
|
my $content = $msg->content; |
318
|
0
|
|
|
|
|
|
$content =~s/>/>/g; |
319
|
0
|
|
|
|
|
|
$content =~s/</g; |
320
|
0
|
|
|
|
|
|
$msg->content($content); |
321
|
0
|
|
|
|
|
|
}); |
322
|
|
|
|
|
|
|
$self->on(send_message=>sub{ |
323
|
0
|
|
|
0
|
|
|
my($self,$msg)=@_; |
324
|
0
|
0
|
|
|
|
|
if($msg->is_success){$self->send_failure_count(0);} |
|
0
|
0
|
|
|
|
|
|
325
|
0
|
|
|
|
|
|
elsif($msg->code == -3){my $count = $self->send_failure_count;$self->send_failure_count(++$count);} |
|
0
|
|
|
|
|
|
|
326
|
0
|
0
|
|
|
|
|
if($self->send_failure_count >= $self->send_failure_count_max){ |
327
|
0
|
|
|
|
|
|
$self->relogin(); |
328
|
|
|
|
|
|
|
} |
329
|
0
|
|
|
|
|
|
}); |
330
|
|
|
|
|
|
|
$self->on(new_group=>sub{ |
331
|
0
|
|
|
0
|
|
|
my($self,$group)=@_; |
332
|
0
|
|
|
|
|
|
$self->update_group($group,is_blocking=>1,is_update_group_ext=>1,is_update_group_member_ext=>1); |
333
|
0
|
|
|
|
|
|
}); |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
$self->on(new_group_member=>sub{ |
336
|
0
|
|
|
0
|
|
|
my($self,$member)=@_; |
337
|
0
|
|
|
|
|
|
$member->group->update_group_member_ext(is_blocking=>1); |
338
|
0
|
|
|
|
|
|
}); |
339
|
|
|
|
|
|
|
$self->on(new_friend=>sub{ |
340
|
0
|
|
|
0
|
|
|
my($self,$friend)=@_; |
341
|
0
|
|
|
|
|
|
$self->update_friend_ext(is_blocking=>1); |
342
|
0
|
|
|
|
|
|
}); |
343
|
0
|
|
|
|
|
|
$Mojo::Webqq::Message::SEND_INTERVAL = $self->send_interval; |
344
|
0
|
|
|
|
|
|
$Mojo::Webqq::_CLIENT = $self; |
345
|
0
|
|
|
|
|
|
$self->check_notice(); |
346
|
0
|
|
|
|
|
|
$self; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
1; |