File Coverage

blib/lib/WebService/Moodle/Simple.pm

Criterion	Covered	Total	%
statement	31	130	23.8
branch	0	20	0.0
condition	0	5	0.0
subroutine	11	20	55.0
pod	7	9	77.7
total	49	184	26.6

package WebService::Moodle::Simple;

use 5.008_005;
our $VERSION = '0.05';
use namespace::clean;

use HTTP::Request;
use JSON;
use List::Util qw/first/;
use LWP::UserAgent;
use Moo;
use Ouch;
use URI;
use Sys::SigAction qw( timeout_call );


# ABSTRACT: API client for Stripe


my $REST_FORMAT = 'json';
# https://moodle.org/mod/forum/discuss.php?d=340377
my $STUDENT_ROLE_ID = 5;

# the base domain like moodle.example.com
has domain => (
    is => 'ro',
);

# name of the moodle external service
has target => (
    is      => 'ro',
);

has token => (
    is      => 'ro',
);

has port => (
    is      => 'ro',
    default => 443,
);

has timeout => (
    is      => 'ro',
    default => 1000,
);

has scheme => (
    is      => 'rw',
    default => 'https',
);



sub dns_uri {
    my $self = shift;
    return URI->new($self->scheme.'://'.$self->domain.':'.$self->port);
}

sub rest_call {
    my ($self, $dns_uri) = @_;

    my $timeout = $self->timeout + 1;

    my $res;

    if ( timeout_call( $timeout,
        sub {
            my $req = HTTP::Request->new (GET => $dns_uri);
            $req->content_type('application/json');

            my $lwp = LWP::UserAgent->new;
            $lwp->timeout($timeout);
            $res = $lwp->request( $req );
        }
    )) {
            ouch 408, 'Timeout: no response from '.$self->domain;
    }

    unless ($res->is_success) {
        ouch $res->code, $res->message;
    }

    return $res;
}


sub set_password {
    my $self = shift;
    my %args = (
        username   => undef,
        password   => undef,
        @_
    );

    my $username = lc($args{username});

    my $params = {
        'wstoken'                      => $self->token,
        'wsfunction'                   => "core_user_update_users",
        'moodlewsrestformat'           => $REST_FORMAT,
        'users[0][id]'                 => $self->get_user(username => $username )->{id},
        'users[0][password]'           => $args{password},
    };


    my $dns_uri = $self->dns_uri;
    $dns_uri->path('webservice/rest/server.php');
    $dns_uri->query_form( $params );

    my $res = $self->rest_call($dns_uri);

    return { ok => $res->is_success };
}



sub add_user {
    my $self = shift;
    my %args = (
        firstname => undef,
        lastname  => undef,
        email     => undef,
        username  => undef,
        password  => undef,
        @_
    );


    my $username = lc($args{username});

    my $params = {
        'wstoken'                      => $self->token,
        'wsfunction'                   => "core_user_create_users",
        'moodlewsrestformat'           => $REST_FORMAT,
        'users[0][username]'           => $username,
        'users[0][email]'              => $args{email},
        'users[0][firstname]'          => $args{firstname},
        'users[0][lastname]'           => $args{lastname},
        'users[0][password]'           => $args{password},
    };


    my $dns_uri = $self->dns_uri;
    $dns_uri->path('webservice/rest/server.php');
    $dns_uri->query_form( $params );

    my $res = $self->rest_call($dns_uri);

    my $response = from_json($res->content);

    unless (ref($response) eq 'ARRAY') {
        return { ok => 0, msg => $response->{debuginfo} };
    }


    return { ok => 1, %{$response->[0]} }
}

sub get_user {
    my $self = shift;
    my %args = (
        username  => undef,
        @_
    );


    my $username = lc($args{username});

    my $params = {
        'wstoken'                      => $self->token,
        'wsfunction'                   => "core_user_get_users_by_field",
        'moodlewsrestformat'           => $REST_FORMAT,
        'field'                        => 'username',
        'values[0]'                    => $username,
    };


    my $dns_uri = $self->dns_uri;
    $dns_uri->path('webservice/rest/server.php');
    $dns_uri->query_form( $params );

    my $res = $self->rest_call($dns_uri);

    my $dat = from_json($res->content);
    unless ($dat && ref($dat) eq 'ARRAY' && scalar(@$dat)) {
        return;
    }
    return $dat->[0];
}


