| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Mojo::Webqq::Discuss; |
|
2
|
1
|
|
|
1
|
|
6
|
use strict; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
31
|
|
|
3
|
1
|
|
|
1
|
|
5
|
use List::Util qw(first); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
52
|
|
|
4
|
1
|
|
|
1
|
|
412
|
use Mojo::Webqq::Discuss::Member; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
8
|
|
|
5
|
1
|
|
|
1
|
|
6
|
use Mojo::Webqq::Base 'Mojo::Webqq::Model::Base'; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
3
|
|
|
6
|
|
|
|
|
|
|
has [qw( |
|
7
|
|
|
|
|
|
|
id |
|
8
|
|
|
|
|
|
|
name |
|
9
|
|
|
|
|
|
|
owner_id |
|
10
|
|
|
|
|
|
|
)]; |
|
11
|
|
|
|
|
|
|
has member => sub{[]}; |
|
12
|
0
|
|
|
0
|
0
|
|
sub member_count {0+@{$_[0]->member}} |
|
|
0
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub AUTOLOAD { |
|
14
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
15
|
0
|
0
|
|
|
|
|
if($Mojo::Webqq::Discuss::AUTOLOAD =~ /.*::d(.*)/){ |
|
16
|
0
|
|
|
|
|
|
my $attr = $1; |
|
17
|
0
|
|
|
|
|
|
$self->$attr(@_); |
|
18
|
|
|
|
|
|
|
} |
|
19
|
0
|
|
|
|
|
|
else{die("undefined subroutine $Mojo::Webqq::Discuss::AUTOLOAD");} |
|
20
|
|
|
|
|
|
|
} |
|
21
|
|
|
|
|
|
|
sub displayname { |
|
22
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
23
|
0
|
|
|
|
|
|
return $self->name; |
|
24
|
|
|
|
|
|
|
} |
|
25
|
|
|
|
|
|
|
sub new { |
|
26
|
0
|
|
|
0
|
0
|
|
my $class = shift; |
|
27
|
0
|
|
|
|
|
|
my $self ; |
|
28
|
0
|
0
|
0
|
|
|
|
bless $self=@_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class; |
|
|
0
|
0
|
|
|
|
|
|
|
29
|
0
|
0
|
0
|
|
|
|
if(exists $self->{member} and ref $self->{member} eq "ARRAY"){ |
|
30
|
0
|
|
|
|
|
|
for( @{ $self->{member} } ){ |
|
|
0
|
|
|
|
|
|
|
|
31
|
0
|
0
|
|
|
|
|
$_->{_discuss_id} = $self->id if not defined $_->{_discuss_id}; |
|
32
|
0
|
0
|
|
|
|
|
$_ = Mojo::Webqq::Discuss::Member->new($_) if ref $_ ne "Mojo::Webqq::Discuss::Member"; |
|
33
|
|
|
|
|
|
|
} |
|
34
|
|
|
|
|
|
|
} |
|
35
|
0
|
|
|
|
|
|
$self; |
|
36
|
|
|
|
|
|
|
} |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub members{ |
|
39
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
40
|
0
|
0
|
|
|
|
|
$self->client->update_discuss($self) if $self->is_empty; |
|
41
|
0
|
|
|
|
|
|
return @{$self->member}; |
|
|
0
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
} |
|
43
|
|
|
|
|
|
|
sub each_discuss_member{ |
|
44
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
45
|
0
|
|
|
|
|
|
my $callback = shift; |
|
46
|
0
|
0
|
|
|
|
|
$self->client->die("参数必须是函数引用") if ref $callback ne "CODE"; |
|
47
|
0
|
0
|
|
|
|
|
return if ref $self->member ne "ARRAY"; |
|
48
|
0
|
0
|
|
|
|
|
$self->client->update_discuss($self) if $self->is_empty; |
|
49
|
0
|
|
|
|
|
|
for(@{$self->member}){ |
|
|
0
|
|
|
|
|
|
|
|
50
|
0
|
|
|
|
|
|
$callback->($self->client,$_); |
|
51
|
|
|
|
|
|
|
} |
|
52
|
|
|
|
|
|
|
} |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub search_discuss_member{ |
|
55
|
1
|
|
|
1
|
|
8
|
no warnings 'uninitialized'; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
1340
|
|
|
56
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
57
|
0
|
|
|
|
|
|
my %p = @_; |
|
58
|
0
|
0
|
|
|
|
|
return if 0 == grep {defined $p{$_}} keys %p; |
|
|
0
|
|
|
|
|
|
|
|
59
|
0
|
0
|
|
|
|
|
$self->client->update_discuss($self) if $self->is_empty; |
|
60
|
0
|
0
|
|
|
|
|
if(wantarray){ |
|
61
|
0
|
0
|
|
0
|
|
|
return grep {my $m = $_;(first {$p{$_} ne $m->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->member}; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
} |
|
63
|
|
|
|
|
|
|
else{ |
|
64
|
0
|
0
|
|
0
|
|
|
return first {my $m = $_;(first {$p{$_} ne $m->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->member}; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
} |
|
66
|
|
|
|
|
|
|
} |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub add_discuss_member{ |
|
69
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
70
|
0
|
|
|
|
|
|
my $member = shift; |
|
71
|
0
|
|
|
|
|
|
my $nocheck = shift; |
|
72
|
0
|
0
|
|
|
|
|
$self->client->die("不支持的数据类型") if ref $member ne "Mojo::Webqq::Discuss::Member"; |
|
73
|
0
|
0
|
|
|
|
|
if($nocheck){ |
|
74
|
0
|
|
|
|
|
|
push @{$self->member},$member; |
|
|
0
|
|
|
|
|
|
|
|
75
|
0
|
|
|
|
|
|
return $self; |
|
76
|
|
|
|
|
|
|
} |
|
77
|
0
|
|
|
|
|
|
my $m = $self->search_discuss_member(id=>$member->id); |
|
78
|
0
|
0
|
|
|
|
|
if(defined $m){ |
|
79
|
0
|
|
|
|
|
|
%$m = %$member; |
|
80
|
|
|
|
|
|
|
} |
|
81
|
|
|
|
|
|
|
else{ |
|
82
|
0
|
|
|
|
|
|
push @{$self->member},$member; |
|
|
0
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
} |
|
84
|
0
|
|
|
|
|
|
return $self; |
|
85
|
|
|
|
|
|
|
} |
|
86
|
|
|
|
|
|
|
sub remove_discuss_member{ |
|
87
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
88
|
0
|
|
|
|
|
|
my $member = shift; |
|
89
|
0
|
0
|
|
|
|
|
$self->client->die("不支持的数据类型") if ref $member ne "Mojo::Webqq::Discuss::Member"; |
|
90
|
0
|
|
|
|
|
|
for(my $i=0;$i<@{$self->member};$i++){ |
|
|
0
|
|
|
|
|
|
|
|
91
|
0
|
0
|
|
|
|
|
if($self->member->[$i]->id eq $member->id){ |
|
92
|
0
|
|
|
|
|
|
splice @{$self->member},$i,1; |
|
|
0
|
|
|
|
|
|
|
|
93
|
0
|
|
|
|
|
|
return 1; |
|
94
|
|
|
|
|
|
|
} |
|
95
|
|
|
|
|
|
|
} |
|
96
|
0
|
|
|
|
|
|
return; |
|
97
|
|
|
|
|
|
|
} |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub is_empty{ |
|
100
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
101
|
0
|
0
|
|
|
|
|
return !(ref($self->member) eq "ARRAY"?0+@{$self->member}:0); |
|
|
0
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
} |
|
103
|
|
|
|
|
|
|
sub update_discuss_member { |
|
104
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
105
|
0
|
|
|
|
|
|
$self->client->update_discuss_member($self,@_); |
|
106
|
|
|
|
|
|
|
} |
|
107
|
|
|
|
|
|
|
sub update{ |
|
108
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
109
|
0
|
|
|
|
|
|
my $hash = shift; |
|
110
|
0
|
|
|
|
|
|
for(grep {substr($_,0,1) ne "_"} keys %$hash){ |
|
|
0
|
|
|
|
|
|
|
|
111
|
0
|
0
|
0
|
|
|
|
if($_ eq "member" and exists $hash->{member} and ref $hash->{member} eq "ARRAY"){ |
|
|
|
|
0
|
|
|
|
|
|
112
|
0
|
0
|
|
|
|
|
next if not @{$hash->{member}}; |
|
|
0
|
|
|
|
|
|
|
|
113
|
0
|
0
|
|
|
|
|
my @member = map {ref $_ eq "Mojo::Webqq::Discuss::Member"?$_:Mojo::Webqq::Discuss::Member->new($_)} @{$hash->{member}}; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
114
|
0
|
0
|
|
|
|
|
if( $self->is_empty() ){ |
|
115
|
0
|
|
|
|
|
|
$self->member(\@member); |
|
116
|
|
|
|
|
|
|
} |
|
117
|
|
|
|
|
|
|
else{ |
|
118
|
0
|
|
|
0
|
|
|
my($new_members,$lost_members,$sames)=$self->client->array_diff($self->member, \@member,sub{$_[0]->id}); |
|
|
0
|
|
|
|
|
|
|
|
119
|
0
|
|
|
|
|
|
for(@{$new_members}){ |
|
|
0
|
|
|
|
|
|
|
|
120
|
0
|
|
|
|
|
|
$self->add_discuss_member($_); |
|
121
|
0
|
0
|
|
|
|
|
$self->client->emit(new_discuss_member=>$_,$self) if defined $self->client; |
|
122
|
|
|
|
|
|
|
} |
|
123
|
0
|
|
|
|
|
|
for(@{$lost_members}){ |
|
|
0
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
$self->remove_discuss_member($_); |
|
125
|
0
|
0
|
|
|
|
|
$self->client->emit(lose_discuss_member=>$_,$self) if defined $self->client; |
|
126
|
|
|
|
|
|
|
} |
|
127
|
0
|
|
|
|
|
|
for(@{$sames}){ |
|
|
0
|
|
|
|
|
|
|
|
128
|
0
|
|
|
|
|
|
my($old,$new) = ($_->[0],$_->[1]); |
|
129
|
0
|
|
|
|
|
|
$old->update($new); |
|
130
|
|
|
|
|
|
|
} |
|
131
|
|
|
|
|
|
|
} |
|
132
|
|
|
|
|
|
|
} |
|
133
|
|
|
|
|
|
|
else{ |
|
134
|
0
|
0
|
|
|
|
|
if(exists $hash->{$_}){ |
|
135
|
0
|
0
|
0
|
|
|
|
if(defined $hash->{$_} and defined $self->{$_}){ |
|
|
|
0
|
0
|
|
|
|
|
|
136
|
0
|
0
|
|
|
|
|
if($hash->{$_} ne $self->{$_}){ |
|
137
|
0
|
|
|
|
|
|
my $old_property = $self->{$_}; |
|
138
|
0
|
|
|
|
|
|
my $new_property = $hash->{$_}; |
|
139
|
0
|
|
|
|
|
|
$self->{$_} = $hash->{$_}; |
|
140
|
0
|
|
|
|
|
|
$self->client->emit("discuss_property_change"=>$self,$_,$old_property,$new_property); |
|
141
|
|
|
|
|
|
|
} |
|
142
|
|
|
|
|
|
|
} |
|
143
|
|
|
|
|
|
|
elsif( ! (!defined $hash->{$_} and !defined $self->{$_}) ){ |
|
144
|
0
|
|
|
|
|
|
my $old_property = $self->{$_}; |
|
145
|
0
|
|
|
|
|
|
my $new_property = $hash->{$_}; |
|
146
|
0
|
|
|
|
|
|
$self->{$_} = $hash->{$_}; |
|
147
|
0
|
|
|
|
|
|
$self->client->emit("discuss_property_change"=>$self,$_,$old_property,$new_property); |
|
148
|
|
|
|
|
|
|
} |
|
149
|
|
|
|
|
|
|
} |
|
150
|
|
|
|
|
|
|
} |
|
151
|
|
|
|
|
|
|
} |
|
152
|
0
|
|
|
|
|
|
$self; |
|
153
|
|
|
|
|
|
|
} |
|
154
|
|
|
|
|
|
|
sub send { |
|
155
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
156
|
0
|
|
|
|
|
|
$self->client->send_discuss_message($self,@_); |
|
157
|
|
|
|
|
|
|
} |
|
158
|
|
|
|
|
|
|
sub me { |
|
159
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
160
|
0
|
|
|
|
|
|
$self->search_discuss_member(id=>$self->client->user->id); |
|
161
|
|
|
|
|
|
|
} |
|
162
|
|
|
|
|
|
|
1; |