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

package Labyrinth::Plugin::Survey::Act::API;

use warnings;
use strict;
use utf8;

use vars qw($VERSION);
$VERSION = '0.06';

=head1 NAME

Labyrinth::Plugin::Survey::Act::API - YAPC Surveys' Act API plugin for Labyrinth framework

=head1 DESCRIPTION

Provides all the interfaces to an Act software instance for YAPC Surveys.

=cut

# -------------------------------------
# Library Modules

use base qw(Labyrinth::Plugin::Base);

use Labyrinth::Audit;
use Labyrinth::DBUtils;
use Labyrinth::DTUtils;
use Labyrinth::MLUtils;
use Labyrinth::Support;
use Labyrinth::Users;
use Labyrinth::Variables;

use Crypt::Lite;
use Digest::SHA1  qw(sha1_hex);
use HTML::Entities;
use JSON;
use Time::Local;
use WWW::Mechanize;

#----------------------------------------------------------
# Variables

my $crypt = Crypt::Lite->new( debug => 0, encoding => 'hex8' );
my $mech = WWW::Mechanize->new();
$mech->agent_alias( 'Linux Mozilla' );

my %rooms;

# -------------------------------------
# The Subs

=head1 PUBLIC INTERFACE METHODS

=over 4

=item LoadUsers

Builds the API call to retrieve the users, and stores the returned JSON into
the database, referencing all the users within Act, who have been recorded as
a speaker and/or registered for the conference event.

=item LoadTalks

Builds he API call to retrieve the talks for the conference event. Parses the
returned JSON, filtering the talks based on day, room and type into specific
categories and stores within the database.

Note that LoadUsers should be called before LoadTalks in order to properly
attribute the tutor/speaker for a course or talk to the correct user within
the system.

=back

=cut

sub LoadUsers {
    my (@saved,%names,%users);
    my $key  = $settings{yapc_name};
    $tvars{counts}{$_} = 0  for(qw(found saved users));

    # get data
    my $url = sprintf $settings{actapi_users}, $settings{icode}, $settings{actapi_pass};
    $mech->get($url);
    unless($mech->success) {
        $tvars{errmess} = 'Unable to access Act instance';
        return;
    }

    my $data = from_json($mech->content());

    for(@{ $settings{othernames} }) {
        my ($k,$v) = split(':');
        $names{$k} = $v;
    }

    for my $user (@$data) {
        $user->{full_name} = $names{$user->{full_name}} if($names{$user->{full_name}});
        my $name = encode_entities($user->{full_name});
        my $nick = encode_entities($user->{nick_name});
        $users{$user->{email}} = 1;

        my @rows;
        @rows = $dbi->GetQuery('hash','FindUserByAct',$user->{user_id})  if($user->{user_id});
        @rows = $dbi->GetQuery('hash','FindUser',$user->{email})        unless(@rows);

        if(@rows) {
            if(!$rows[0]->{actuserid} || $rows[0]->{actuserid} == 0) {
                $dbi->DoQuery('UpdateActUser',$user->{user_id},$rows[0]->{userid});
            }

            if($rows[0]->{userid} > 2) {
                my @keys = $dbi->GetQuery('hash','GetUserCode',$rows[0]->{userid});
                $dbi->DoQuery('ConfirmUser',1,$rows[0]->{userid});
                #print "FOUND: $name <$user->{email}> => $keys[0]->{code}/$rows[0]->{userid}/$user->{userid}\n";
                $tvars{counts}{found}++;
            }
            next;
        }

        my $str = $$ . $user->{email} . time();
        my $code = sha1_hex($crypt->encrypt($str, $key));

        $user->{user_id} ||= 0;
        my $userid = $dbi->IDQuery('NewUser',$user->{email},$nick,$name,$user->{email},$user->{user_id});
        $dbi->DoQuery('ConfirmUser',1,$userid);
        $dbi->DoQuery('SaveUserCode',$code,$userid);

        push @saved, "$name <$user->{email}> => $code/$userid/$user->{user_id}";
        $tvars{counts}{saved}++
    }

    $tvars{data}{saved} = \@saved;

    my @users = $dbi->GetQuery('hash','AllUsers');
    $tvars{counts}{users} = scalar(@users);
}

