path: root/FS/FS/part_export/magicmail.pm

package FS::part_export::magicmail;

use strict;

use base qw( FS::part_export );

use Data::Dumper;
use MIME::Base64;

use Net::HTTPS::Any qw( https_get https_post );
use XML::Simple;
use URI::Escape;

use FS::Record qw (qsearch);

use vars qw( $DEBUG );
$DEBUG = 0;

=pod

=head1 NAME

FS::part_export::magicmail

=head1 SYNOPSIS

MagicMail integration for Freeside

=head1 REQUIRES

L<Net::HTTPS::Any>

L<XML::Simple>

L<URI::Escape>

=head1 DESCRIPTION

This export offers basic svc_acct provisioning for MagicMail.  Each customer will
map to an account in MagicMail, and each svc_acct exported will map to a user/mailbox.

This module also provides generic methods for working through the MagicMail API, and can
be used as a base for more complex exports to MagicMail (just be sure to override
the C<%info> hash and the L</Hook Methods>.)

L</Hook Methods> return an error message on failure, and a blank string on success.
All other methods return a positive value (usually a hashref) on success and return
nothing on failure, instead setting the error message in the export object using 
L</Error Methods>.  Use L</error> to retrieve this message.

=cut

use vars qw( %info );

tie my %options, 'Tie::IxHash',
  'client_id'        => { label => 'API Client ID',
                          default => '' },
  'client_password'  => { label => 'API Client Password',
                          default => '' },
  'account_prefix'   => { label => 'Account Prefix',
                          default => 'FREESIDE' },
  'package'          => { label => 'Package',
                          default => 'EMAIL' },
  'port'             => { label => 'Port',
                          default => 443 },
  'autopurge'        => { type => 'checkbox',
                          label => 'Auto purge user/account on unprovision' },
  'use_agent_custid' => { type => 'checkbox',
                          label => 'Use agent_custid for Magicmail account_id when available' },
  'debug'            => { type => 'checkbox',
                          label => 'Enable debug warnings' },
;

%info = (
  'svc'             => 'svc_acct',
  'desc'            => 'Export service to MagicMail, for svc_acct services',
  'options'         => \%options,
  'notes'           => <<'END',
Add service user and email address to MagicMail<BR>
See <A HREF="http://www.freeside.biz/mediawiki/index.php/Freeside:4:Documentation:MagicMail">documentation</A> for details.
END
);

=head1 Hook Methods

=cut

=head2 _export_insert

Hook that is called when service is initially provisioned.
To avoid confusion, don't use for anything else.

For this export, creates a MagicMail account for this customer
if it doesn't exist, activates account if it is suspended/deleted,
creates a user/mailbox on that account for the provisioning service, 
assigns I<package> (specified by export option) to master user on 
account if it hasn't been, and adds the email address for the 
provisioning service.  On error, attempts to purge any newly 
created account/user and remove any newly set package via L</rollback>.

On success, also runs L</sync_magic_packages> (does not cause fatal
error on failure.)

Override this method when using this module as a base for other exports.

=cut

