File Coverage

blib/lib/Net/OpenSRS/OMA.pm

Criterion	Covered	Total	%
statement	61	77	79.2
branch	10	20	50.0
condition	5	18	27.7
subroutine	10	18	55.5
pod	4	4	100.0
total	90	137	65.6

package Net::OpenSRS::OMA::Response;  # internal package, defined below
1;
package Net::OpenSRS::OMA;

use strict;
use warnings;
use JSON;
use LWP::UserAgent;
use Carp;

our $VERSION = "0.01_02";
$VERSION = eval $VERSION;

=head1 NAME

Net::OpenSRS::OMA - Client library for the OpenSRS Mail API

=head1 SYNOPSIS

  use Data::Dumper;
  use Net::OpenSRS::OMA;

  my $oma = new Net::OpenSRS::OMA(
    uri => 'https://admin.a.hostedemail.com/api',
    user => '[e-mail]',
    client => 'my client 0.1',
    password => 'abc123',
  );


  my $response = $oma->get_user(
    user => '[e-mail]'
  );

  if ($response->is_success)
  {
    print Dumper $response->content;
  }
  elsif ($response->error)
  {
    print "Request didn't work at OMA level: " . $response->error . "\n";
  }
  else
  {
    print "Request didn't work at HTTP level: " . $response->http_status;
  }

=head1 DEPENDENCIES

This module requires these modules.

=over

=item LWP::UserAgent

=item LWP::Protocol::https

=item JSON

=back

=head1 CAVEAT

This API is still under development and thus the
method calls, arguments and functions are subject to change.

Consult the API documentation for up to date information.

=head1 METHODS

=cut

=head2 new

Create and return a new Net::OpenSRS::OMA object.

Takes the following arguments (in a single hash argument)

  uri - base uri for the api: http://example.com/api/
  user - username  for authentication
  password - password for authentication
  token - token for authentication
  client - client identification string

uri, user and either password or token are required.

=cut

sub new($@)
{
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my %args = @_;
  my $self = {};
  unless ($args{uri} && $args{user} &&
      ($args{password} || $args{token} ))
  {
    warn('Need uri, user and password or token');
    return undef;
  }
  $self->{URI} = $args{uri};
  my $client = $args{client};
  $client = "Perl OMA Client\\$VERSION" unless $client;
  $self->{CREDENTIALS} = {
    user => $args{user},
    client => $client
  };

  if ($args{password}) {$self->{CREDENTIALS}->{password} = $args{password}}
  else { $self->{CREDENTIALS}->{token} = $args{token}}

  $self->{UA} = LWP::UserAgent->new;
  $self->{UA}->agent($client);

  return bless($self, $class);
}

=head2 uri

Get the API address this object is using

=head2 user

Get the username this object is using

=head2 client

Get the client identifier string this object is using

=cut

sub uri($){return $_[0]->{URI}};
sub user($){return $_[0]->{CREDENTIALS}->{user}}
sub client($){return $_[0]->{CREDENTIALS}->{client}}

=head2 API Methods

API methods are called as object methods.  All methods take a hash argument, that hash has
a credentials hashref added, is converted to JSON and sent to the API.  Method calls return a
Net::OpenSRS::OMA::Response object containing the response from the server.

Consult the API documentation for the arguments and response formats for each method.

The callable methods are:

=over

=item add_role

=item authenticate

=item change_company

=item change_company_bulletin

=item change_domain

=item change_domain_bulletin

=item change_user

=item change_brand

=item create_workgroup

=item delete_company

=item delete_domain

=item delete_user

=item delete_workgroup

=item echo

=item generate_token

=item get_company

=item get_company_bulletin

=item get_company_changes

=item get_deleted_contacts

=item get_deleted_messages

=item get_domain

=item get_domain_bulletin

=item get_domain_changes

=item get_user

=item get_user_attribute_history

=item get_user_changes

=item get_user_folders

=item get_user_messages

=item get_valid_languages

=item get_valid_timezones

=item logout_user

=item migration_add

=item migration_jobs

=item migration_status

=item migration_threads

=item migration_trace

=item move_user_messages

=item post_domain_bulletin

=item post_company_bulletin

=item remove_role

=item rename_user

=item restore_deleted_contacts

=item restore_deleted_messages

=item restore_domain

=item restore_user

=item search_brand_members

=item search_brands

=item search_companies

=item search_domains

=item search_users

=item search_workgroups

=item set_role

=item stats_summary

=item stats_list

=item stats_snapshot

=back

=cut

