File Coverage

blib/lib/Labyrinth/Plugin/Survey/Act/API.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 20 100.0


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__