File Coverage

blib/lib/Mojo/Webqq/Model.pm
Criterion Covered Total %
statement 114 962 11.8
branch 0 394 0.0
condition 0 67 0.0
subroutine 38 104 36.5
pod 0 43 0.0
total 152 1570 9.6


line stmt bran cond sub pod time code
1             package Mojo::Webqq::Model;
2 1     1   8 use strict;
  1         2  
  1         32  
3 1     1   6 use List::Util qw(first);
  1         2  
  1         63  
4 1     1   6 use base qw(Mojo::Webqq::Model::Base);
  1         2  
  1         465  
5 1     1   399 use Mojo::Webqq::User;
  1         2  
  1         7  
6 1     1   405 use Mojo::Webqq::Friend;
  1         2  
  1         8  
7 1     1   457 use Mojo::Webqq::Group;
  1         3  
  1         8  
8 1     1   426 use Mojo::Webqq::Discuss;
  1         2  
  1         8  
9 1     1   7 use Mojo::Webqq::Discuss::Member;
  1         2  
  1         4  
10 1     1   6 use Mojo::Webqq::Group::Member;
  1         1  
  1         6  
11 1     1   415 use Mojo::Webqq::Model::Remote::_get_user_info;
  1         3  
  1         29  
12 1     1   510 use Mojo::Webqq::Model::Remote::get_single_long_nick;
  1         3  
  1         31  
13 1     1   2004 use Mojo::Webqq::Model::Remote::get_qq_from_id;
  1         3  
  1         32  
14 1     1   1120 use Mojo::Webqq::Model::Remote::_get_user_friends;
  1         2  
  1         32  
15 1     1   394 use Mojo::Webqq::Model::Remote::_get_user_friends_ext;
  1         3  
  1         27  
16 1     1   665 use Mojo::Webqq::Model::Remote::_get_friends_state;
  1         3  
  1         32  
17 1     1   393 use Mojo::Webqq::Model::Remote::_get_group_list_info;
  1         3  
  1         28  
18 1     1   408 use Mojo::Webqq::Model::Remote::_get_group_list_info_ext;
  1         2  
  1         28  
19 1     1   407 use Mojo::Webqq::Model::Remote::_get_group_info;
  1         3  
  1         27  
20 1     1   407 use Mojo::Webqq::Model::Remote::_get_group_info_ext;
  1         3  
  1         28  
21 1     1   948 use Mojo::Webqq::Model::Remote::_get_discuss_info;
  1         2  
  1         32  
22 1     1   615 use Mojo::Webqq::Model::Remote::_get_discuss_list_info;
  1         2  
  1         32  
23 1     1   742 use Mojo::Webqq::Model::Remote::_get_recent_info;
  1         3  
  1         34  
24 1     1   399 use Mojo::Webqq::Model::Remote::_invite_friend;
  1         2  
  1         27  
25 1     1   391 use Mojo::Webqq::Model::Remote::_set_group_admin;
  1         3  
  1         27  
26 1     1   391 use Mojo::Webqq::Model::Remote::_remove_group_admin;
  1         2  
  1         65  
27 1     1   388 use Mojo::Webqq::Model::Remote::_kick_group_member;
  1         3  
  1         27  
28 1     1   406 use Mojo::Webqq::Model::Remote::_set_group_member_card;
  1         3  
  1         26  
29 1     1   387 use Mojo::Webqq::Model::Remote::_shutup_group_member;
  1         2  
  1         28  
30 1     1   503 use Mojo::Webqq::Model::Remote::_qiandao;
  1         3  
  1         27  
31 1     1   5 use Encode ();
  1         2  
  1         21  
