GR::Extension::IPB xmlrpc interface

IPB.pm

# O2 extension for IP Board
# By Carsten Nielsen
#--------------------------------------------------------------------------------------------------
package GR::Extension::IPB;
#--------------------------------------------------------------------------------------------------
use base 'O2::Extension::Super';
#--------------------------------------------------------------------------------------------------
use strict;
use warnings;
use XMLRPC::Lite;
#--------------------------------------------------------------------------------------------------
# Fetching some stats about the forum.
sub fetchStats {
  my ($obj) = @_;
  
  $obj->{call} = 'fetchStats';
  
  return $obj->sendRequest();
}
#--------------------------------------------------------------------------------------------------
# Login an user. Requires user-id and ip-address. Returns array with cookies to set. 
sub loginUser {
  my ($obj, $id, $ip) = @_;
  
  $obj->{call} = "loginUser";
  
  $obj->setParams(
    id => $id,
    ip => $ip,
  );
  
  return $obj->send_request();
}
#--------------------------------------------------------------------------------------------------
# Logout an user. Requires user-id. Returns array with cookies to set.
sub logoutUser {
  my ($obj, $id, $ip) = @_;
  
  $obj->{call} = "logoutUser";
  
  $obj->setParams(
    id => $id,
  );
  
  return $obj->send_request();
}
#--------------------------------------------------------------------------------------------------
# Update user-data. Requires user-id and datas.
sub updateUser {
  my ($obj, $displayName, $email, $username, $password) = @_;
  
  $obj->{call} = "updateUser";
  
  die "Missing parameters" unless ($displayName && $email && $username && $password);
  
  $obj->setParams(
    display_name => $displayName,
    email        => $email,
    username     => $username,
    password     => $password,
  );
  
  return $obj->sendRequest();
}
#--------------------------------------------------------------------------------------------------
# Create user. Requires user-data. Returns new user as array.
sub createUser {
  my ($obj, $displayName, $email, $username, $password) = @_;
  
  $obj->{call} = "createUser";
  
  die "Missing parameters" unless ($displayName && $email && $username && $password);
  
  $obj->setParams(
    display_name => $displayName,
    email        => $email,
    username     => $username,
    password     => $password,
  );
  
  return $obj->sendRequest();
}
#--------------------------------------------------------------------------------------------------
# Delete a user. Requires user-id.
sub deleteUser {
  my ($obj, $id) = @_;
  
  $obj->{call} = "deleteUser";
  
  die "Missing parameters" unless ($id);
  
  $obj->setParams(
    id => $id,
  );
  
  return $obj->sendRequest();
}
#--------------------------------------------------------------------------------------------------
# Check if a username exists
sub usernameExists {
  my ($obj, $username) = @_;
  
  $obj->{call} = "checkMemberExists";
  
  $obj->setParams(
    search_type   => 'username',
    search_string => $username,
  );
  
  my $result = $obj->sendRequest();
  
  return ($result->{memberExists}) ? 1 : 0;
}
#--------------------------------------------------------------------------------------------------
# Check if an email-address exists
sub emailExists {
  my ($obj, $email) = @_;
  
  $obj->{call} = 'checkMemberExists';
  
  $obj->setParams(
    search_type   => 'email',
    search_string => $email,
  );
  
  my $result = $obj->sendRequest();
  
  return ($result->{memberExists}) ? 1 : 0;
}
#--------------------------------------------------------------------------------------------------
# Check for a user. Requires search_string and the search_type which can be id, email, username or displayname.
sub userExists {
  my ($obj, $search_string, $search_type) = @_;
  
  $obj->{call} = 'checkMemberExists';
  
  $obj->setParams(
    search_type   => $search_type,
    search_string => $search_string,
  );
  
  my $result = $obj->sendRequest();
  
  return ($result->{memberExists}) ? 1 : 0;
}
#--------------------------------------------------------------------------------------------------
# Fetch a user. Requires search_string and the search_type which can be id, email, username or displayname.
sub getUser {
  my ($obj, $search_string, $search_type) = @_;
  
  $obj->{call} = 'fetchMember';
  
  $obj->setParams(
    search_type   => $search_type,
    search_string => $search_string,
  );
  
  return $obj->sendRequest();
}
#--------------------------------------------------------------------------------------------------
# Get user-data by user-id.
sub getUserById {
  my ($obj, $id) = @_;
  
  $obj->{call} = 'fetchMember';
  
  $obj->setParams(
    search_type   => 'id',
    search_string => $id,
  );
  
  return $obj->sendRequest();
}
#--------------------------------------------------------------------------------------------------
# Get user-data by username.
sub getUserByUsername {
  my ($obj, $username) = @_;
  
  $obj->{call} = 'fetchMember';
  
  $obj->setParams(
    search_type   => 'username',
    search_string => $username,
  );
  
  return $obj->sendRequest();
}
#--------------------------------------------------------------------------------------------------
# Get user-data by email.
sub getUserByEmail {
  my ($obj, $email) = @_;
  
  $obj->{call} = 'fetchMember';
  
  $obj->setParams(
    search_type   => 'email',
    search_string => $email,
  );
  
  return $obj->sendRequest();
}
#--------------------------------------------------------------------------------------------------
sub getUsersOnline {
  my ($obj) = @_;
  
  $obj->{call} = 'fetchOnlineUsers';
  
  $obj->setParams(
    sep_character => ',',
  );
  
  my $result = $obj->sendRequest();
  
  return $result->{TOTAL};
}
#--------------------------------------------------------------------------------------------------
sub setParams {
  my ($obj, %params) = @_;
  
  foreach my $key (keys %params) {
    $obj->{params}{$key} = $params{$key};
  }
}
#--------------------------------------------------------------------------------------------------
sub sendRequest {
  my ($obj) = @_;
  
  my $params = {};
  
  $obj->{call} = $obj->{call} ? $obj->{call} : 'helloBoard';
  
  my $config = $obj->getContext()->getConfig()->get('IPB');
  
  if (scalar keys(%{ $obj->{params} })) {
    while (my ($name, $value) = each( %{ $obj->{params} })) {
      $params->{$name} = $value;
    }
  }
  
  $params->{api_key}    = $config->{apikey};
  $params->{api_module} = $config->{module};
  
  my $result = XMLRPC::Lite
    -> proxy($config->{host}.$config->{path})
    -> call($obj->{call}, $params)
    -> result();
  
  return $result;
}
#--------------------------------------------------------------------------------------------------
sub getContext {
  my ($obj) = @_;
  
  return $obj->{context} if $obj->{context};
  
  require O2::Context;
  return $obj->{context} = O2::Context->new();
}
#--------------------------------------------------------------------------------------------------
1;