sub enrol_student {
    my $self = shift;
    my %args = (
        username   => undef,
        course    => undef,
        @_
    );

    my $user = $self->get_user(
        username => $args{username}
    );
    return { ok => undef, msg => "Invalid user $args{username}" } unless $user;

    my $user_id = $user->{id};

    my $params = {
        'wstoken'                      => $self->token,
        'wsfunction'                   => "enrol_manual_enrol_users",
        'moodlewsrestformat'           => $REST_FORMAT,
        'enrolments[0][roleid]'        => $STUDENT_ROLE_ID,
        'enrolments[0][userid]'        => $user_id,
        'enrolments[0][courseid]'      => $self->get_course_id (  short_cname => $args{course} ),
    };


    my $dns_uri = $self->dns_uri;
    $dns_uri->path('webservice/rest/server.php');
    $dns_uri->query_form( $params );

    my $res = $self->rest_call($dns_uri);
    unless ($res->is_success) {
        ouch $res->code, $res->message;
    }

    return { ok => 1, msg => "$args{username} enrolled in $args{course}" } if ($res->content eq 'null');
    return { ok => undef, msg => from_json($res->content)->{message} };
}

sub get_course_id {
    my $self = shift;
    my %args = (
        short_cname => undef,
        @_
    );

    my $dns_uri = $self->dns_uri;
    $dns_uri->path('webservice/rest/server.php');
    $dns_uri->query_form( {
        wstoken            =>  $self->token,
        wsfunction         => 'core_course_get_courses',
        moodlewsrestformat => $REST_FORMAT,
    } );

    my $res = $self->rest_call($dns_uri);
    my $ra_courses = from_json($res->content);
    foreach my $rh_course (@$ra_courses) {
        if ($rh_course->{shortname} eq $args{short_cname}) {
            return $rh_course->{id};
        }
    }

    ouch 'MSE-0002', 'failed to find course of name '.$args{short_cname};
}


# NOTE: suspend_user depends on the 'suspended' parameter
# https://tracker.moodle.org/browse/MDL-31465

sub suspend_user {
    my $self = shift;
    my %args = (
        username => undef,
        suspend  => 1, # suspend unless it is 0
        @_
    );

    my $mdl_user = $self->get_user( username => $args{username} );

    my $params = {
        'wstoken'                      => $self->token,
        'wsfunction'                   => "core_user_update_users",
        'moodlewsrestformat'           => $REST_FORMAT,
        'users[0][id]'                 => $mdl_user->{id},
        'users[0][suspended]'          => $args{suspend} + 0,
    };


    my $dns_uri = $self->dns_uri;
    $dns_uri->path('webservice/rest/server.php');
    $dns_uri->query_form( $params );

    $self->rest_call($dns_uri);

    return;
}


sub check_password  {
    my $self = shift;
    my %args = (
        username => undef,
        password => undef,
        @_
    );

    my $username = $args{username};
    my $password = $args{password};

    my $params = {
        'username'   => $args{username},
        'password'   => $args{password},
        'service'    => 'moodle_mobile_app',
    };


    my $dns_uri = $self->dns_uri;
    $dns_uri->path('login/token.php');
    $dns_uri->query_form( $params );

    my $res = $self->rest_call($dns_uri);

    my $content = $res->content;

    my $data;
    eval {
        $data = from_json($res->content);
    };
    if ($@){
        return {
            msg => "'$username' login failed",
            ok  => 0,
        };
    }

    if ( $data->{token} ) {
        return {
            msg => "'$username' has the correct password",
            ok  => 1,
        };
    }

    return {
        msg => "'$username' login failed, error code: ".$data->{errorcode},
        ok  => 0,
    };

}

1;

__END__