sub _export_insert {
  my ($self, $svc_acct) = @_;
  $self->error_init;
  my $cust_main = $svc_acct->cust_main;
  my $username = $svc_acct->username;
  my $r = {}; #rollback input

  # create customer account if it doesn't exist
  my $newacct = 0;
  my $account_id = $self->cust_account_id($cust_main);
  my $account = $self->get_account($account_id);
  return $self->error if $self->error;
  unless ($account) {
    $account = $self->add_account($account_id,
      'first_name' => $cust_main->first,
      'last_name'  => $cust_main->last,
      # could also add phone & memo
    );
    return $self->error if $self->error;
    $account_id = $account->{'id'};
    $$r{'purge_account'} = $account_id;
  }

  # activate account if suspended/deleted
  my $oldstatus = $account->{'status'};
  unless ($oldstatus eq 'active') {
    $account = $self->activate_account($account_id);
  }
  return $self->rollback($r) if $self->error;
  $$r{'delete_account'} = $account_id
    if $oldstatus eq 'deleted';
  $$r{'suspend_account'} = $account_id
    if $oldstatus eq 'suspended';

  # check for a master user, assign package if found
  my $package = $self->option('package');
  my $muser = $self->get_master_user($account_id);
  return $self->rollback($r) if $self->error;
  if ($muser) {
    my $musername = $muser->{'id'};
    my $packages = $self->get_packages($musername);
    return $self->rollback($r) if $self->error || !$packages;
    unless ($packages->{$package}) {
      $packages = $self->assign_package($musername,$package);
      return $self->rollback($r) if $self->error || !$packages || !$packages->{$package};
      $$r{'remove_package'} = [$musername,$package];
    }
  }

  # add user
  my ($first,$last) = $svc_acct->finger =~ /(.*)\s(.*)/;
  $first ||= $svc_acct->finger || '';
  $last  ||= '';
  my $user = $self->add_user($account_id,$username,
    'first_name'    => $first,
    'last_name'     => $last,
    'password'      => $svc_acct->_password_encryption eq 'plain'
                       ? $svc_acct->get_cleartext_password
                       : $svc_acct->_password,
    'password_type' => $svc_acct->_password_encryption eq 'plain'
                       ? 'plain'
                       : 'encrypted',
    # could also add memo
  );
  return $self->rollback($r) if $self->error;
  $$r{'purge_user'} = $username;

  # assign package if it hasn't been yet
  unless ($muser) {
    die "Unexpected lack of master user on account, please contact a developer"
      unless $user->{'master_user'} eq 'Y';
    $muser = $user;
    # slight false laziness with above
    my $musername = $muser->{'id'};
    my $packages = $self->get_packages($musername);
    return $self->rollback($r) if $self->error || !$packages;
    unless ($packages->{$package}) {
      $packages = $self->assign_package($musername,$package);
      return $self->rollback($r) if $self->error || !$packages || !$packages->{$package};
      $$r{'remove_package'} = [$musername,$package];
    }
  }

  # add email address
  $self->add_email_address($username,$username.'@'.$svc_acct->domain);
  return $self->rollback($r) if $self->error;

  # double-check packages (only throws warnings, no rollback on fail)
  $self->sync_magic_packages($cust_main, 'include' => $svc_acct);

  return '';
}

=head2 _export_delete

Hook that is called when service is unprovisioned.
To avoid confusion, don't use for anything else.

For this export, deletes the email address and user
associated with the provisioning service.  Only sets
an error if this part fails;  everything else simply
generates warnings.

Also attempts to delete the associated account, if there 
aren't any more users on the account.

If deleted user was master user for account and other 
users exist on the account, attempts to make another user 
the master user.

Runs L</sync_magic_packages>.

If the I<autopurge> export option is set, also purges 
newly deleted users/accounts.

Override this method when using this module as a base for other exports.

=cut

sub _export_delete {
  my ($self, $svc_acct) = @_;
  $self->error_init;
  my $cust_main = $svc_acct->cust_main;
  my $username = $svc_acct->username;

  # check account id
  my $user = $self->get_user($username);
  unless ($user) {
    $self->error("Could not remove user from magicmail, username $username not retrievable");
    $self->error_warn;
    return ''; #non-fatal error, allow svc to be unprovisioned
  }
  my $account_id = $user->{'account'};
  return $self->error("Could not remove user from magicmail, account id does not match")
    unless $account_id eq $self->cust_account_id($cust_main); #fatal, sort out before unprovisioning
  
  # check for master change
  my $newmaster;
  if ($user->{'master_user'}) {
    my $users = $self->get_users($account_id);
    if ($users && (keys %$users > 1)) {
      foreach my $somesvc (
        sort { $a->svcnum <=> $b->svcnum } # cheap way of ordering by provision date
          $self->cust_magic_services($cust_main,'ignore'=>$svc_acct)
      ) {
        next unless $users->{uc($somesvc->username)};
        $newmaster = $somesvc->username;
        last;
      }
      $self->error("Cannot find replacement master user for account $account_id")
        unless $newmaster;
    }
    $self->error_warn; #maybe this should be fatal?
  }

  # do the actual deleting
  $self->delete_user($username);
  return $self->error if $self->error;

  ## no fatal errors after this point

  # transfer master user
  $self->make_master_user($newmaster) if $newmaster;
  $self->error_warn;
  $self->sync_magic_packages($cust_main, 'ignore' => $svc_acct);

  # purge user if configured to do so
  $self->purge_user($username) if $self->option('autopurge');
  $self->error_warn;

  # delete account if there are no more users
  my $users = $self->get_users($account_id);
  $self->error_warn;
  return '' unless $users;
  return '' if keys %$users;
  $self->delete_account($account_id);
  return $self->error_warn if $self->error;

  #purge account if configured to do so
  $self->purge_account($account_id) if $self->option('autopurge');
  return $self->error_warn;
}

=head2 _export_replace

Hook that is called when provisioned service is edited.
To avoid confusion, don't use for anything else.

Updates user info & password.  Cannot be used to change user name.

Override this method when using this module as a base for other exports.

=cut

