line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Labyrinth::Plugin::Survey::Act::API; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
7118
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
72
|
|
4
|
2
|
|
|
2
|
|
11
|
use strict; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
60
|
|
5
|
2
|
|
|
2
|
|
565
|
use utf8; |
|
2
|
|
|
|
|
10
|
|
|
2
|
|
|
|
|
10
|
|
6
|
|
|
|
|
|
|
|
7
|
2
|
|
|
2
|
|
54
|
use vars qw($VERSION); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
117
|
|
8
|
|
|
|
|
|
|
$VERSION = '0.08'; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 NAME |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Labyrinth::Plugin::Survey::Act::API - YAPC Surveys' Act API plugin for Labyrinth framework |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 DESCRIPTION |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Provides all the interfaces to an Act software instance for YAPC Surveys. |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=cut |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# ------------------------------------- |
21
|
|
|
|
|
|
|
# Library Modules |
22
|
|
|
|
|
|
|
|
23
|
2
|
|
|
2
|
|
12
|
use base qw(Labyrinth::Plugin::Base); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
800
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
use Labyrinth::Audit; |
26
|
|
|
|
|
|
|
use Labyrinth::DBUtils; |
27
|
|
|
|
|
|
|
use Labyrinth::DTUtils; |
28
|
|
|
|
|
|
|
use Labyrinth::MLUtils; |
29
|
|
|
|
|
|
|
use Labyrinth::Support; |
30
|
|
|
|
|
|
|
use Labyrinth::Users; |
31
|
|
|
|
|
|
|
use Labyrinth::Variables; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
use Crypt::Lite; |
34
|
|
|
|
|
|
|
use Digest::SHA1 qw(sha1_hex); |
35
|
|
|
|
|
|
|
use HTML::Entities; |
36
|
|
|
|
|
|
|
use JSON; |
37
|
|
|
|
|
|
|
use Time::Local; |
38
|
|
|
|
|
|
|
use WWW::Mechanize; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
#---------------------------------------------------------- |
41
|
|
|
|
|
|
|
# Variables |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
my $crypt = Crypt::Lite->new( debug => 0, encoding => 'hex8' ); |
44
|
|
|
|
|
|
|
my $mech = WWW::Mechanize->new(); |
45
|
|
|
|
|
|
|
$mech->agent_alias( 'Linux Mozilla' ); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
my %rooms; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# ------------------------------------- |
50
|
|
|
|
|
|
|
# The Subs |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head1 PUBLIC INTERFACE METHODS |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=over 4 |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=item LoadUsers |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
Builds the API call to retrieve the users, and stores the returned JSON into |
59
|
|
|
|
|
|
|
the database, referencing all the users within Act, who have been recorded as |
60
|
|
|
|
|
|
|
a speaker and/or registered for the conference event. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=item LoadTalks |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Builds he API call to retrieve the talks for the conference event. Parses the |
65
|
|
|
|
|
|
|
returned JSON, filtering the talks based on day, room and type into specific |
66
|
|
|
|
|
|
|
categories and stores within the database. |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
Note that LoadUsers should be called before LoadTalks in order to properly |
69
|
|
|
|
|
|
|
attribute the tutor/speaker for a course or talk to the correct user within |
70
|
|
|
|
|
|
|
the system. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=back |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=cut |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub LoadUsers { |
77
|
|
|
|
|
|
|
my (@saved,%names,%users); |
78
|
|
|
|
|
|
|
my $key = $settings{yapc_name}; |
79
|
|
|
|
|
|
|
$tvars{counts}{$_} = 0 for(qw(found saved users)); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# get data |
82
|
|
|
|
|
|
|
my $url = sprintf $settings{actapi_users}, $settings{icode}, $settings{actapi_pass}; |
83
|
|
|
|
|
|
|
$mech->get($url); |
84
|
|
|
|
|
|
|
unless($mech->success) { |
85
|
|
|
|
|
|
|
$tvars{errmess} = 'Unable to access Act instance'; |
86
|
|
|
|
|
|
|
return; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
my $data = from_json($mech->content()); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
for(@{ $settings{othernames} }) { |
92
|
|
|
|
|
|
|
my ($k,$v) = split(':'); |
93
|
|
|
|
|
|
|
$names{$k} = $v; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
for my $user (@$data) { |
97
|
|
|
|
|
|
|
$user->{full_name} = $names{$user->{full_name}} if($names{$user->{full_name}}); |
98
|
|
|
|
|
|
|
my $name = encode_entities($user->{full_name}); |
99
|
|
|
|
|
|
|
my $nick = encode_entities($user->{nick_name}); |
100
|
|
|
|
|
|
|
$users{$user->{email}} = 1; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
my @rows; |
103
|
|
|
|
|
|
|
@rows = $dbi->GetQuery('hash','FindUserByAct',$user->{user_id}) if($user->{user_id}); |
104
|
|
|
|
|
|
|
@rows = $dbi->GetQuery('hash','FindUser',$user->{email}) unless(@rows); |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
if(@rows) { |
107
|
|
|
|
|
|
|
$tvars{counts}{all}++; |
108
|
|
|
|
|
|
|
next unless($rows[0]->{search}); # ignore disabled users |
109
|
|
|
|
|
|
|
$tvars{counts}{enabled}++; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
if(!$rows[0]->{actuserid} || $rows[0]->{actuserid} == 0) { |
112
|
|
|
|
|
|
|
$dbi->DoQuery('UpdateActUser',$user->{user_id},$rows[0]->{userid}); |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
if($rows[0]->{userid} > 2) { |
116
|
|
|
|
|
|
|
$tvars{counts}{found}++; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# could have signed up, then been registered |
119
|
|
|
|
|
|
|
unless($rows[0]->{code}) { |
120
|
|
|
|
|
|
|
my $str = $$ . $user->{email} . time(); |
121
|
|
|
|
|
|
|
$rows[0]->{code} = sha1_hex($crypt->encrypt($str, $key)); |
122
|
|
|
|
|
|
|
$dbi->DoQuery('SaveUserCode',$rows[0]->{code},$rows[0]->{userid}); |
123
|
|
|
|
|
|
|
push @saved, { status => 'REGISTERED', name => $name, email => $user->{email}, link => "$rows[0]->{code}/$rows[0]->{userid}" }; |
124
|
|
|
|
|
|
|
$tvars{counts}{registered}++; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
next if($rows[0]->{confirmed}); # already confirmed |
128
|
|
|
|
|
|
|
$tvars{counts}{confirmed}++; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
$dbi->DoQuery('ConfirmUser',1,$rows[0]->{userid}); |
131
|
|
|
|
|
|
|
push @saved, { status => 'CONFIRMED', name => $name, email => $user->{email}, link => "$rows[0]->{code}/$rows[0]->{userid}" }; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
next; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
my $str = $$ . $user->{email} . time(); |
138
|
|
|
|
|
|
|
my $code = sha1_hex($crypt->encrypt($str, $key)); |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
$user->{user_id} ||= 0; |
141
|
|
|
|
|
|
|
my $userid = $dbi->IDQuery('NewUser',$user->{email},$nick,$name,$user->{email},$user->{user_id}); |
142
|
|
|
|
|
|
|
$dbi->DoQuery('ConfirmUser',1,$userid); |
143
|
|
|
|
|
|
|
$dbi->DoQuery('SaveUserCode',$code,$userid); |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
push @saved, { status => 'SAVED', name => $name, email => $user->{email}, link => "$code/$userid" }; |
146
|
|
|
|
|
|
|
$tvars{counts}{saved}++ |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
$tvars{data}{saved} = \@saved; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
my @users = $dbi->GetQuery('hash','AllUsers'); |
152
|
|
|
|
|
|
|
$tvars{counts}{users} = scalar(@users); |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
sub LoadTalks { |
156
|
|
|
|
|
|
|
my (@talks); |
157
|
|
|
|
|
|
|
my $yapc = $settings{icode}; |
158
|
|
|
|
|
|
|
$tvars{counts}{$_} = 0 for(qw(insert update ignore found totals)); |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
for(@{ $settings{act_rooms} }) { |
161
|
|
|
|
|
|
|
my ($k,$v) = split(':'); |
162
|
|
|
|
|
|
|
$rooms{$k} = $v; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
my ($y,$m,$d) = $settings{talks_start} =~ /^(\d+)\D(\d+)\D(\d+)\D/; |
166
|
|
|
|
|
|
|
$tvars{yapc}{talks_start} = timegm(0,0,0,$d,$m-1,$y); |
167
|
|
|
|
|
|
|
($y,$m,$d) = $settings{survey_start} =~ /^(\d+)\D(\d+)\D(\d+)\D/; |
168
|
|
|
|
|
|
|
$tvars{yapc}{talks_end} = timegm(23,59,59,$d,$m-1,$y); |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# get data |
171
|
|
|
|
|
|
|
my $url = sprintf $settings{actapi_talks}, $settings{icode}, $settings{actapi_pass}; |
172
|
|
|
|
|
|
|
$mech->get($url); |
173
|
|
|
|
|
|
|
unless($mech->success) { |
174
|
|
|
|
|
|
|
$tvars{errmess} = 'Unable to access Act instance'; |
175
|
|
|
|
|
|
|
return; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
#my $data = from_json($mech->content(), {utf8 => 1}); |
179
|
|
|
|
|
|
|
my $data = from_json($mech->content()); |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
#print STDERR "data=".Dumper($data); |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
for my $talk (@$data) { |
184
|
|
|
|
|
|
|
my $title = encode_entities($talk->{title}); |
185
|
|
|
|
|
|
|
my $tutor = encode_entities($talk->{speaker}); |
186
|
|
|
|
|
|
|
$talk->{room} ||= ''; |
187
|
|
|
|
|
|
|
$talk->{datetime} ||= ''; |
188
|
|
|
|
|
|
|
my $type = _check_room($talk->{room}, $talk->{datetime}); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
my @rows; |
191
|
|
|
|
|
|
|
@rows = $dbi->GetQuery('hash','FindCourseByAct',$talk->{talk_id}) if($talk->{talk_id}); |
192
|
|
|
|
|
|
|
@rows = $dbi->GetQuery('hash','FindCourse',$title,$tutor) unless(@rows); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
if(@rows) { |
195
|
|
|
|
|
|
|
if(!$rows[0]->{acttalkid} || $rows[0]->{acttalkid} == 0) { |
196
|
|
|
|
|
|
|
$dbi->DoQuery('UpdateActCourse',$talk->{talk_id},$talk->{user_id},$rows[0]->{courseid}); |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
if($rows[0]->{talk} == -1) { # ignore this talk |
200
|
|
|
|
|
|
|
push @talks, { status => 'IGNORE', courseid => $rows[0]->{courseid}, title => $title, tutor => $tutor, room => $talk->{room}, datetime => formatDate(21,$talk->{datetime}), timestamp => $talk->{datetime}, type => $type }; |
201
|
|
|
|
|
|
|
$tvars{counts}{ignore}++; |
202
|
|
|
|
|
|
|
next; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
if($rows[0]->{talk} == 2) { # preset LT |
206
|
|
|
|
|
|
|
$type = $rows[0]->{talk}; |
207
|
|
|
|
|
|
|
$talk->{datetime} = $rows[0]->{datetime}; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
my $diff = 0; |
211
|
|
|
|
|
|
|
$diff = 1 if(_different($title,$rows[0]->{course})); |
212
|
|
|
|
|
|
|
$diff = 1 if(_different($tutor,$rows[0]->{tutor})); |
213
|
|
|
|
|
|
|
$diff = 1 if(_different($talk->{room},$rows[0]->{room})); |
214
|
|
|
|
|
|
|
$diff = 1 if(_different($talk->{datetime},$rows[0]->{datetime})); |
215
|
|
|
|
|
|
|
$diff = 1 if(_differant($type,$rows[0]->{talk})); |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
if($diff) { |
218
|
|
|
|
|
|
|
$dbi->DoQuery('SaveCourse',$title,$tutor,$talk->{room},$talk->{datetime},$type,$rows[0]->{courseid}); |
219
|
|
|
|
|
|
|
push @talks, { status => 'UPDATE', courseid => $rows[0]->{courseid}, title => $title, tutor => $tutor, room => $talk->{room}, datetime => formatDate(21,$talk->{datetime}), timestamp => $talk->{datetime}, type => $type }; |
220
|
|
|
|
|
|
|
push @talks, { status => 'WAS', courseid => $rows[0]->{courseid}, title => $rows[0]->{course}, tutor => $rows[0]->{tutor}, room => $rows[0]->{room}, datetime => formatDate(21,$rows[0]->{datetime}), timestamp => $rows[0]->{datetime}, type => $rows[0]->{talk} }; |
221
|
|
|
|
|
|
|
$tvars{counts}{update}++; |
222
|
|
|
|
|
|
|
} else { |
223
|
|
|
|
|
|
|
$tvars{counts}{found}++; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
} else { |
226
|
|
|
|
|
|
|
my $id = $dbi->IDQuery('AddCourse',$title,$tutor,$talk->{room},$talk->{datetime},$type); |
227
|
|
|
|
|
|
|
push @talks, { status => 'INSERT', courseid => $id, title => $title, tutor => $tutor, room => $talk->{room}, datetime => formatDate(21,$talk->{datetime}), timestamp => $talk->{datetime}, type => $type }; |
228
|
|
|
|
|
|
|
$tvars{counts}{insert}++; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
$tvars{data}{talks} = \@talks if(@talks); |
233
|
|
|
|
|
|
|
$tvars{counts}{totals} += $tvars{counts}{$_} for(qw(insert update ignore found)); |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
#---------------------------------------------------------- |
237
|
|
|
|
|
|
|
# Private functions |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
sub _check_room { |
240
|
|
|
|
|
|
|
my $room = shift or return 0; |
241
|
|
|
|
|
|
|
my $time = shift or return 0; |
242
|
|
|
|
|
|
|
my $type = $rooms{$room} ? 1 : 0; |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
push @{$tvars{errors}}, "Undefined room: $room" if(!defined $rooms{$room}); |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
my $day = $tvars{yapc}{talks_start}; |
247
|
|
|
|
|
|
|
while($day < $tvars{yapc}{talks_end}) { |
248
|
|
|
|
|
|
|
my $start = $day + (60*60*8); |
249
|
|
|
|
|
|
|
my $end = $day + (60*60*18); |
250
|
|
|
|
|
|
|
return 0 if($time < $start); |
251
|
|
|
|
|
|
|
return $type if($time < $end); |
252
|
|
|
|
|
|
|
$day += (60*60*24); |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
return 0; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub _different { |
259
|
|
|
|
|
|
|
my ($val1,$val2) = @_; |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
return 1 if( $val1 && !$val2); |
262
|
|
|
|
|
|
|
return 1 if(!$val1 && $val2); |
263
|
|
|
|
|
|
|
return 0 if(!$val1 && !$val2); |
264
|
|
|
|
|
|
|
return 1 if( $val1 ne $val2); |
265
|
|
|
|
|
|
|
return 0; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub _differant { |
269
|
|
|
|
|
|
|
my ($val1,$val2) = @_; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
return 1 if( $val1 && !$val2); |
272
|
|
|
|
|
|
|
return 1 if(!$val1 && $val2); |
273
|
|
|
|
|
|
|
return 0 if(!$val1 && !$val2); |
274
|
|
|
|
|
|
|
return 1 if( $val1 != $val2); |
275
|
|
|
|
|
|
|
return 0; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
1; |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
__END__ |