| 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__ |