my @_methods = qw(
add_role
authenticate
change_company
change_company_bulletin
change_domain
change_domain_bulletin
change_user
change_brand
create_workgroup
delete_company
delete_domain
delete_user
delete_workgroup
echo
generate_token
get_company
get_company_bulletin
get_company_changes
get_deleted_contacts
get_deleted_messages
get_domain
get_domain_bulletin
get_domain_changes
get_user
get_user_attribute_history
get_user_changes
get_user_folders
get_user_messages
get_valid_languages
get_valid_timezones
logout_user
migration_add
migration_jobs
migration_status
migration_threads
migration_trace
move_user_messages
post_domain_bulletin
post_company_bulletin
remove_role
rename_user
restore_deleted_contacts
restore_deleted_messages
restore_domain
restore_user
search_brand_members
search_brands
search_companies
search_domains
search_users
search_workgroups
set_role
stats_summary
stats_list
stats_snapshot
);

my @_deprecated_methods = qw(
_audit
_change_brand
_delete_brand
_get_brand
_get_brand_changes
_get_brand_trace
_get_company_trace
_get_domain_trace
_get_user_trace
_id_to_name
_list_brand_traces
_list_company_traces
_list_domain_traces
_list_user_traces
_name_to_id
);

our $AUTOLOAD;
sub AUTOLOAD {
  return if our $AUTOLOAD =~ /::DESTROY$/;
  my $self = shift;
  my $sub = $AUTOLOAD;
  (my $method = $sub) =~ s/.*:://;
  unless (grep {$_ eq $method} (@_methods, @_deprecated_methods))
  {
    croak("Undefined method $AUTOLOAD");
  }
  my %body = @_;
  return $self->_do_method($method, \%body);
}


#
# don't call this
#
sub _do_method($$$)
{
  my ($self, $method, $body) = @_;
  my $muri = $self->{URI} . '/' . $method;

  # create request body (add credentials)
  my %body_copy = %$body;
  $body_copy{'credentials'} = $self->{'CREDENTIALS'};
  my $body_text = to_json(\%body_copy);

  # create request
  my $request = HTTP::Request->new(POST => $muri);
  $request->content_type('application/json');
  $request->content($body_text);

  #send request
  my $response = $self->{UA}->request($request);

  # deal with response
  if ($response->is_success)
  {
    my $j;
    eval {$j = from_json($response->content)};
    if ($@)
    {
      warn "Invalid JSON from API: -(" . $response->content . ")-";
      $j = '';
    }
    return new Net::OpenSRS::OMA::Response(
      status => $response->status_line,
      raw_content => $response->content,
      content => $j,
      );
  }
  else
  {
    return new Net::OpenSRS::OMA::Response(
      status => $response->status_line,
    );
  }
}


1;

package Net::OpenSRS::OMA::Response;


=head1 RESPONSE OBJECT METHODS

=cut

sub new($@)
{
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my %args = @_;
  my $self = {};
  $self->{CONTENT} = $args{content} if $args{content};
  $self->{RAW_CONTENT} = $args{raw_content} if $args{raw_content};
  $self->{HTTP_STATUS} = $args{status} if $args{status};
  return bless($self, $class);
}

=head2 is_success

Returns true if the HTTP status of the request was 200, the response had valid
JSON content, and the 'success' field of the response is true.

=cut
sub is_success($)
{
  my $self = shift;
  return
    $self->{HTTP_STATUS} =~ /^200/ &&
    $self->{CONTENT} &&
    $self->{CONTENT}->{success} ;
}

=head2 content

Returns a hashref, the decoded JSON content of the response, or undef if
there is no content.

=cut

sub content($) {return $_[0]->{CONTENT}};

=head2 raw_content

Returns a scalar, string, the raw response fromt he server, or undef if
there is no content

=cut

sub raw_content($) {return $_[0]->{RAW_CONTENT}};

=head2 http_status

Returns a scalar, the HTTP status of the request, from the LWP module.

=cut

sub http_status($) {return $_[0]->{HTTP_STATUS}};

=head2 error_number

Returns a scalar, the error number from the JSON content of the response,
or undef if no error number.

=cut

sub error_number($) {return $_[0]->{CONTENT}->{error_number}};

=head2 error

Returns a scalar, the error string from the JSON content of the response,
or undef if no error string.

=cut

sub error($) {return $_[0]->{CONTENT}->{error}};

1;

=head1 AUTHOR

Richard Platel

=head1 COPYRIGHT AND LICENSE

Copyright 2012 Richard Platel

This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.

=cut