sub LoadTalks {
    my (@ignore,@insert,@update);
    my $yapc = $settings{icode};
    $tvars{counts}{$_} = 0  for(qw(insert update ignore found totals));

    for(@{ $settings{act_rooms} }) {
        my ($k,$v) = split(':');
        $rooms{$k} = $v;
    }

    my ($y,$m,$d) = $settings{talks_start} =~ /^(\d+)\D(\d+)\D(\d+)\D/;
    $tvars{yapc}{talks_start} = timegm(0,0,0,$d,$m-1,$y);
    ($y,$m,$d) = $settings{survey_start} =~ /^(\d+)\D(\d+)\D(\d+)\D/;
    $tvars{yapc}{talks_end} = timegm(23,59,59,$d,$m-1,$y);

    # get data
    my $url = sprintf $settings{actapi_talks}, $settings{icode}, $settings{actapi_pass};
    $mech->get($url);
    unless($mech->success) {
        $tvars{errmess} = 'Unable to access Act instance';
        return;
    }

    #my $data = from_json($mech->content(), {utf8 => 1});
    my $data = from_json($mech->content());

    #print STDERR "data=".Dumper($data);

    for my $talk (@$data) {
        my $title = encode_entities($talk->{title});
        my $tutor = encode_entities($talk->{speaker});
        $talk->{room}     ||= '';
        $talk->{datetime} ||= '';
        my $type = _check_room($talk->{room}, $talk->{datetime});

        my @rows;
        @rows = $dbi->GetQuery('hash','FindCourseByAct',$talk->{talk_id})    if($talk->{talk_id});
        @rows = $dbi->GetQuery('hash','FindCourse',$title,$tutor)           unless(@rows);

        if(@rows) {
            if(!$rows[0]->{acttalkid} || $rows[0]->{acttalkid} == 0) {
                $dbi->DoQuery('UpdateActCourse',$talk->{talk_id},$talk->{user_id},$rows[0]->{courseid});
            }

            if($rows[0]->{talk} == -1) { # ignore this talk
                push @ignore, "$rows[0]->{courseid},$title,$tutor,$talk->{room},$talk->{datetime} = $type";
                $tvars{counts}{ignore}++;
                next;
            }

            if($rows[0]->{talk} == 2) { # preset LT
                $type = $rows[0]->{talk};
                $talk->{datetime} = $rows[0]->{datetime};
            }

           my $diff = 0;
           $diff = 1       if(_different($title,$rows[0]->{course}));
           $diff = 1       if(_different($tutor,$rows[0]->{tutor}));
           $diff = 1       if(_different($talk->{room},$rows[0]->{room}));
           $diff = 1       if(_different($talk->{datetime},$rows[0]->{datetime}));
           $diff = 1       if(_differant($type,$rows[0]->{talk}));

            if($diff) {
                $dbi->DoQuery('SaveCourse',$title,$tutor,$talk->{room},$talk->{datetime},$type,$rows[0]->{courseid});
                push @update, "$rows[0]->{courseid},$title,$tutor,$talk->{room},$talk->{datetime} = $type";
                push @update, "WAS=$rows[0]->{courseid},$rows[0]->{course},$rows[0]->{tutor},$rows[0]->{room},$rows[0]->{datetime} = $rows[0]->{talk}";
                push @update, "NOW=$rows[0]->{courseid},$title,$tutor,$talk->{room},$talk->{datetime} = $type";
                $tvars{counts}{update}++;
            } else {
                $tvars{counts}{found}++;
            }
        } else {
            my $id = $dbi->IDQuery('AddCourse',$title,$tutor,$talk->{room},$talk->{datetime},$type);
            push @insert, "$id,$title,$tutor,$talk->{room},$talk->{datetime} = $type";
            $tvars{counts}{insert}++;
        }
    }

    $tvars{counts}{totals} += $tvars{counts}{$_}             for(qw(insert update ignore found));
}

#----------------------------------------------------------
# Private functions

sub _check_room {
    my $room = shift or return 0;
    my $time = shift or return 0;
    my $type = $rooms{$room} ? 1 : 0;

    push @{$tvars{errors}}, "Undefined room: $room"  if(!defined $rooms{$room});

    my $day = $tvars{yapc}{talks_start};
    while($day < $tvars{yapc}{talks_end}) {
        my $start = $day + (60*60*8);
        my $end   = $day + (60*60*18);
        return 0        if($time < $start);
        return $type    if($time < $end);
        $day += (60*60*24);
    }

    return 0;
}

sub _different {
    my ($val1,$val2) = @_;

    return 1   if( $val1 && !$val2);
    return 1   if(!$val1 &&  $val2);
    return 0   if(!$val1 && !$val2);
    return 1   if( $val1 ne  $val2);
    return 0;
}

sub _differant {
    my ($val1,$val2) = @_;

    return 1   if( $val1 && !$val2);
    return 1   if(!$val1 &&  $val2);
    return 0   if(!$val1 && !$val2);
    return 1   if( $val1 !=  $val2);
    return 0;
}

1;

__END__