sub _export_replace {
  my($self, $new, $old) = @_;
  $self->error_init;
  my $username = $new->username;

  return "Cannot change username on a magicmail account"
    unless $username eq $old->username;

  # check account id
  my $user = $self->get_user($username);
  return $self->error("Could not update user, username $username not retrievable")
    unless $user;
  my $account_id = $user->{'account'};
  return $self->error("Could not update user $username, account id does not match")
    unless $account_id eq $self->cust_account_id($new); #fatal, sort out before updating

  # update user
  my ($first,$last) = $new->finger =~ /(.*)\s(.*)/;
  $first ||= $new->finger || '';
  $last  ||= '';
  $user = $self->update_user($account_id,$username,
    'first_name'    => $first,
    'last_name'     => $last,
    'password'      => $new->_password_encryption eq 'plain'
                       ? $new->get_cleartext_password
                       : $new->_password,
    'password_type' => $new->_password_encryption eq 'plain'
                       ? 'plain'
                       : 'encrypted',
    # could also add memo
  );
  return $self->error;
}

=head2 _export_suspend

Hook that is called when service is suspended.
To avoid confusion, don't use for anything else.

=cut

sub _export_suspend {
  my ($self, $svc_acct) = @_;
  $self->error_init;
  my $username = $svc_acct->username;

  # check account id
  my $user = $self->get_user($username);
  return $self->error("Could not update user, username $username not retrievable")
    unless $user;
  my $account_id = $user->{'account'};
  return $self->error("Could not update user $username, account id does not match")
    unless $account_id eq $self->cust_account_id($svc_acct); #fatal, sort out before updating

  #suspend user
  $self->suspend_user($username);
  return $self->error;
}

=head2 _export_unsuspend

Hook that is called when service is unsuspended.
To avoid confusion, don't use for anything else.

=cut

sub _export_unsuspend {
  my ($self, $svc_acct) = @_;
  $self->error_init;
  my $username = $svc_acct->username;

  # check account id
  my $user = $self->get_user($username);
  return $self->error("Could not update user, username $username not retrievable")
    unless $user;
  my $account_id = $user->{'account'};
  return $self->error("Could not update user $username, account id does not match")
    unless $account_id eq $self->cust_account_id($svc_acct); #fatal, sort out before updating

  #suspend user
  $self->activate_user($username);
  return $self->error;
}

=head1 Freeside Methods

These methods are specific to freeside, used to translate 
freeside customers/services/exports
into magicmail accounts/users/packages.

=head2 cust_account_id

Accepts either I<$cust_main> or I<$svc_acct>.
Returns MagicMail account_id for this customer under this export.

=cut

sub cust_account_id {
  my ($self, $in) = @_;
  my $cust_main = ref($in) eq 'FS::cust_main' ? $in : $in->cust_main;
  return $self->option('account_prefix').
         ( ($self->option('use_agent_custid') && $cust_main->agent_custid)
             ? $cust_main->agent_custid
             : $cust_main->custnum
         );
}

=head2 cust_magic_services

Accepts I<$cust_main> or I<$svc_acct> and the following options:

I<ignore> - I<$svc_acct> to be ignored

I<include> - I<$svc_acct> to be included

Returns a list services owned by the customer
that are provisioned in MagicMail with the same I<account_prefix>
(not necessarily the same export.)

I<include> is not checked for compatability with the current 
export.  It will probably cause errors if you pass a service
that doesn't use the current export.

=cut

sub cust_magic_services {
  my ($self, $in, %opt) = @_;
  my $cust_main = ref($in) eq 'FS::cust_main' ? $in : $in->cust_main;
  my @out = 
    grep {
      $opt{'ignore'} ? ($_->svcnum != $opt{'ignore'}->svcnum) : 1;
    }
    map {
      qsearch('svc_acct', { 'svcnum' => $_->svcnum })
    }
    grep {
      grep {
        ($_->exporttype eq 'magicmail')
          && ($_->option('account_prefix') eq $self->option('account_prefix'))
      }
      map {
        qsearch('part_export',{ 'exportnum' => $_->exportnum })
      }
      qsearch('export_svc',{ 'svcpart' => $_->svcpart }) 
    }
    qsearch({
      'table' => 'cust_svc',
      'addl_from' => 'INNER JOIN cust_pkg ON (cust_svc.pkgnum = cust_pkg.pkgnum)',
      'hashref' => { 'cust_pkg.custnum' => $cust_main->custnum }
    }); #end of @out =
  push(@out,$opt{'include'})
    unless grep { $opt{'include'} ? ($_->svcnum == $opt{'include'}->svcnum) : 1 } @out;
  return @out;
}

=head2 cust_magic_packages