32              
33             sub time33 {
34 1     1   5 use integer;
  1         2  
  1         6  
35 0     0 0   my $self = shift;
36 0           my $t = shift;
37 0           my $e = 0;
38 0           my $i = 0;
39 0           for( my $n = length($t); $i<$n; $i++ ){
40 0           $e = ( 33 * $e + ord(substr($t,$i,1)) ) % 4294967296;
41             }
42 0           return $e;
43             }
44             sub hash33{
45 1     1   98 use integer;
  1         2  
  1         4  
46 0     0 0   my $self = shift;
47 0           my $t = shift;
48 0           my $n = length($t);
49 0           my $e = 0;
50 0           for(my $i=0;$n>$i;$i++ ){
51 0           $e += ($e << 5) + ord(substr($t,$i,1));
52             }
53 0           return 2147483647 & $e;
54             }
55             sub hash {
56 0     0 0   my $self = shift;
57 0           my $ptwebqq = shift;
58 0           my $uin = shift;
59              
60 0           $uin .= "";
61 0           my @ptb;
62 0           for(my $i =0;$i
63 0           $ptb[$i % 4] ^= ord(substr($ptwebqq,$i,1));
64             }
65 0           my @salt = ("EC", "OK");
66 0           my @uinByte;
67 0           $uinByte[0] = $uin >> 24 & 0xFF ^ ord(substr($salt[0],0,1));
68 0           $uinByte[1] = $uin >> 16 & 0xFF ^ ord(substr($salt[0],1,1));
69 0           $uinByte[2] = $uin >> 8 & 0xFF ^ ord(substr($salt[1],0,1));
70 0           $uinByte[3] = $uin & 0xFF ^ ord(substr($salt[1],1,1));
71 0           my @result;
72 0           for(my $i=0;$i<8;$i++){
73 0 0         $result[$i] = $i%2==0?$ptb[$i>>1]:$uinByte[$i>>1];
74             }
75 0           my @hex = ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F");
76 0           my $buf = "";
77 0           for(my $i=0;$i<@result;$i++){
78 0           $buf .= $hex[$result[$i] >> 4 & 0xF];
79 0           $buf .= $hex[$result[$i] & 0xF];
80             }
81              
82 0           return $buf;
83             }
84              
85             sub is_support_model_ext {
86 0     0 0   my $self = shift;
87 0           return $self->model_ext;
88             #return $self->uid && $self->pwd
89             #my $ret = $self->search_cookie("p_skey") && $self->search_cookie("skey");
90             #$self->model_ext($ret || 0);
91             #return $ret;
92             }
93             sub get_model_status{
94 0     0 0   my $self = shift;
95 0 0 0       if( defined $self->model_status->{friend}
96             and defined $self->model_status->{group}
97             ){
98             my $is_fail =
99             $self->model_status->{friend} == 0
100 0   0       && $self->model_status->{group} == 0
101             ;
102 0 0         return $is_fail?0:1;
103             }
104             else{
105 0           return -1;
106             }
107             }
108             sub get_csrf_token {
109 1     1   468 use integer;
  1         2  
  1         3  
110 0     0 0   my $self = shift;
111 0 0         if(not $self->is_support_model_ext){
112 0           $self->error("当前不支持获取扩展信息,无法获取CSRF Token");
113 0           return;
114             }
115 0 0         return $self->csrf_token if defined $self->csrf_token;
116 0           my $t = $self->search_cookie("skey");
117 0           my $n = 0;
118 0           my $o=length($t);
119 0           my $r;
120 0 0         if($t){
121 0           for($r=5381;$o>$n;$n++){
122 0           $r += ($r<<5) + ord(substr($t,$n,1));
123             }
124 0           my $token = 2147483647 & $r;
125 0           $self->csrf_token($token);
126 0           return $token;
127             }
128             }
129             sub each_friend{
130 0     0 0   my $self = shift;
131 0           my $callback = shift;
132 0 0         $self->die("参数必须是函数引用") if ref $callback ne "CODE";
133 0 0         $self->update_friend(is_blocking=>1,is_update_friend_ext=>1) if @{$self->friend} == 0;
  0            
134 0           for (@{$self->friend}){
  0            
135 0           $callback->($self,$_);
136             }
137             }
138             sub each_group{
139 0     0 0   my $self = shift;
140 0           my $callback = shift;
141 0 0         $self->die("参数必须是函数引用") if ref $callback ne "CODE";
142 0 0         $self->update_group(is_blocking=>1,is_update_group_member=>0) if @{$self->group} == 0;
  0            
143 0           for (@{$self->group}){
  0            
144 0           $callback->($self,$_);
145             }
146             }
147              
148             sub each_discuss{
149 0     0 0   my $self = shift;
150 0           my $callback = shift;
151 0 0         $self->die("参数必须是函数引用") if ref $callback ne "CODE";
152 0 0         $self->update_discuss(is_blocking=>1,is_update_discuss_member=>0) if @{$self->discuss} == 0;
  0            
153 0           for (@{$self->discuss}){
  0            
154 0           $callback->($self,$_);
155             }
156             }
157             sub each_group_member{
158 0     0 0   my $self = shift;
159 0           my $callback = shift;
160 0 0         $self->die("参数必须是函数引用") if ref $callback ne "CODE";
161 0 0         if(@{$self->group} == 0){
  0            
162 0           $self->update_group(is_blocking=>1,is_update_group_member=>1);
163             }
164             else{
165 0           for( @{$self->group}){
  0            
166 0 0         $_->update_group_member(is_blocking=>1,) if $_->is_empty;
167             }
168             }
169 0           my @member = map {@{$_->member}} grep {ref $_->member eq "ARRAY"} @{$self->group};
  0            
  0            
  0            
  0            
170 0           for (@member){
171 0           $callback->($self,$_);
172             }
173             }
174             sub each_discuss_member{
175 0     0 0   my $self = shift;
176 0           my $callback = shift;
177 0 0         $self->die("参数必须是函数引用") if ref $callback ne "CODE";
178 0 0         if(@{$self->discuss} == 0){
  0            
179 0           $self->update_discuss(is_blocking=>1,is_update_discuss_member=>1);
180             }
181             else{
182 0           for( @{$self->discuss}){
  0            
183 0 0         $_->update_discuss_member(is_blocking=>1,) if $_->is_empty;
184             }
185             }
186 0           my @member = map {@{$_->member}} grep {ref $_->member eq "ARRAY"} @{$self->discuss};
  0            
  0            
  0            
  0            
187 0           for (@member){
188 0           $callback->($self,$_);
189             }
190             }
191              
192             sub update_user {
193 0     0 0   my $self = shift;
194 0           my $is_blocking = ! shift;
195 0           $self->info("更新个人信息...\n");
196             my $handle = sub{
197 0     0     my $user_info = shift;
198 0 0         unless ( defined $user_info ) {
199 0           $self->warn("更新个人信息失败\n");
200 0           $self->user(Mojo::Webqq::User->new({id=>$self->uid,uid=>$self->uid}));
201 0           $self->emit("model_update"=>"user",0);
202 0           return;
203             }
204 0           $self->user(Mojo::Webqq::User->new($user_info));
205 0           $self->emit("model_update"=>"user",1);
206 0           };
207 0 0         if($is_blocking){
208 0           my $user_info = $self->_get_user_info();
209 0           $handle->($user_info);
210             }
211             else{
212 0           $self->_get_user_info($handle);
213             }
214             }
215              
216             sub remove_friend {
217 0     0 0   my $self = shift;
218 0           my $friend = shift;
219 0 0         $self->die("不支持的数据类型\n") if ref $friend ne "Mojo::Webqq::Friend";
220 0           for(my $i=0;@{$self->friend};$i++){
  0            
221 0 0         if($friend->id eq $self->friend->[$i]->id){
222 0           splice @{$self->friend},$i,1;
  0            
223 0           return 1;
224             }
225             }
226 0           return 0;
227             }
228             sub add_friend {
229 0     0 0   my $self = shift;
230 0           my $friend = shift;
231 0           my $nocheck = shift;
232 0 0         $self->die("不支持的数据类型\n") if ref $friend ne "Mojo::Webqq::Friend";
233 0 0         if(@{$self->friend} == 0){
  0            
234 0           push @{$self->friend},$friend;
  0            
235 0           return $self;
236             }
237 0 0         if($nocheck){
238 0           push @{$self->friend},$friend;
  0            
239 0           return $self;
240             }
241 0           my $f = $self->search_friend(id => $friend->id);
242 0 0         if(defined $f){
243 0           %$f = %$friend;
244             }
245             else{
246 0           push @{$self->friend},$friend;
  0            
247             }
248 0           return $self;
249             }
250              
251             sub update_friend_ext {
252 0     0 0   my $self = shift;
253 0           my %p = @_;
254 0 0         $p{is_blocking} = 1 if not defined $p{is_blocking} ;
255 0 0         if ( not $self->is_support_model_ext){
256 0           $self->warn("无法支持获取扩展信息");
257 0           return;
258             }
259             my $handle = sub{
260 0     0     my $friends_ext_info = shift;
261 0 0 0       if(defined $friends_ext_info and ref $friends_ext_info eq "ARRAY"){
262 0           $self->info("更新好友扩展信息...");
263 0           my(undef,$ext)=$self->array_unique($friends_ext_info,sub{$_[0]->{displayname} . "|" . $_[0]->{category}},"friend_ext");
  0            
264 0           my $unique_friend = $self->array_unique($self->friend,sub{$_[0]->displayname . "|" . $_[0]->category},"friend");
  0            
265 0           for my $f(@$unique_friend){
266 0           my $id = $f->displayname . "|" . $f->category;
267 0 0         next if not exists $ext->{$id};
268 0           $f->{uid} = $ext->{$id}{uid};
269             }
270            
271 0 0         if($self->log_level eq 'debug'){
272 0           for(@{$self->friend}){
  0            
273 0 0         $self->debug("更新好友[" . $_->displayname . "|" . $_->category . "]扩展信息uid失败") if not $_->uid;
274             }
275             }
276              
277 0           $self->emit("model_update"=>"friend_ext",1);
278             }
279             else{
280 0           $self->warn("更新好友扩展信息失败");
281 0           $self->emit("model_update"=>"friend_ext",0);
282             }
283 0           };
284 0 0         if($p{is_blocking}){
285 0           my $friends_ext_info = $self->_get_user_friends_ext();
286 0           $handle->($friends_ext_info);
287             }
288             else{
289 0           $self->_get_user_friends_ext($handle);
290             }
291             }
292             sub update_friend {
293 0     0 0   my $self = shift;
294 0 0         if(ref $_[0] eq "Mojo::Webqq::Friend"){
295 0           my $friend = shift;
296 0           my %p = @_;
297 0 0         $p{is_blocking} = 1 if not defined $p{is_blocking};
298 0           $self->info("更新好友 [ " . $friend->displayname . " ] 信息...");
299             my $handle = sub{
300 0     0     my $friend_info = shift;
301 0 0         if(defined $friend_info){$friend->update($friend_info);}
  0            
302 0           else{$self->warn("更新好友 [ " . $friend->displayname . " ] 信息失败...");}
303 0           };
304 0 0         if($p{is_blocking}){
305 0           my $friend_info = $self->_get_friend_info($friend->id);
306 0           $handle->($friend_info);
307             }
308             else{
309 0           $self->_get_friend_info($friend->id,$handle);
310             }
311 0           return $self;
312             }
313 0           my %p = @_;
314 0 0         $p{is_blocking} = 1 if not defined $p{is_blocking};
315 0 0         $p{is_update_friend_ext} = 1 if not defined $p{is_update_friend_ext};
316             my $handle = sub{
317 0     0     my @friends;
318 0           my $friends_info = shift;
319 0 0         if(defined $friends_info){
320 0           $self->info("更新好友信息...");
321 0           push @friends,Mojo::Webqq::Friend->new($_) for @{$friends_info};
  0            
322 0 0 0       if(ref $self->friend eq "ARRAY" and @{$self->friend} == 0){
  0            
323 0           $self->friend(\@friends);
324             }
325             else{
326 0           my($new_friends,$lost_friends,$sames) = $self->array_diff($self->friend,\@friends,sub{$_[0]->id});
  0            
327 0           for(@{$new_friends}){
  0            
328 0           $self->add_friend($_);
329 0           $self->emit(new_friend=>$_);
330             }
331 0           for(@{$lost_friends}){
  0            
332 0           $self->remove_friend($_);
333 0           $self->emit(lose_friend=>$_);
334             }
335 0           for(@{$sames}){
  0            
336 0           my($old,$new) = @$_;
337 0           $old->update($new);
338             }
339             }
340 0           $self->emit("model_update","friend",1);
341 0 0         $self->update_friend_ext(is_blocking=>$p{is_blocking}) if $p{is_update_friend_ext};
342             }
343 0           else{$self->warn("更新好友信息失败");$self->emit("model_update","friend",0);}
  0            
344 0           };
345 0 0         if($p{is_blocking}){
346 0           my $friends_info = $self->_get_user_friends();
347 0           $handle->($friends_info);
348             }
349             else{
350 0           $self->_get_user_friends($handle);
351             }
352             }
353             sub search_friend {
354 1     1   2177 no warnings 'uninitialized';
  1         2  
  1         2674  
355 0     0 0   my $self = shift;
356 0           my %p = @_;
357 0 0         return if 0 == grep {defined $p{$_}} keys %p;
  0            
358 0 0         $self->update_friend(is_blocking=>1,is_update_friend_ext=>1) if @{ $self->friend } == 0;
  0            
359 0 0         if(wantarray){
360 0 0   0     return grep {my $f = $_;(first {$p{$_} ne $f->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->friend};
  0            
  0            
  0            
  0            
  0            
361             }
362             else{
363 0 0   0     return first {my $f = $_;(first {$p{$_} ne $f->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->friend};
  0            
  0            
  0            
  0            
  0            
364             }
365             }
366              
367             sub add_group{
368 0     0 0   my $self = shift;
369 0           my $group = shift;
370 0           my $nocheck = shift;
371 0 0         $self->die("不支持的数据类型") if ref $group ne "Mojo::Webqq::Group";
372 0 0         if(@{$self->group} == 0){
  0            
373 0           push @{$self->group},$group;
  0            
374 0           return $self;
375             }
376 0 0         if($nocheck){
377 0           push @{$self->group},$group;
  0            
378 0           return $self;
379             }
380 0           my $g = $self->search_group(id => $group->id);
381 0 0         if(defined $g){
382 0           %$g = %$group;
383             }
384             else{#new group
385 0           push @{$self->group},$group;
  0            
386             }
387 0           return $self;
388             }
389             sub remove_group{
390 0     0 0   my $self = shift;
391 0           my $group = shift;
392 0 0         $self->die("不支持的数据类型") if ref $group ne "Mojo::Webqq::Group";
393 0           for(my $i=0;@{$self->group};$i++){
  0            
394 0 0         if($group->id eq $self->group->[$i]->id){
395 0           splice @{$self->group},$i,1;
  0            
396 0           return 1;
397             }
398             }
399 0           return 0;
400             }
401             sub update_group_ext {
402 0     0 0   my $self = shift;
403 0 0         if ( not $self->is_support_model_ext){
404 0           $self->warn("无法支持获取扩展信息");
405 0           return;
406             }
407 0 0         return if @{ $self->group } == 0;
  0            
408 0           my $group;
409 0 0         $group = shift if ref $_[0] eq "Mojo::Webqq::Group";
410 0           my %p = @_;
411 0 0         $p{is_blocking} = 1 if not defined $p{is_blocking};
412 0 0         $p{is_update_group_member_ext} = 1 if not defined $p{is_update_group_member_ext};
413              
414 0 0 0       if(defined $group and defined $group->uid){#要更新的指定群组已经包含扩展信息
    0 0        
415 0 0         $self->update_group_member_ext($group,%p) if $p{is_update_group_member_ext};
416 0           return;
417             }
418 0     0     elsif( (!defined $group) and (! first { !defined $_->uid} @{$self->group} ) ){ #所有群组都包含扩展信息了
419 0           for(@{$self->group}){
  0            
420 0 0         $self->update_group_member_ext($_,%p) if $p{is_update_group_member_ext};
421             }
422 0           return;
423             }
424             my $handle = sub{
425 0     0     my $group_list_ext = shift;
426 0 0 0       if(defined $group_list_ext and ref $group_list_ext eq "ARRAY"){
427 0           $self->info("更新群列表扩展信息...");
428 0           my(undef,$gext)= $self->array_unique($group_list_ext,sub{$_[0]->{name}},"group_ext");
  0            
429 0           my $unique_group = $self->array_unique($self->group,sub{$_[0]->name},"group");
  0            
430 0 0         my @groups = defined $group?(grep {$_->id eq $group->id} @$unique_group) : @$unique_group;
  0            
431 0 0         if($p{is_blocking}){
432 0           for my $g (@groups){
433 0           my $id = $g->name;
434 0 0         next if not exists $gext->{$id};
435 0           $g->update($gext->{$id});
436 0 0         $self->update_group_member_ext($g,%p) if $p{is_update_group_member_ext};
437             }
438             }
439             else{
440 0           my $i = -3;
441 0           for my $g (@groups){
442 0           my $id = $g->name;
443 0 0         next if not exists $gext->{$id};
444 0           $g->update($gext->{$id});
445             $self->timer($i+3,sub{
446 0 0         $self->update_group_member_ext($g,%p) if $p{is_update_group_member_ext};
447 0           });
448 0           $i++;
449             }
450             }
451 0           $self->emit("model_update","group_ext",1);
452             }
453 0           else{$self->warn("更新群扩展信息失败");$self->emit("model_update","group_ext",0);}
  0            
454 0           };
455 0 0         if($p{is_blocking}){
456 0           my $group_list_ext = $self->_get_group_list_info_ext();
457 0           $handle->($group_list_ext);
458             }
459             else{
460 0           $self->_get_group_list_info_ext($handle);
461             }
462             }
463             sub update_group_member_ext {
464 0     0 0   my $self = shift;
465 0           my $group = shift;
466 0 0         if ( not $self->is_support_model_ext){
467 0           $self->warn("群组[ ". $group->name . " ]当前无法支持获取扩展信息");
468 0           return;
469             }
470 0 0         $self->die("不支持的数据类型") if ref $group ne "Mojo::Webqq::Group";
471 0 0         if(not defined $group->uid){
472 0           $self->warn("群组[ ". $group->name . " ]未包含有效的uid,无法更新群成员扩展信息");
473 0           return;
474             }
475 0 0         if($group->is_empty){
476 0           $self->warn("群组[ ". $group->name . " ]未包含群成员,忽略更新群成员扩展信息");
477 0           return;
478             }
479 0           my %p = @_;
480 0 0         $p{is_blocking} = 1 if not defined $p{is_blocking};
481             my $handle = sub{
482 0     0     my $group_info_ext = shift;
483 0 0         if(defined $group_info_ext){
484 0           $self->info("更新群组[ ". $group->name . " ]成员扩展信息");
485             my $unique_sub = sub{
486 0   0       my $name = $_[0]->{name} // "";
487 0   0       my $card = $_[0]->{card} // "";
488 0 0         if(ref $self->group_member_identify_callback eq 'CODE'){
489 0           return $self->group_member_identify_callback->($name,$card);
490             }
491             else{
492 0 0         return $self->group_member_card_ext_only? $name: $name . $card;
493             }
494 0           };
495 0           my(undef,$mext) = $self->array_unique($group_info_ext->{member},$unique_sub,$group->name . " member_ext");
496 0           my $unique_member = $self->array_unique($group->member,$unique_sub,$group->name . " member");
497 0           for(@$unique_member){
498 0           my $id = $unique_sub->($_);
499 0 0         next if not exists $mext->{$id};
500 0           $_->update($mext->{$id});
501             }
502 0 0         if($self->log_level eq 'debug'){
503 0           for(@{$group->member}){
  0            
504 0 0         $self->debug("更新群成员[".$_->name . "|" . $group->name ."]扩展信息uid失败") if not $_->uid;
505             }
506             }
507 0   0       $group->{max_member} //= $group_info_ext->{max_member};
508 0   0       $group->{max_admin} //= $group_info_ext->{max_admin};
509 0           $group->{_is_hold_member_ext} = 1;
510 0           $self->emit("model_update","group_member_ext",1);
511             }
512 0           else{$self->warn("更新群组[ " . $group->name . " ]成员扩展信息失败");}
513 0           };
514 0 0         if($p{is_blocking}){
515 0           my $group_info_ext = $self->_get_group_info_ext($group->uid);
516 0           $handle->($group_info_ext);
517             }
518             else{
519 0           $self->_get_group_info_ext($group->uid,$handle);
520             }
521            
522             }
523             sub update_group_member {
524 0     0 0   my $self = shift;
525 0           my $group = shift;
526 0 0         $self->die("不支持的数据类型") if ref $group ne "Mojo::Webqq::Group";
527 0           my %p = @_;
528 0 0         $p{is_blocking} = 1 if not defined $p{is_blocking};
529 0 0         $p{is_update_group_member_ext} = 1 if not defined $p{is_update_group_member_ext};
530             my $handle = sub{
531 0     0     my $group_info = shift;
532 0 0         if(defined $group_info){
533 0           $self->info("更新群组[ ". $group->name . " ]成员信息");
534 0 0         if(ref $group_info->{member} eq 'ARRAY'){
535 0           $group->update($group_info);
536 0 0         $self->update_group_member_ext($group,%p) if $p{is_update_group_member_ext};
537             }
538 0           else{$self->debug("更新群组[ " . $group->name . " ]成员信息无效")}
539             }
540 0           else{$self->warn("更新群组[ " . $group->name . " ]成员信息失败")}
541            
542 0           };
543 0 0         if($p{is_blocking}){
544 0           my $group_info = $self->_get_group_info($group->code);
545 0           $handle->($group_info);
546             }
547             else{
548 0           $self->_get_group_info($group->code,$handle);
549             }
550             }
551             sub update_group {
552 0     0 0   my $self = shift;
553 0 0         if(ref $_[0] eq "Mojo::Webqq::Group"){
554 0           my $group = shift;
555 0           my %p = @_;
556 0 0         $p{is_blocking} = 1 if not defined $p{is_blocking};
557 0 0         $p{is_update_group_member} = 1 if not defined $p{is_update_group_member} ;
558 0 0         $p{is_update_group_ext} = $p{is_blocking} if not defined $p{is_update_group_ext} ;
559 0 0 0       $p{is_update_group_member_ext} = $p{is_update_group_ext} && $p{is_blocking} if not defined $p{is_update_group_member_ext} ;
560             my $handle = sub{
561 0     0     my $group_info = shift;
562 0 0         if(defined $group_info){
563 0 0         if(ref $group_info->{member} eq 'ARRAY'){
564 0           $self->info("更新群组[ ". $group->name . " ]信息");
565 0           $group->update($group_info);
566 0 0         $self->update_group_ext($group,%p) if $p{is_update_group_ext};
567             }
568 0           else{$self->debug("更新群组[ " . $group->name . " ]成员信息无效")}
569             }
570 0           else{$self->warn("更新群组[ " . $group->name . " ]成员信息失败")}
571              
572 0           };
573 0 0         if($p{is_blocking}){
574 0           my $group_info = $self->_get_group_info($group->code);
575 0           $handle->($group_info);
576             }
577             else{
578 0           $self->_get_group_info($group->code,$handle);
579             }
580 0           return $self;
581             }
582 0           my %p = @_;
583 0 0         $p{is_blocking} = 1 if not defined $p{is_blocking} ;
584 0 0         $p{is_update_group_member} = 1 if not defined $p{is_update_group_member} ;
585 0 0         $p{is_update_group_ext} = $p{is_blocking} if not defined $p{is_update_group_ext} ;
586 0 0 0       $p{is_update_group_member_ext} = $p{is_blocking} && $p{is_update_group_ext} && $p{is_update_group_member} if not defined $p{is_update_group_member_ext} ;
587             my $handle = sub{
588 0     0     my @groups;
589 0           my $group_list = shift;
590 0 0         unless(defined $group_list){
591 0           $self->warn("更新群列表信息失败\n");
592 0           $self->emit("model_update","group",0);
593 0           return $self;
594             }
595 0           $self->info("更新群列表信息...");
596 0           for my $g (@{$group_list}){
  0            
597 0           push @groups, Mojo::Webqq::Group->new($g);
598             }
599 0 0 0       if(ref $self->group eq "ARRAY" and @{$self->group} == 0){
  0            
600 0           $self->group(\@groups);
601             }
602             else{
603 0           my($new_groups,$lost_groups,$sames) = $self->array_diff($self->group,\@groups,sub{$_[0]->id});
  0            
604 0           for(@{$new_groups}){
  0            
605 0           $self->add_group($_);
606 0           $self->emit(new_group=>$_) ;
607             }
608 0           for(@{$lost_groups}){
  0            
609 0           $self->remove_group($_);
610 0           $self->emit(lose_group=>$_) ;
611             }
612 0           for(@{$sames}){
  0            
613 0           my($old_group,$new_group) = ($_->[0],$_->[1]);
614 0           $old_group->update($new_group);
615             }
616             }
617 0           $self->emit("model_update","group",1);
618 0 0         if($p{is_update_group_member}){
619 0 0         if($p{is_blocking}){
620 0           for(@{ $self->group }){
  0            
621 0           $self->update_group_member($_,%p);
622             }
623             }
624             else{
625 0           my $i = -3;
626 0           for my $g (@{ $self->group }){
  0            
627 0           $self->timer($i+3,sub{$self->update_group_member($g,%p)});
  0            
628 0           $i++;
629             }
630             }
631             }
632 0 0         if($p{is_update_group_ext}){
633 0           $self->update_group_ext(%p);
634             }
635 0           };
636              
637 0 0         if($p{is_blocking}){
638 0           my $group_list = $self->_get_group_list_info();
639 0           $handle->($group_list);
640             }
641             else{
642 0           $self->_get_group_list_info($handle);
643             }
644             }
645              
646             sub search_group {
647 1     1   8 no warnings 'uninitialized';
  1         2  
  1         343  
648 0     0 0   my $self = shift;
649 0           my %p = @_;
650 0 0         return if 0 == grep {defined $p{$_}} keys %p;
  0            
651 0 0         $self->update_group(is_update_group_member=>0) if @{ $self->group } == 0;
  0            
652 0           delete $p{member};
653 0 0         if(wantarray){
654 0 0   0     return grep {my $g = $_;(first {$p{$_} ne $g->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->group};
  0            
  0            
  0            
  0            
  0            
655             }
656             else{
657 0 0   0     return first {my $g = $_;(first {$p{$_} ne $g->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->group};
  0            
  0            
  0            
  0            
  0            
658             }
659             }
660              
661             sub search_group_member {
662 1     1   8 no warnings 'uninitialized';
  1         2  
  1         1440  
663 0     0 0   my $self = shift;
664 0           my %p = @_;
665 0 0         return if 0 == grep {defined $p{$_}} keys %p;
  0            
666 0 0         if(@{$self->group} == 0){
  0            
667 0           $self->update_group(is_blocking=>1,is_update_group_member=>1);
668             }
669             else{
670 0           for( @{$self->group}){
  0            
671 0 0         $_->update_group_member(is_blocking=>1,) if $_->is_empty;
672             }
673             }
674 0           my @member = map {@{$_->member}} grep {ref $_->member eq "ARRAY"} @{$self->group};
  0            
  0            
  0            
  0            
675 0 0         if(wantarray){
676 0 0   0     return grep {my $m = $_;(first {$p{$_} ne $m->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @member;
  0            
  0            
  0            
  0            
677             }
678             else{
679 0 0   0     return first {my $m = $_;(first {$p{$_} ne $m->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @member;
  0            
  0            
  0            
  0            
680             }
681             }
682              
683             sub add_discuss {
684 0     0 0   my $self = shift;
685 0           my $discuss = shift;
686 0           my $nocheck = shift;
687 0 0         $self->die("不支持的数据类型") if ref $discuss ne "Mojo::Webqq::Discuss";
688 0 0         if(@{$self->discuss} == 0){
  0            
689 0           push @{$self->discuss},$discuss;
  0            
690 0           return $self;
691             }
692 0 0         if($nocheck){
693 0           push @{$self->discuss},$discuss;
  0            
694 0           return $self;
695             }
696 0           my $d = $self->search_discuss(id => $discuss->id);
697 0 0         if(defined $d){
698 0           %$d = %$discuss;
699             }
700             else{#new discuss
701 0           push @{$self->discuss},$discuss;
  0            
702             }
703 0           return $self;
704              
705             }
706             sub remove_discuss {
707 0     0 0   my $self = shift;
708 0           my $discuss = shift;
709 0 0         $self->die("不支持的数据类型") if ref $discuss ne "Mojo::Webqq::Discuss";
710 0           for(my $i=0;@{$self->discuss};$i++){
  0            
711 0 0         if($discuss->id eq $self->discuss->[$i]->id){
712 0           splice @{$self->discuss},$i,1;
  0            
713 0           return 1;
714             }
715             }
716 0           return 0;
717             }
718              
719       0 0   sub add_discuss_member {}
720              
721             sub update_discuss_member{
722 0     0 0   my $self = shift;
723 0           my $discuss = shift;
724 0 0         $self->die("不支持的数据类型") if ref $discuss ne "Mojo::Webqq::Discuss";
725 0           $self->info("更新讨论组[ ". $discuss->name . " ]成员信息");
726 0           my %p = @_;
727 0 0         $p{is_blocking} = 1 if not defined $p{is_blocking};
728             my $handle = sub{
729 0     0     my $discuss_info = shift;
730 0 0         if(defined $discuss_info){
731 0 0         if(ref $discuss_info->{member} eq 'ARRAY'){
732 0           $discuss->update($discuss_info);
733             }
734 0           else{$self->debug("更新讨论组[ " . $discuss->name . " ]成员信息无效")}
735             }
736 0           else{$self->warn("更新讨论组[ " . $discuss->name . " ]成员信息失败")}
737 0           };
738              
739 0 0         if($p{is_blocking}){
740 0           my $discuss_info = $self->_get_discuss_info($discuss->id);
741 0           $handle->($discuss_info);
742             }
743             else{
744 0           $self->_get_discuss_info($discuss->id,$handle);
745             }
746            
747             }
748             sub update_discuss {
749 0     0 0   my $self = shift;
750 0 0         if(ref $_[0] eq "Mojo::Webqq::Discuss"){
751 0           my $discuss = shift;
752 0           my %p = @_;
753 0           $self->info("更新讨论组[ ". $discuss->name . " ]信息");
754 0 0         $p{is_blocking} = 1 if not defined $p{is_blocking};
755             my $handle = sub{
756 0     0     my $discuss_info = shift;
757 0 0         if(defined $discuss_info){
758 0 0         if(ref $discuss_info->{member} eq 'ARRAY'){
759 0           $discuss->update($discuss_info);
760             }
761 0           else{$self->debug("更新讨论组[ " . $discuss->name . " ]成员信息无效")}
762             }
763 0           else{$self->warn("更新讨论组[ " . $discuss->name . " ]成员信息失败")}
764              
765 0           };
766 0 0         if($p{is_blocking}){
767 0           my $discuss_info = $self->_get_discuss_info($discuss->id);
768 0           $handle->($discuss_info);
769             }
770             else{
771 0           $self->_get_discuss_info($discuss->id,$handle);
772             }
773 0           return $self;
774             }
775 0           my %p = @_;
776 0 0         $p{is_blocking} = 1 if not defined $p{is_blocking} ;
777 0 0         $p{is_update_discuss_member} = 1 if not defined $p{is_update_discuss_member} ;
778 0           $self->info("更新讨论组列表信息...");
779             my $handle = sub{
780 0     0     my @discusss;
781 0           my $discuss_list = shift;
782 0 0         unless(defined $discuss_list){
783 0           $self->warn("更新讨论列表信息失败\n");
784 0           $self->emit("model_update","discuss",0);
785 0           return $self;
786             }
787 0           for my $d (@{$discuss_list}){
  0            
788 0           push @discusss, Mojo::Webqq::Discuss->new($d);
789             }
790 0 0 0       if(ref $self->discuss eq "ARRAY" and @{$self->discuss} == 0){
  0            
791 0           $self->discuss(\@discusss);
792             }
793             else{
794 0           my($new_discusss,$lost_discusss,$sames) = $self->array_diff($self->discuss,\@discusss,sub{$_[0]->did});
  0            
795 0           for(@{$new_discusss}){
  0            
796 0           $self->add_discuss($_);
797 0           $self->emit(new_discuss=>$_) ;
798             }
799 0           for(@{$lost_discusss}){
  0            
800 0           $self->remove_discuss($_);
801 0           $self->emit(lose_discuss=>$_) ;
802             }
803 0           for(@{$sames}){
  0            
804 0           my($old_discuss,$new_discuss) = ($_->[0],$_->[1]);
805 0           $old_discuss->update($new_discuss);
806             }
807             }
808 0           $self->emit("model_update","discuss",1);
809 0 0         if($p{is_update_discuss_member}){
810 0           for(@{ $self->discuss }){
  0            
811 0           $self->update_discuss_member($_,%p);
812             }
813             }
814 0           };
815 0 0         if($p{is_blocking}){
816 0           my $discuss_list = $self->_get_discuss_list_info();
817 0           $handle->($discuss_list);
818             }
819             else{
820 0           $self->_get_discuss_list_info($handle);
821             }
822             }
823              
824             sub search_discuss {
825 1     1   8 no warnings 'uninitialized';
  1         2  
  1         295  
826 0     0 0   my $self = shift;
827 0           my %p = @_;
828 0 0         return if 0 == grep {defined $p{$_}} keys %p;
  0            
829 0 0         $self->update_discuss(is_blocking=>1,is_update_discuss_member=>0) if @{$self->discuss} == 0;
  0            
830 0           delete $p{member};
831 0 0         if(wantarray){
832 0 0   0     return grep {my $d = $_;(first {$p{$_} ne $d->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->discuss};
  0            
  0            
  0            
  0            
  0            
833             }
834             else{
835 0 0   0     return first {my $d = $_;(first {$p{$_} ne $d->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->discuss};
  0            
  0            
  0            
  0            
  0            
836             }
837             }
838              
839             sub search_discuss_member {
840 1     1   7 no warnings 'uninitialized';
  1         3  
  1         2062  
841 0     0 0   my $self = shift;
842 0           my %p = @_;
843 0 0         return if 0 == grep {defined $p{$_}} keys %p;
  0            
844 0 0         if(@{$self->discuss} == 0){
  0            
845 0           $self->update_discuss(is_blocking=>1,is_update_discuss_member=>1);
846             }
847             else{
848 0           for( @{$self->discuss}){
  0            
849 0 0         $_->update_discuss_member(is_blocking=>1,) if $_->is_empty;
850             }
851             }
852 0           my @member = map {@{$_->member}} grep {ref $_->member eq "ARRAY"} @{$self->discuss};
  0            
  0            
  0            
  0            
853 0 0         if(wantarray){
854 0 0   0     return grep {my $m = $_;(first {$p{$_} ne $m->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @member;
  0            
  0            
  0            
  0            
855             }
856             else{
857 0 0   0     return first {my $m = $_;(first {$p{$_} ne $m->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @member;
  0            
  0            
  0            
  0            
858             }
859             }
860              
861             sub invite_friend{
862 0     0 0   my $self = shift;
863 0 0         if ( not $self->is_support_model_ext){
864 0           $self->warn("无法支持获取扩展信息");
865 0           return;
866             }
867 0           my $group = shift;
868 0           my @friends = @_;
869 0 0         if(not defined $group->uid){
870 0           $self->error("未获取到群号码,无法邀请好友入群");
871 0           return;
872             }
873 0 0 0       if($group->role ne "manage" and $group->role ne "create"){
874 0           $self->error("非群主或管理员,无法邀请好友入群");
875 0           return;
876             }
877 0           for(@friends){
878 0 0         $self->die("非好友对象") if not $_->is_friend;
879             }
880 0           my $ret = $self->_invite_friend($group->uid,map {$_->uid} @friends);
  0            
881 0 0         if($ret){$self->info("邀请好友入群成功")}
  0            
882 0           else{$self->error("邀请好友入群失败")}
883 0           return $ret;
884             }
885             sub kick_group_member{
886 0     0 0   my $self = shift;
887 0 0         if ( not $self->is_support_model_ext){
888 0           $self->warn("无法支持获取扩展信息");
889 0           return;
890             }
891 0           my $group = shift;
892 0           my @members = @_;
893 0 0         if(not defined $group->uid){
894 0           $self->error("未获取到群号码,无法踢除群成员");
895 0           return;
896             }
897 0 0 0       if($group->role ne "manage" and $group->role ne "create"){
898 0           $self->error("非群主或管理员,无法踢除群成员");
899 0           return;
900             }
901 0           for(@members){
902 0 0         $self->die("非群成员对象") if not $_->is_group_member;
903             }
904 0           my $ret = $self->_kick_group_member($group->uid,map {$_->uid} @members);
  0            
905 0 0         if($ret){
906 0           for(@members){
907 0           $_->group->remove_group_member($_);
908 0           $self->emit(lose_group_member=>$_);
909             }
910 0           $self->info("踢除群成员成功");
911             }
912 0           else{$self->error("剔除群成员失败")}
913 0           return $ret;
914             }
915              
916             sub shutup_group_member{
917 0     0 0   my $self = shift;
918 0 0         if ( not $self->is_support_model_ext){
919 0           $self->warn("无法支持获取扩展信息");
920 0           return;
921             }
922 0           my $group = shift;
923 0           my $time = shift;
924 0           my @members = @_;
925 0 0         if($time<60){
926 0           $self->error("禁言时间太短,至少1分钟");
927 0           return;
928             }
929 0 0         if(not defined $group->uid){
930 0           $self->error("未获取到群号码,无法完成禁言操作");
931 0           return;
932             }
933 0 0 0       if($group->role ne "manage" and $group->role ne "create"){
934 0           $self->error("非群主或管理员,无法完成禁言操作");
935 0           return;
936             }
937 0           for(@members){
938 0 0         $self->die("非群成员对象") if not $_->is_group_member;
939 0 0 0       if($_->role eq "admin" or $_->role eq "owner"){
940 0           $self->error("无法对群主或管理员进行禁言操作");
941 0           return;
942             }
943             }
944 0           my $ret = $self->_shutup_group_member($group->uid,$time,map {$_->uid} @members);
  0            
945 0 0         if($ret){$self->info("禁言操作成功");}
  0            
946 0           else{$self->error("禁言操作失败");}
947 0           return $ret;
948             }
949             sub speakup_group_member{
950 0     0 0   my $self = shift;
951 0 0         if ( not $self->is_support_model_ext){
952 0           $self->warn("无法支持获取扩展信息");
953 0           return;
954             }
955 0           my $group = shift;
956 0           my @members = @_;
957 0 0         if(not defined $group->uid){
958 0           $self->error("未获取到群号码,无法完成禁言操作");
959 0           return;
960             }
961 0 0 0       if($group->role ne "manage" and $group->role ne "create"){
962 0           $self->error("非群主或管理员,无法完成禁言操作");
963 0           return;
964             }
965 0           for(@members){
966 0 0         $self->die("非群成员对象") if not $_->is_group_member;
967 0 0 0       if($_->role eq "admin" or $_->role eq "owner"){
968 0           $self->error("无法对群主或管理员进行取消禁言操作");
969 0           return;
970             }
971             }
972 0           my $ret = $self->_shutup_group_member($group->uid,0,map {$_->uid} @members);
  0            
973 0 0         if($ret){$self->info("取消禁言操作成功");}
  0            
974 0           else{$self->error("取消禁言操作失败");}
975 0           return $ret;
976             }
977             sub set_group_admin{
978 0     0 0   my $self = shift;
979 0 0         if ( not $self->is_support_model_ext){
980 0           $self->warn("无法支持获取扩展信息");
981 0           return;
982             }
983 0           my $group = shift;
984 0           my @members = @_;
985 0 0         if(not defined $group->uid){
986 0           $self->error("未获取到群号码,无法设置管理员");
987 0           return;
988             }
989 0 0         if($group->role ne "create"){
990 0           $self->error("非群主,无法设置管理员");
991 0           return;
992             }
993 0           for(@members){
994 0 0         $self->die("非群成员对象") if not $_->is_group_member;
995             }
996 0           my $ret = $self->_set_group_admin($group->uid,map {$_->uid} @members);
  0            
997 0 0         if($ret){
998 0           $_->role("admin") for(@members);
999 0           $self->info("设置管理员成功");
1000             }
1001 0           else{$self->error("设置管理员失败")}
1002 0           return $ret;
1003             }
1004             sub remove_group_admin{
1005 0     0 0   my $self = shift;
1006 0           my $group = shift;
1007 0           my @members = @_;
1008 0 0         if(not defined $group->uid){
1009 0           $self->error("未获取到群号码,无法移除管理员");
1010 0           return;
1011             }
1012 0 0         if($group->role ne "create"){
1013 0           $self->error("非群主,无法移除管理员");
1014 0           return;
1015             }
1016 0           for(@members){
1017 0 0         $self->die("非群成员对象") if not $_->is_group_member;
1018             }
1019 0           my $ret = $self->_remove_group_admin($group->uid,map {$_->uid} @members);
  0            
1020 0 0         if($ret){
1021 0           $_->role("member") for(@members);
1022 0           $self->info("移除管理员成功");
1023             }
1024 0           else{$self->error("移除管理员失败")}
1025 0           return $ret;
1026             }
1027             sub set_group_member_card{
1028 0     0 0   my $self = shift;
1029 0           my $group = shift;
1030 0           my $member = shift;
1031 0           my $card = shift;
1032 0 0         if(not defined $group->uid){
1033 0           $self->error("未获取到群号码,无法设置群名片");
1034 0           return;
1035             }
1036 0 0 0       if(!$member->is_me and $group->role ne "create" and $group->role ne "manage"){
      0        
1037 0           $self->error("非群主或管理员,无法设置其他人群名片");
1038 0           return;
1039             }
1040 0 0         $self->die("非群成员对象") if not $member->is_group_member;
1041 0           my $ret = $self->_set_group_member_card($group->uid,$member->uid,$card);
1042 0 0         if($ret){
1043 0           $member->card($card);
1044 0 0         if(length $card){$self->info("设置群名片成功");}
  0            
1045 0           else{$self->info("取消群名片成功");}
1046             }
1047 0           else{$self->error("设置群名片失败")}
1048 0           return $ret;
1049             }
1050              
1051             sub qiandao {
1052 0     0 0   my $self = shift;
1053 0           my $group = shift;
1054 0 0         if ( not $self->is_support_model_ext){
1055 0           $self->warn("无法支持获取扩展信息, 无法进行签到");
1056 0           return;
1057             }
1058 0 0         $self->die("非群组对象") if not $group->is_group;
1059 0 0         if(not defined $group->uid){
1060 0           $self->error("未获取到群号码,无法进行签到");
1061 0           return;
1062             }
1063 0           my $ret = $self->_qiandao($group->uid);
1064 0 0         if($ret){
1065 0           $self->info("群组[ ". $group->displayname ." ]签到成功");
1066             }
1067 0           else{$self->error("群组[ ". $group->displayname ." ]签到失败")}
1068 0           return $ret;
1069             }
1070              
1071             sub friends{
1072 0     0 0   my $self = shift;
1073 0 0         $self->update_friend() if @{$self->friend} == 0;
  0            
1074 0           return @{$self->friend};
  0            
1075             }
1076             sub groups{
1077 0     0 0   my $self = shift;
1078 0 0         $self->update_group() if @{$self->group} == 0;
  0            
1079 0           return @{$self->group};
  0            
1080             }
1081             sub discusss{
1082 0     0 0   my $self = shift;
1083 0 0         $self->update_discuss() if @{$self->discuss} == 0;
  0            
1084 0           return @{$self->discuss};
  0            
1085             }
1086              
1087             1;