Accepts I<$cust_main> or I<$svc_acct> and the same options as L</cust_magic_services>.

Returns list of MagicMail packages for this customer's L</cust_magic_services>
(ie packages that the master user for this customer should have assigned to it.)

=cut

sub cust_magic_packages {
  my ($self, $in, %opt) = @_;
  my $out = {};
  my @svcs = $self->cust_magic_services($in);
  foreach my $svc ($self->cust_magic_services($in,%opt)) {
    # there really should only be one export per service, but loop just in case
    foreach my $export ( $svc->cust_svc->part_svc->part_export('magicmail') ) {
      $out->{$export->option('package')} = 1;
    }
  }
  return keys %$out;
}

=head2 sync_magic_packages

Accepts I<$cust_main> or I<$svc_acct> and the same options as L</cust_magic_services>.

Assigns or removes packages from the master user of L</cust_account_id> so
that they match L</cust_magic_packages>.  (Will only attempt to remove 
non-matching packages if matching packages are all successfully assigned.)

All errors will be immediately cleared by L</error_warn>.
No meaningful return value.

=cut

sub sync_magic_packages {
  my ($self, $in, %opt) = @_;
  my $cust_main = ref($in) eq 'FS::cust_main' ? $in : $in->cust_main;
  my $account_id = $self->cust_account_id($cust_main);
  my $muser = $self->get_master_user($account_id);
  return $self->error_warn if $self->error;
  return $self->error_warn("Could not find master user for account $account_id")
    unless $muser && $muser->{'id'};
  my $musername = $muser->{'id'};
  my $have = $self->get_packages($musername);
  return $self->error_warn if $self->error;
  my %dont = map { $_ => 1 } keys %$have;
  foreach my $want ($self->cust_magic_packages($cust_main,%opt)) {
    delete $dont{$want};
    $self->assign_package($musername,$want)
      unless $have->{$want};
  }
  return $self->error_warn if $self->error;
  foreach my $dont (keys %dont) {
    $self->remove_package($musername,$dont)
  }
  return $self->error_warn;
}

=head1 Helper Methods

These methods combine account, user and package information
through multiple API requests.

=head2 get_accounts_and_users

Returns results of L</get_accounts> with extra 'users' key for
each account, the value of which is the result of L</get_users>
for that account.

=cut

sub get_accounts_and_users {
  my ($self) = @_;
  my $accounts = $self->get_accounts() or return;
  foreach my $account (keys %$accounts) {
    $accounts->{$account}->{'users'} = $self->get_users($account) or return;
  }
  return $accounts;
}

=head2 get_master_user

Accepts I<$account_id>.  Returns hashref of details on master user
for that account (as would be returned by L</get_user>.)
Returns nothing without setting error if master user is not found.

=cut

sub get_master_user {
  my ($self,$account_id) = @_;
  my $users = $self->get_users($account_id);
  return if $self->error || !$users;
  foreach my $username (keys %$users) {
    if ($users->{$username}->{'master_user'} eq 'Y') {
      $users->{$username}->{'id'} = $username;
      return $users->{$username};
    }
  }
  return;
}

=head2 request

	#send a request to https://machine/api/v2/some/function
	my $result = $export->request('POST','/some/function',%args);

Accepts I<$method>, I<$path> and optional I<%args>.  Sends request
to server and returns server response as a hashref (converted from
XML by L<XML::Simple>.)  I<%args> can include a ForceArray key that 
will be passed to L<XML::Simple/XMLin>;  all other args will be
passed in the reqest.  Do not include 'client_type' in I<%args>,
and do not include '/api/v2' in I<$path>.

Used by other methods to send requests;  unless you're editing
this module, you should probably be using those other methods instead.

=cut

sub request {
  my ($self,$method,$path,%args) = @_;
  local $Data::Dumper::Terse = 1;
  unless (grep(/^$method$/,('GET','POST'))) {
    return if $self->error("Can't request method $method");
  }
  my $get = $method eq 'GET';
  my $forcearray = [];
  if (exists $args{'ForceArray'}) {
    $forcearray = delete $args{'ForceArray'};
  }
  $args{'client_type'} = 'FREESIDE';
  my %request = (
    'host'    => $self->machine,
    'port'    => $self->option('port'),
    'path'    => '/api/v2' . $path,
    'headers' => { 
      'Authorization' => 'Basic ' . MIME::Base64::encode(
                                      $self->option('client_id') 
                                      . ':' 
                                      . $self->option('client_password'),
                                    ''),
    },
  );
  my ( $page, $response, %reply_headers );
  if ($get) {
    my $pathargs = '';
    foreach my $field (keys %args) {
      $pathargs .= $pathargs ? '&' : '?';
      $pathargs .= $field . '=' . uri_escape_utf8($args{$field});
    }
    $request{'path'} .= $pathargs;
    warn "Request = " . Dumper(\%request) if $self->debug;
    ( $page, $response, %reply_headers ) = https_get(%request);
  } else {
    foreach my $field (keys %args) {
      $request{'content'} .= '&' if $request{'content'};
      $request{'content'} .= $field . '=' . uri_escape_utf8($args{$field});
    }
    warn "Request = " . Dumper(\%request) if $self->debug;
    ( $page, $response, %reply_headers ) = https_post(%request);
  }
  unless ($response =~ /^(200|400|500)/) {
    return if $self->error("Bad Response: $response");
  }
  warn "Response = " . Dumper($page) if $self->debug;
  my $result = $page ? XMLin($page, ForceArray => $forcearray) : {};
  warn "Result = " . Dumper($result) if $self->debug;
  return $result;
}

=head1 Account Methods

Make individual account-related API requests.

=head2 add_account

Accepts I<$account_id> and the following options:

I<first_name>

I<last_name>

I<phone>

I<memo>

Returns a hashref containing the created account details.

=cut

sub add_account {
  my ($self,$id,%opt) = @_;
  warn "CREATING ACCOUNT $id\n" if $self->debug;
  my %args;
  foreach my $field ( qw( first_name last_name phone memo ) ) {
    $args{$field} = $opt{$field} if $opt{$field};
  }
  my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), %args );
  return if $self->check_for_error($result);
  return $result->{'account'};
}

=head2 get_account

Accepts I<$account_id>.
Returns a hashref containing account details.  
Returns nothing without setting error if account is not found.

=cut

sub get_account {
  my ($self,$id) = @_;
  warn "GETTING ACCOUNT $id\n" if $self->debug;
  my $result = $self->request('GET','/account/'.uri_escape_utf8($id));
  if ($result->{'error'}) {
    return if $result->{'error'}->{'code'} eq 'account.error.not_found';
  }
  return if $self->check_for_error($result);
  return $result->{'account'};
}

=head2 get_accounts

No input.  Returns a hashref, keys are account_id, values
are hashrefs of account details.

=cut

sub get_accounts {
  my ($self) = @_;
  warn "GETTING ALL ACCOUNTS\n" if $self->debug;
  my $result = $self->request('GET','/account','ForceArray' => ['account']);
  return if $self->check_for_error($result);
  return $result->{'accounts'}->{'account'} || {};
}

=head2 update_account

Accepts I<$account_id> and the same options as L</add_account>.
Updates an existing account.
Returns a hashref containing the updated account details.

=cut

sub update_account {
  my ($self,$id,%opt) = @_;
  warn "UPDATING ACCOUNT $id\n" if $self->debug;
  my %args;
  foreach my $field ( qw( first_name last_name phone memo ) ) {
    $args{$field} = $opt{$field} if $opt{$field};
  }
  my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), %args, action => 'update' );
  return if $self->check_for_error($result);
  return $result->{'account'};
}

=head2 suspend_account

Accepts I<$account_id>.  Sets account status to suspended.
Returns a hashref containing the updated account details.

=cut

sub suspend_account {
  my ($self,$id) = @_;
  warn "SUSPENDING ACCOUNT $id\n" if $self->debug;
  my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), status => 'suspended', action => 'update' );
  return if $self->check_for_error($result);
  return $result->{'account'};
}

=head2 activate_account

Accepts I<$account_id>.  Sets account status to active.
Returns a hashref containing the updated account details.

=cut

sub activate_account {
  my ($self,$id) = @_;
  warn "ACTIVATING ACCOUNT $id\n" if $self->debug;
  my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), status => 'active', action => 'update' );
  return if $self->check_for_error($result);
  return $result->{'account'};
}

=head2 delete_account

Accepts I<$account_id>.  Sets account status to deleted.
Returns a hashref containing the updated account details.

=cut

sub delete_account {
  my ($self,$id) = @_;
  warn "DELETING ACCOUNT $id\n" if $self->debug;
  my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), status => 'deleted', action => 'update' );
  return if $self->check_for_error($result);
  return $result->{'account'};
}

=head2 purge_account

Accepts account I<$id> and the following options:

I<force> - if true, purges account even if it wasn't first deleted

Purges account from system.
No meaningful return value.

=cut

sub purge_account {
  my ($self,$id,%opt) = @_;
  my %args;
  $args{'force'} = 'true' if $opt{'force'};
  warn "PURGING ACCOUNT $id\n" if $self->debug;
  my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), %args, action => 'purge' );
  $self->check_for_error($result);
  return;
}

=head1 User Methods

Make individual user-related API requests.

=head2 add_user

Accepts I<$account_id>, I<$username> and the following options:

I<first_name>

I<last_name>

I<memo>

I<password>

I<password_type> - plain or encrypted

Returns a hashref containing the created user details.

=cut

sub add_user {
  my ($self,$account_id,$username,%opt) = @_;
  warn "CREATING USER $username FOR ACCOUNT $account_id\n" if $self->debug;
  my %args;
  foreach my $field ( qw( first_name last_name memo password password_type ) ) {
    $args{$field} = $opt{$field} if $opt{$field};
  }
  $args{'account'} = $account_id;
  unless ($account_id) {
    return if $self->error("Account ID required");
  }
  if ($args{'password_type'} && !grep(/$args{'password_type'}/,('plain','encrypted'))) {
    return if $self->error("Illegal password_type $args{'password_type'}");
  }
  my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), %args );
  return if $self->check_for_error($result);
  return $result->{'user'};
}

=head2 get_user

Accepts I<$username>.
Returns a hashref containing user details.  
Returns nothing without setting error if user is not found.

=cut

sub get_user {
  my ($self,$username) = @_;
  warn "GETTING USER $username\n" if $self->debug;
  my $result = $self->request('GET','/user/'.uri_escape_utf8($username));
  if ($result->{'error'}) {
    return if $result->{'error'}->{'code'} eq 'account.error.not_found';
  }
  return if $self->check_for_error($result);
  return $result->{'user'};
}

=head2 get_users

Accepts I<$account_id>.  Returns a hashref, keys are username, values
are hashrefs of user details.

=cut

sub get_users {
  my ($self,$account_id) = @_;
  warn "GETTING ALL USERS FOR ACCOUNT $account_id\n" if $self->debug;
  my $result = $self->request('GET','/user','ForceArray' => ['user'],'account' => $account_id);
  return if $self->check_for_error($result);
  return $result->{'users'}->{'user'} || {};
}

=head2 update_user

Accepts I<$account_id>, I<$username> and the same options as L</add_user>.
Updates an existing user.
Returns a hashref containing the updated user details.

=cut

sub update_user {
  my ($self,$account_id,$username,%opt) = @_;
  warn "UPDATING USER $username\n" if $self->debug;
  my %args;
  foreach my $field ( qw( first_name last_name memo password password_type ) ) {
    $args{$field} = $opt{$field} if $opt{$field};
  }
  if ($args{'password_type'} && !grep(/$args{'password_type'}/,('plain','encrypted'))) {
    return if $self->error("Illegal password_type $args{'password_type'}");
  }
  $args{'account'} = $account_id;
  my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), %args, action => 'update' );
  return if $self->check_for_error($result);
  return $result->{'user'};
}

=head2 make_master_user

Accepts I<$username>.  Sets user to be master user for account.
Returns a hashref containing the updated user details.

Caution: does not unmake existing master user.

=cut

sub make_master_user {
  my ($self,$username) = @_;
  warn "MAKING MASTER USER $username\n" if $self->debug;
  my $result = $self->request('POST', '/user/'.uri_escape_utf8($username),
    master_user => 'Y',
    action => 'update'
  );
  return if $self->check_for_error($result);
  return $result->{'user'};
}

=head2 suspend_user

Accepts I<$username>.  Sets user status to suspended.
Returns a hashref containing the updated user details.

=cut

sub suspend_user {
  my ($self,$username) = @_;
  warn "SUSPENDING USER $username\n" if $self->debug;
  my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), status => 'suspended', action => 'update' );
  return if $self->check_for_error($result);
  return $result->{'user'};
}

=head2 activate_user

Accepts I<$username>.  Sets user status to active.
Returns a hashref containing the updated user details.

=cut

sub activate_user {
  my ($self,$username) = @_;
  warn "ACTIVATING USER $username\n" if $self->debug;
  my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), status => 'active', action => 'update' );
  return if $self->check_for_error($result);
  return $result->{'user'};
}

=head2 delete_user

Accepts I<$username>.  Sets user status to deleted.
Returns a hashref containing the updated user details.

=cut

sub delete_user {
  my ($self,$username) = @_;
  warn "DELETING USER $username\n" if $self->debug;
  my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), status => 'deleted', action => 'update' );
  return if $self->check_for_error($result);
  return $result->{'user'};
}

=head2 purge_user

Accepts I<$username> and the following options:

I<force> - if true, purges user even if it wasn't first deleted

Purges user from system.
No meaningful return value.

=cut

sub purge_user {
  my ($self,$username,%opt) = @_;
  my %args;
  $args{'force'} = 'true' if $opt{'force'};
  warn "PURGING USER $username\n" if $self->debug;
  my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), %args, action => 'purge' );
  $self->check_for_error($result);
  return;
}

=head1 Package Methods

Make individual package-related API requests.

=head2 assign_package

Accepts I<$username> and I<$package>.  Assigns package to user.
Returns a hashref of packages assigned to this user, keys are package names
and values are hashrefs of details about those packages.  
Returns undef if none are found.

=cut

sub assign_package {
  my ($self,$username,$package) = @_;
  warn "ASSIGNING PACKAGE $package TO USER $username\n" if $self->debug;
  my $result = $self->request('POST', '/user_package/'.uri_escape_utf8($username), 
    'ForceArray' => ['package'], 
    'package' => $package,
  );
  return if $self->check_for_error($result);
  return $result->{'packages'}->{'package'};
}

=head2 get_packages

Accepts I<$username>.
Returns a hashref of packages assigned to this user, keys are package names
and values are hashrefs of details about those packages.

=cut

sub get_packages {
  my ($self,$username) = @_;
  warn "GETTING PACKAGES ASSIGNED TO USER $username\n" if $self->debug;
  my $result = $self->request('GET', '/user_package/'.uri_escape_utf8($username), 
    'ForceArray' => ['package'], 
  );
  return if $self->check_for_error($result);
  return $result->{'packages'}->{'package'} || {};
}

=head2 remove_package

Accepts I<$username> and I<$package>.  Removes package from user.
No meaningful return value.

=cut

sub remove_package {
  my ($self,$username,$package) = @_;
  warn "REMOVING PACKAGE $package FROM USER $username\n" if $self->debug;
  my $result = $self->request('POST', '/user_package/'.uri_escape_utf8($username),
    'package' => $package,
	'action' => 'purge'
  );
  $self->check_for_error($result);
  return;
}

=head1 Domain Methods

Make individual account-related API requests.

=cut

### DOMAIN METHODS HAVEN'T BEEN THOROUGLY TESTED, AREN'T CURRENTLY USED ###

=head2 add_domain

Accepts I<$account_id> and I<$domain>.  Creates domain for that account.

=cut

sub add_domain {
  my ($self,$account_id,$domain) = @_;
  warn "CREATING DOMAIN $domain FOR ACCOUNT $account_id\n" if $self->debug;
  my $result = $self->request('POST','/domain/'.uri_escape_utf8($domain), 'account' => $account_id);
  return if $self->check_for_error($result);
  return $result->{'domain'};
}

=head2 get_domain

Accepts I<$domain>.  Returns hasref of domain info if it exists,
or empty if it doesn't exist or permission denied.
Returns nothing without setting error if domain is not found.

=cut

sub get_domain {
  my ($self, $domain) = @_;
  warn "GETTING DOMAIN $domain\n" if $self->debug;
  my $result = $self->request('GET','/domain/'.uri_escape_utf8($domain));
  if ($result->{'error'}) {
    #unfortunately, no difference between 'does not exist' and true 'permission denied'
    return if $result->{'error'}->{'code'} eq 'error.permission_denied';
  }
  return if $self->check_for_error($result);
  return $result->{'domain'};
}

=head2 get_domains

Accepts I<$account_id>.  Returns hasref of domains for that account,
keys are domains, values are hashrefs of info about each domain.

=cut

sub get_domains {
  my ($self, $account_id) = @_;
  warn "GETTING DOMAINS FOR ACCOUNT $account_id\n" if $self->debug;
  my $result = $self->request('GET','/domain',
    'ForceArray' => ['domain'], 
    'account' => $account_id
  );
  return if $self->check_for_error($result);
  return $result->{'domains'}->{'domain'} || {};
}

=head2 remove_domain

Accepts I<$domain>.  Removes domain.
No meaningful return value.

=cut

sub remove_domain {
  my ($self,$domain) = @_;
  warn "REMOVING DOMAIN $domain\n" if $self->debug;
  my $result = $self->request('POST', '/domain/'.uri_escape_utf8($domain), action => 'purge');
  $self->check_for_error($result);
  return;
}

=head1 Email Address Methods

Make individual emailaddress-related API requests.

=head2 add_email_address

Accepts I<$username> and I<$address>.  Adds address for that user.
Returns hashref of details for new address.

=cut

sub add_email_address {
  my ($self, $username, $address) = @_;
  warn "ADDING ADDRESS $address FOR USER $username\n" if $self->debug;
  my $result = $self->request('POST','/emailaddress/'.uri_escape_utf8($address),
    'user' => $username
  );
  return if $self->check_for_error($result);
  return $result->{'emailaddress'};
}

=head2 get_email_address

Accepts I<$address>.  Returns hasref of address info if it exists,
or empty if it doesn't exist or permission denied.
Returns nothing without setting error if address is not found.

=cut

sub get_email_address {
  my ($self, $address) = @_;
  warn "GETTING ADDRESS $address\n" if $self->debug;
  my $result = $self->request('GET','/emailaddress/'.uri_escape_utf8($address));
  if ($result->{'error'}) {
    #unfortunately, no difference between 'does not exist' and true 'permission denied'
    return if $result->{'error'}->{'code'} eq 'error.permission_denied';
  }
  return if $self->check_for_error($result);
  return $result->{'emailaddress'};
}

=head2 get_email_addresses

Accepts I<$username>.  Returns hasref of email addresses for that account,
keys are domains, values are hashrefs of info about each domain.

=cut

sub get_email_addresses {
  my ($self, $username) = @_;
  warn "GETTING ADDRESSES FOR USER $username\n" if $self->debug;
  my $result = $self->request('GET','/emailaddress',
    'ForceArray' => ['emailaddress'], 
    'user' => $username,
  );
  return if $self->check_for_error($result);
  return $result->{'emailaddresses'}->{'emailaddress'} || {};
}

=head2 remove_email_address

Accepts I<$address>.  Removes address.
No meaningful return value.

=cut

sub remove_email_address {
  my ($self,$address) = @_;
  warn "REMOVING ADDRESS $address\n" if $self->debug;
  my $result = $self->request('POST', '/emailaddress/'.uri_escape_utf8($address), action => 'purge');
  $self->check_for_error($result);
  return;
}

=head1 Error Methods

Used to track errors during a request, for precision control over when
and how those errors are returned.

=head2 error

Accepts optional I<$message>, which will be appended to the internal error message on this
object if defined (use L</init_error> to clear the message.)  Returns current contents of 
internal error message on this object.

=cut

sub error {
  my ($self,$message) = @_;
  if (defined($message)) {
    $self->{'_error'} .= "\n" if $self->{'_error'};
    $self->{'_error'} .= $message;
  }
  return $self->{'_error'};
}

=head2 check_for_error

Accepts I<$result> returned by L</request>.  Sets error if I<$result>
does not exist or contains an error message.  Returns L</error>.

=cut

sub check_for_error {
  my ($self,$result) = @_;
  return $self->error("Unknown error, no result found")
    unless $result;
  return $self->error($result->{'error'}->{'code'} . ': ' . $result->{'error'}->{'message'})
    if $result->{'error'};
  return $self->error;
}

=head2 error_init

Resets error message in object to blank string.
Should only be used at the start of L</Hook Methods>.
No meaningful return value.

=cut

sub error_init {
  my ($self) = @_;
  $self->{'_error'} = '';
  return;
}

=head2 error_warn

Accepts optional I<$message>, which will be appended to the internal error message on this
object if defined.

Outputs L</error> (if there is one) using warn, then runs L</error_init>.
Returns blank string.

=cut

sub error_warn {
  my $self = shift;
  my $message = shift;
  $self->error($message) if defined($message);
  warn $self->error if $self->error;
  $self->error_init;
  return '';
}

=head2 debug

Returns true if debug is set, either as an export option or in the module code.

=cut

sub debug {
  my $self = shift;
  return $DEBUG || $self->option('debug');
}

=head2 rollback

Accepts hashref with the following fields, use for undoing recent changes:

I<remove_package> - arrayref of username and package to remove

I<purge_user> - username to be forcefully purged

I<suspend_account> - account_id to be suspended

I<delete_account> - account_id to be deleted

I<purge_account> - account_id to be forcefully purged

Indicated actions will be performed in the order listed above.
Sets generic error message if no message is found, and returns L</error>.

=cut

sub rollback {
  my ($self,$r) = @_;
  $self->error('Unknown error') unless $self->error;
  $self->remove_package(@{$$r{'remove_package'}}) if $$r{'remove_package'};
  $self->purge_user($$r{'purge_user'}, 'force' => 1) if $$r{'purge_user'};
  $self->suspend_account($$r{'suspend_account'}) if $$r{'suspend_account'};
  $self->delete_account($$r{'delete_account'}) if $$r{'delete_account'};
  $self->purge_account($$r{'purge_account'}, 'force' => 1) if $$r{'purge_account'};
  return $self->error;
}

=head1 SEE ALSO

L<FS::part_export>

=head1 AUTHOR

Jonathan Prykop 
jonathan@freeside.biz

=cut

1;