FS/FS/part_export/magicmail.pm

   1 package FS::part_export::magicmail;
   2
   3 use strict;
   4
   5 use base qw( FS::part_export );
   6
   7 use Data::Dumper;
   8 use MIME::Base64;
   9
  10 use Net::HTTPS::Any qw( https_get https_post );
  11 use XML::Simple;
  12 use URI::Escape;
  13
  14 use FS::Record qw (qsearch);
  15
  16 use vars qw( $DEBUG );
  17 $DEBUG = 0;
  18
  19 =pod
  20
  21 =head1 NAME
  22
  23 FS::part_export::magicmail
  24
  25 =head1 SYNOPSIS
  26
  27 MagicMail integration for Freeside
  28
  29 =head1 REQUIRES
  30
  31 L<Net::HTTPS::Any>
  32
  33 L<XML::Simple>
  34
  35 L<URI::Escape>
  36
  37 =head1 DESCRIPTION
  38
  39 This export offers basic svc_acct provisioning for MagicMail.  Each customer will
  40 map to an account in MagicMail, and each svc_acct exported will map to a user/mailbox.
  41
  42 This module also provides generic methods for working through the MagicMail API, and can
  43 be used as a base for more complex exports to MagicMail (just be sure to override
  44 the C<%info> hash and the L</Hook Methods>.)
  45
  46 L</Hook Methods> return an error message on failure, and a blank string on success.
  47 All other methods return a positive value (usually a hashref) on success and return
  48 nothing on failure, instead setting the error message in the export object using
  49 L</Error Methods>.  Use L</error> to retrieve this message.
  50
  51 =cut
  52
  53 use vars qw( %info );
  54
  55 tie my %options, 'Tie::IxHash',
  56   'client_id'        => { label => 'API Client ID',
  57                           default => '' },
  58   'client_password'  => { label => 'API Client Password',
  59                           default => '' },
  60   'account_prefix'   => { label => 'Account Prefix',
  61                           default => 'FREESIDE' },
  62   'package'          => { label => 'Package',
  63                           default => 'EMAIL' },
  64   'port'             => { label => 'Port',
  65                           default => 443 },
  66   'autopurge'        => { type => 'checkbox',
  67                           label => 'Auto purge user/account on unprovision' },
  68   'use_agent_custid' => { type => 'checkbox',
  69                           label => 'Use agent_custid for Magicmail account_id when available' },
  70   'debug'            => { type => 'checkbox',
  71                           label => 'Enable debug warnings' },
  72 ;
  73
  74 %info = (
  75   'svc'             => 'svc_acct',
  76   'desc'            => 'Export service to MagicMail, for svc_acct services',
  77   'options'         => \%options,
  78   'notes'           => <<'END',
  79 Add service user and email address to MagicMail<BR>
  80 See <A HREF="http://www.freeside.biz/mediawiki/index.php/Freeside:4:Documentation:MagicMail">documentation</A> for details.
  81 END
  82 );
  83
  84 =head1 Hook Methods
  85
  86 =cut
  87
  88 =head2 _export_insert
  89
  90 Hook that is called when service is initially provisioned.
  91 To avoid confusion, don't use for anything else.
  92
  93 For this export, creates a MagicMail account for this customer
  94 if it doesn't exist, activates account if it is suspended/deleted,
  95 creates a user/mailbox on that account for the provisioning service,
  96 assigns I<package> (specified by export option) to master user on
  97 account if it hasn't been, and adds the email address for the
  98 provisioning service.  On error, attempts to purge any newly
  99 created account/user and remove any newly set package via L</rollback>.
 100
 101 On success, also runs L</sync_magic_packages> (does not cause fatal
 102 error on failure.)
 103
 104 Override this method when using this module as a base for other exports.
 105
 106 =cut
 107
 108 sub _export_insert {
 109   my ($self, $svc_acct) = @_;
 110   $self->error_init;
 111   my $cust_main = $svc_acct->cust_main;
 112   my $username = $svc_acct->username;
 113   my $r = {}; #rollback input
 114
 115   # create customer account if it doesn't exist
 116   my $newacct = 0;
 117   my $account_id = $self->cust_account_id($cust_main);
 118   my $account = $self->get_account($account_id);
 119   return $self->error if $self->error;
 120   unless ($account) {
 121     $account = $self->add_account($account_id,
 122       'first_name' => $cust_main->first,
 123       'last_name'  => $cust_main->last,
 124       # could also add phone & memo
 125     );
 126     return $self->error if $self->error;
 127     $account_id = $account->{'id'};
 128     $$r{'purge_account'} = $account_id;
 129   }
 130
 131   # activate account if suspended/deleted
 132   my $oldstatus = $account->{'status'};
 133   unless ($oldstatus eq 'active') {
 134     $account = $self->activate_account($account_id);
 135   }
 136   return $self->rollback($r) if $self->error;
 137   $$r{'delete_account'} = $account_id
 138     if $oldstatus eq 'deleted';
 139   $$r{'suspend_account'} = $account_id
 140     if $oldstatus eq 'suspended';
 141
 142   # check for a master user, assign package if found
 143   my $package = $self->option('package');
 144   my $muser = $self->get_master_user($account_id);
 145   return $self->rollback($r) if $self->error;
 146   if ($muser) {
 147     my $musername = $muser->{'id'};
 148     my $packages = $self->get_packages($musername);
 149     return $self->rollback($r) if $self->error || !$packages;
 150     unless ($packages->{$package}) {
 151       $packages = $self->assign_package($musername,$package);
 152       return $self->rollback($r) if $self->error || !$packages || !$packages->{$package};
 153       $$r{'remove_package'} = [$musername,$package];
 154     }
 155   }
 156
 157   # add user
 158   my ($first,$last) = $svc_acct->finger =~ /(.*)\s(.*)/;
 159   $first ||= $svc_acct->finger || '';
 160   $last  ||= '';
 161   my $user = $self->add_user($account_id,$username,
 162     'first_name'    => $first,
 163     'last_name'     => $last,
 164     'password'      => $svc_acct->_password_encryption eq 'plain'
 165                        ? $svc_acct->get_cleartext_password
 166                        : $svc_acct->_password,
 167     'password_type' => $svc_acct->_password_encryption eq 'plain'
 168                        ? 'plain'
 169                        : 'encrypted',
 170     # could also add memo
 171   );
 172   return $self->rollback($r) if $self->error;
 173   $$r{'purge_user'} = $username;
 174
 175   # assign package if it hasn't been yet
 176   unless ($muser) {
 177     die "Unexpected lack of master user on account, please contact a developer"
 178       unless $user->{'master_user'} eq 'Y';
 179     $muser = $user;
 180     # slight false laziness with above
 181     my $musername = $muser->{'id'};
 182     my $packages = $self->get_packages($musername);
 183     return $self->rollback($r) if $self->error || !$packages;
 184     unless ($packages->{$package}) {
 185       $packages = $self->assign_package($musername,$package);
 186       return $self->rollback($r) if $self->error || !$packages || !$packages->{$package};
 187       $$r{'remove_package'} = [$musername,$package];
 188     }
 189   }
 190
 191   # add email address
 192   $self->add_email_address($username,$username.'@'.$svc_acct->domain);
 193   return $self->rollback($r) if $self->error;
 194
 195   # double-check packages (only throws warnings, no rollback on fail)
 196   $self->sync_magic_packages($cust_main, 'include' => $svc_acct);
 197
 198   return '';
 199 }
 200
 201 =head2 _export_delete
 202
 203 Hook that is called when service is unprovisioned.
 204 To avoid confusion, don't use for anything else.
 205
 206 For this export, deletes the email address and user
 207 associated with the provisioning service.  Only sets
 208 an error if this part fails;  everything else simply
 209 generates warnings.
 210
 211 Also attempts to delete the associated account, if there
 212 aren't any more users on the account.
 213
 214 If deleted user was master user for account and other
 215 users exist on the account, attempts to make another user
 216 the master user.
 217
 218 Runs L</sync_magic_packages>.
 219
 220 If the I<autopurge> export option is set, also purges
 221 newly deleted users/accounts.
 222
 223 Override this method when using this module as a base for other exports.
 224
 225 =cut
 226
 227 sub _export_delete {
 228   my ($self, $svc_acct) = @_;
 229   $self->error_init;
 230   my $cust_main = $svc_acct->cust_main;
 231   my $username = $svc_acct->username;
 232
 233   # check account id
 234   my $user = $self->get_user($username);
 235   unless ($user) {
 236     $self->error("Could not remove user from magicmail, username $username not retrievable");
 237     $self->error_warn;
 238     return ''; #non-fatal error, allow svc to be unprovisioned
 239   }
 240   my $account_id = $user->{'account'};
 241   return $self->error("Could not remove user from magicmail, account id does not match")
 242     unless $account_id eq $self->cust_account_id($cust_main); #fatal, sort out before unprovisioning
 243
 244   # check for master change
 245   my $newmaster;
 246   if ($user->{'master_user'}) {
 247     my $users = $self->get_users($account_id);
 248     if ($users && (keys %$users > 1)) {
 249       foreach my $somesvc (
 250         sort { $a->svcnum <=> $b->svcnum } # cheap way of ordering by provision date
 251           $self->cust_magic_services($cust_main,'ignore'=>$svc_acct)
 252       ) {
 253         next unless $users->{uc($somesvc->username)};
 254         $newmaster = $somesvc->username;
 255         last;
 256       }
 257       $self->error("Cannot find replacement master user for account $account_id")
 258         unless $newmaster;
 259     }
 260     $self->error_warn; #maybe this should be fatal?
 261   }
 262
 263   # do the actual deleting
 264   $self->delete_user($username);
 265   return $self->error if $self->error;
 266
 267   ## no fatal errors after this point
 268
 269   # transfer master user
 270   $self->make_master_user($newmaster) if $newmaster;
 271   $self->error_warn;
 272   $self->sync_magic_packages($cust_main, 'ignore' => $svc_acct);
 273
 274   # purge user if configured to do so
 275   $self->purge_user($username) if $self->option('autopurge');
 276   $self->error_warn;
 277
 278   # delete account if there are no more users
 279   my $users = $self->get_users($account_id);
 280   $self->error_warn;
 281   return '' unless $users;
 282   return '' if keys %$users;
 283   $self->delete_account($account_id);
 284   return $self->error_warn if $self->error;
 285
 286   #purge account if configured to do so
 287   $self->purge_account($account_id) if $self->option('autopurge');
 288   return $self->error_warn;
 289 }
 290
 291 =head2 _export_replace
 292
 293 Hook that is called when provisioned service is edited.
 294 To avoid confusion, don't use for anything else.
 295
 296 Updates user info & password.  Cannot be used to change user name.
 297
 298 Override this method when using this module as a base for other exports.
 299
 300 =cut
 301
 302 sub _export_replace {
 303   my($self, $new, $old) = @_;
 304   $self->error_init;
 305   my $username = $new->username;
 306
 307   return "Cannot change username on a magicmail account"
 308     unless $username eq $old->username;
 309
 310   # check account id
 311   my $user = $self->get_user($username);
 312   return $self->error("Could not update user, username $username not retrievable")
 313     unless $user;
 314   my $account_id = $user->{'account'};
 315   return $self->error("Could not update user $username, account id does not match")
 316     unless $account_id eq $self->cust_account_id($new); #fatal, sort out before updating
 317
 318   # update user
 319   my ($first,$last) = $new->finger =~ /(.*)\s(.*)/;
 320   $first ||= $new->finger || '';
 321   $last  ||= '';
 322   $user = $self->update_user($account_id,$username,
 323     'first_name'    => $first,
 324     'last_name'     => $last,
 325     'password'      => $new->_password_encryption eq 'plain'
 326                        ? $new->get_cleartext_password
 327                        : $new->_password,
 328     'password_type' => $new->_password_encryption eq 'plain'
 329                        ? 'plain'
 330                        : 'encrypted',
 331     # could also add memo
 332   );
 333   return $self->error;
 334 }
 335
 336 =head2 _export_suspend
 337
 338 Hook that is called when service is suspended.
 339 To avoid confusion, don't use for anything else.
 340
 341 =cut
 342
 343 sub _export_suspend {
 344   my ($self, $svc_acct) = @_;
 345   $self->error_init;
 346   my $username = $svc_acct->username;
 347
 348   # check account id
 349   my $user = $self->get_user($username);
 350   return $self->error("Could not update user, username $username not retrievable")
 351     unless $user;
 352   my $account_id = $user->{'account'};
 353   return $self->error("Could not update user $username, account id does not match")
 354     unless $account_id eq $self->cust_account_id($svc_acct); #fatal, sort out before updating
 355
 356   #suspend user
 357   $self->suspend_user($username);
 358   return $self->error;
 359 }
 360
 361 =head2 _export_unsuspend
 362
 363 Hook that is called when service is unsuspended.
 364 To avoid confusion, don't use for anything else.
 365
 366 =cut
 367
 368 sub _export_unsuspend {
 369   my ($self, $svc_acct) = @_;
 370   $self->error_init;
 371   my $username = $svc_acct->username;
 372
 373   # check account id
 374   my $user = $self->get_user($username);
 375   return $self->error("Could not update user, username $username not retrievable")
 376     unless $user;
 377   my $account_id = $user->{'account'};
 378   return $self->error("Could not update user $username, account id does not match")
 379     unless $account_id eq $self->cust_account_id($svc_acct); #fatal, sort out before updating
 380
 381   #suspend user
 382   $self->activate_user($username);
 383   return $self->error;
 384 }
 385
 386 =head1 Freeside Methods
 387
 388 These methods are specific to freeside, used to translate
 389 freeside customers/services/exports
 390 into magicmail accounts/users/packages.
 391
 392 =head2 cust_account_id
 393
 394 Accepts either I<$cust_main> or I<$svc_acct>.
 395 Returns MagicMail account_id for this customer under this export.
 396
 397 =cut
 398
 399 sub cust_account_id {
 400   my ($self, $in) = @_;
 401   my $cust_main = ref($in) eq 'FS::cust_main' ? $in : $in->cust_main;
 402   return $self->option('account_prefix').
 403          ( ($self->option('use_agent_custid') && $cust_main->agent_custid)
 404              ? $cust_main->agent_custid
 405              : $cust_main->custnum
 406          );
 407 }
 408
 409 =head2 cust_magic_services
 410
 411 Accepts I<$cust_main> or I<$svc_acct> and the following options:
 412
 413 I<ignore> - I<$svc_acct> to be ignored
 414
 415 I<include> - I<$svc_acct> to be included
 416
 417 Returns a list services owned by the customer
 418 that are provisioned in MagicMail with the same I<account_prefix>
 419 (not necessarily the same export.)
 420
 421 I<include> is not checked for compatability with the current
 422 export.  It will probably cause errors if you pass a service
 423 that doesn't use the current export.
 424
 425 =cut
 426
 427 sub cust_magic_services {
 428   my ($self, $in, %opt) = @_;
 429   my $cust_main = ref($in) eq 'FS::cust_main' ? $in : $in->cust_main;
 430   my @out =
 431     grep {
 432       $opt{'ignore'} ? ($_->svcnum != $opt{'ignore'}->svcnum) : 1;
 433     }
 434     map {
 435       qsearch('svc_acct', { 'svcnum' => $_->svcnum })
 436     }
 437     grep {
 438       grep {
 439         ($_->exporttype eq 'magicmail')
 440           && ($_->option('account_prefix') eq $self->option('account_prefix'))
 441       }
 442       map {
 443         qsearch('part_export',{ 'exportnum' => $_->exportnum })
 444       }
 445       qsearch('export_svc',{ 'svcpart' => $_->svcpart })
 446     }
 447     qsearch({
 448       'table' => 'cust_svc',
 449       'addl_from' => 'INNER JOIN cust_pkg ON (cust_svc.pkgnum = cust_pkg.pkgnum)',
 450       'hashref' => { 'cust_pkg.custnum' => $cust_main->custnum }
 451     }); #end of @out =
 452   push(@out,$opt{'include'})
 453     unless grep { $opt{'include'} ? ($_->svcnum == $opt{'include'}->svcnum) : 1 } @out;
 454   return @out;
 455 }
 456
 457 =head2 cust_magic_packages
 458
 459 Accepts I<$cust_main> or I<$svc_acct> and the same options as L</cust_magic_services>.
 460
 461 Returns list of MagicMail packages for this customer's L</cust_magic_services>
 462 (ie packages that the master user for this customer should have assigned to it.)
 463
 464 =cut
 465
 466 sub cust_magic_packages {
 467   my ($self, $in, %opt) = @_;
 468   my $out = {};
 469   my @svcs = $self->cust_magic_services($in);
 470   foreach my $svc ($self->cust_magic_services($in,%opt)) {
 471     # there really should only be one export per service, but loop just in case
 472     foreach my $export ( $svc->cust_svc->part_svc->part_export('magicmail') ) {
 473       $out->{$export->option('package')} = 1;
 474     }
 475   }
 476   return keys %$out;
 477 }
 478
 479 =head2 sync_magic_packages
 480
 481 Accepts I<$cust_main> or I<$svc_acct> and the same options as L</cust_magic_services>.
 482
 483 Assigns or removes packages from the master user of L</cust_account_id> so
 484 that they match L</cust_magic_packages>.  (Will only attempt to remove
 485 non-matching packages if matching packages are all successfully assigned.)
 486
 487 All errors will be immediately cleared by L</error_warn>.
 488 No meaningful return value.
 489
 490 =cut
 491
 492 sub sync_magic_packages {
 493   my ($self, $in, %opt) = @_;
 494   my $cust_main = ref($in) eq 'FS::cust_main' ? $in : $in->cust_main;
 495   my $account_id = $self->cust_account_id($cust_main);
 496   my $muser = $self->get_master_user($account_id);
 497   return $self->error_warn if $self->error;
 498   return $self->error_warn("Could not find master user for account $account_id")
 499     unless $muser && $muser->{'id'};
 500   my $musername = $muser->{'id'};
 501   my $have = $self->get_packages($musername);
 502   return $self->error_warn if $self->error;
 503   my %dont = map { $_ => 1 } keys %$have;
 504   foreach my $want ($self->cust_magic_packages($cust_main,%opt)) {
 505     delete $dont{$want};
 506     $self->assign_package($musername,$want)
 507       unless $have->{$want};
 508   }
 509   return $self->error_warn if $self->error;
 510   foreach my $dont (keys %dont) {
 511     $self->remove_package($musername,$dont)
 512   }
 513   return $self->error_warn;
 514 }
 515
 516 =head1 Helper Methods
 517
 518 These methods combine account, user and package information
 519 through multiple API requests.
 520
 521 =head2 get_accounts_and_users
 522
 523 Returns results of L</get_accounts> with extra 'users' key for
 524 each account, the value of which is the result of L</get_users>
 525 for that account.
 526
 527 =cut
 528
 529 sub get_accounts_and_users {
 530   my ($self) = @_;
 531   my $accounts = $self->get_accounts() or return;
 532   foreach my $account (keys %$accounts) {
 533     $accounts->{$account}->{'users'} = $self->get_users($account) or return;
 534   }
 535   return $accounts;
 536 }
 537
 538 =head2 get_master_user
 539
 540 Accepts I<$account_id>.  Returns hashref of details on master user
 541 for that account (as would be returned by L</get_user>.)
 542 Returns nothing without setting error if master user is not found.
 543
 544 =cut
 545
 546 sub get_master_user {
 547   my ($self,$account_id) = @_;
 548   my $users = $self->get_users($account_id);
 549   return if $self->error || !$users;
 550   foreach my $username (keys %$users) {
 551     if ($users->{$username}->{'master_user'} eq 'Y') {
 552       $users->{$username}->{'id'} = $username;
 553       return $users->{$username};
 554     }
 555   }
 556   return;
 557 }
 558
 559 =head2 request
 560
 561         #send a request to https://machine/api/v2/some/function
 562         my $result = $export->request('POST','/some/function',%args);
 563
 564 Accepts I<$method>, I<$path> and optional I<%args>.  Sends request
 565 to server and returns server response as a hashref (converted from
 566 XML by L<XML::Simple>.)  I<%args> can include a ForceArray key that
 567 will be passed to L<XML::Simple/XMLin>;  all other args will be
 568 passed in the reqest.  Do not include 'client_type' in I<%args>,
 569 and do not include '/api/v2' in I<$path>.
 570
 571 Used by other methods to send requests;  unless you're editing
 572 this module, you should probably be using those other methods instead.
 573
 574 =cut
 575
 576 sub request {
 577   my ($self,$method,$path,%args) = @_;
 578   local $Data::Dumper::Terse = 1;
 579   unless (grep(/^$method$/,('GET','POST'))) {
 580     return if $self->error("Can't request method $method");
 581   }
 582   my $get = $method eq 'GET';
 583   my $forcearray = [];
 584   if (exists $args{'ForceArray'}) {
 585     $forcearray = delete $args{'ForceArray'};
 586   }
 587   $args{'client_type'} = 'FREESIDE';
 588   my %request = (
 589     'host'    => $self->machine,
 590     'port'    => $self->option('port'),
 591     'path'    => '/api/v2' . $path,
 592     'headers' => {
 593       'Authorization' => 'Basic ' . MIME::Base64::encode(
 594                                       $self->option('client_id')
 595                                       . ':'
 596                                       . $self->option('client_password'),
 597                                     ''),
 598     },
 599   );
 600   my ( $page, $response, %reply_headers );
 601   if ($get) {
 602     my $pathargs = '';
 603     foreach my $field (keys %args) {
 604       $pathargs .= $pathargs ? '&' : '?';
 605       $pathargs .= $field . '=' . uri_escape_utf8($args{$field});
 606     }
 607     $request{'path'} .= $pathargs;
 608     warn "Request = " . Dumper(\%request) if $self->debug;
 609     ( $page, $response, %reply_headers ) = https_get(%request);
 610   } else {
 611     foreach my $field (keys %args) {
 612       $request{'content'} .= '&' if $request{'content'};
 613       $request{'content'} .= $field . '=' . uri_escape_utf8($args{$field});
 614     }
 615     warn "Request = " . Dumper(\%request) if $self->debug;
 616     ( $page, $response, %reply_headers ) = https_post(%request);
 617   }
 618   unless ($response =~ /^(200|400|500)/) {
 619     return if $self->error("Bad Response: $response");
 620   }
 621   warn "Response = " . Dumper($page) if $self->debug;
 622   my $result = $page ? XMLin($page, ForceArray => $forcearray) : {};
 623   warn "Result = " . Dumper($result) if $self->debug;
 624   return $result;
 625 }
 626
 627 =head1 Account Methods
 628
 629 Make individual account-related API requests.
 630
 631 =head2 add_account
 632
 633 Accepts I<$account_id> and the following options:
 634
 635 I<first_name>
 636
 637 I<last_name>
 638
 639 I<phone>
 640
 641 I<memo>
 642
 643 Returns a hashref containing the created account details.
 644
 645 =cut
 646
 647 sub add_account {
 648   my ($self,$id,%opt) = @_;
 649   warn "CREATING ACCOUNT $id\n" if $self->debug;
 650   my %args;
 651   foreach my $field ( qw( first_name last_name phone memo ) ) {
 652     $args{$field} = $opt{$field} if $opt{$field};
 653   }
 654   my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), %args );
 655   return if $self->check_for_error($result);
 656   return $result->{'account'};
 657 }
 658
 659 =head2 get_account
 660
 661 Accepts I<$account_id>.
 662 Returns a hashref containing account details.
 663 Returns nothing without setting error if account is not found.
 664
 665 =cut
 666
 667 sub get_account {
 668   my ($self,$id) = @_;
 669   warn "GETTING ACCOUNT $id\n" if $self->debug;
 670   my $result = $self->request('GET','/account/'.uri_escape_utf8($id));
 671   if ($result->{'error'}) {
 672     return if $result->{'error'}->{'code'} eq 'account.error.not_found';
 673   }
 674   return if $self->check_for_error($result);
 675   return $result->{'account'};
 676 }
 677
 678 =head2 get_accounts
 679
 680 No input.  Returns a hashref, keys are account_id, values
 681 are hashrefs of account details.
 682
 683 =cut
 684
 685 sub get_accounts {
 686   my ($self) = @_;
 687   warn "GETTING ALL ACCOUNTS\n" if $self->debug;
 688   my $result = $self->request('GET','/account','ForceArray' => ['account']);
 689   return if $self->check_for_error($result);
 690   return $result->{'accounts'}->{'account'} || {};
 691 }
 692
 693 =head2 update_account
 694
 695 Accepts I<$account_id> and the same options as L</add_account>.
 696 Updates an existing account.
 697 Returns a hashref containing the updated account details.
 698
 699 =cut
 700
 701 sub update_account {
 702   my ($self,$id,%opt) = @_;
 703   warn "UPDATING ACCOUNT $id\n" if $self->debug;
 704   my %args;
 705   foreach my $field ( qw( first_name last_name phone memo ) ) {
 706     $args{$field} = $opt{$field} if $opt{$field};
 707   }
 708   my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), %args, action => 'update' );
 709   return if $self->check_for_error($result);
 710   return $result->{'account'};
 711 }
 712
 713 =head2 suspend_account
 714
 715 Accepts I<$account_id>.  Sets account status to suspended.
 716 Returns a hashref containing the updated account details.
 717
 718 =cut
 719
 720 sub suspend_account {
 721   my ($self,$id) = @_;
 722   warn "SUSPENDING ACCOUNT $id\n" if $self->debug;
 723   my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), status => 'suspended', action => 'update' );
 724   return if $self->check_for_error($result);
 725   return $result->{'account'};
 726 }
 727
 728 =head2 activate_account
 729
 730 Accepts I<$account_id>.  Sets account status to active.
 731 Returns a hashref containing the updated account details.
 732
 733 =cut
 734
 735 sub activate_account {
 736   my ($self,$id) = @_;
 737   warn "ACTIVATING ACCOUNT $id\n" if $self->debug;
 738   my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), status => 'active', action => 'update' );
 739   return if $self->check_for_error($result);
 740   return $result->{'account'};
 741 }
 742
 743 =head2 delete_account
 744
 745 Accepts I<$account_id>.  Sets account status to deleted.
 746 Returns a hashref containing the updated account details.
 747
 748 =cut
 749
 750 sub delete_account {
 751   my ($self,$id) = @_;
 752   warn "DELETING ACCOUNT $id\n" if $self->debug;
 753   my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), status => 'deleted', action => 'update' );
 754   return if $self->check_for_error($result);
 755   return $result->{'account'};
 756 }
 757
 758 =head2 purge_account
 759
 760 Accepts account I<$id> and the following options:
 761
 762 I<force> - if true, purges account even if it wasn't first deleted
 763
 764 Purges account from system.
 765 No meaningful return value.
 766
 767 =cut
 768
 769 sub purge_account {
 770   my ($self,$id,%opt) = @_;
 771   my %args;
 772   $args{'force'} = 'true' if $opt{'force'};
 773   warn "PURGING ACCOUNT $id\n" if $self->debug;
 774   my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), %args, action => 'purge' );
 775   $self->check_for_error($result);
 776   return;
 777 }
 778
 779 =head1 User Methods
 780
 781 Make individual user-related API requests.
 782
 783 =head2 add_user
 784
 785 Accepts I<$account_id>, I<$username> and the following options:
 786
 787 I<first_name>
 788
 789 I<last_name>
 790
 791 I<memo>
 792
 793 I<password>
 794
 795 I<password_type> - plain or encrypted
 796
 797 Returns a hashref containing the created user details.
 798
 799 =cut
 800
 801 sub add_user {
 802   my ($self,$account_id,$username,%opt) = @_;
 803   warn "CREATING USER $username FOR ACCOUNT $account_id\n" if $self->debug;
 804   my %args;
 805   foreach my $field ( qw( first_name last_name memo password password_type ) ) {
 806     $args{$field} = $opt{$field} if $opt{$field};
 807   }
 808   $args{'account'} = $account_id;
 809   unless ($account_id) {
 810     return if $self->error("Account ID required");
 811   }
 812   if ($args{'password_type'} && !grep(/$args{'password_type'}/,('plain','encrypted'))) {
 813     return if $self->error("Illegal password_type $args{'password_type'}");
 814   }
 815   my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), %args );
 816   return if $self->check_for_error($result);
 817   return $result->{'user'};
 818 }
 819
 820 =head2 get_user
 821
 822 Accepts I<$username>.
 823 Returns a hashref containing user details.
 824 Returns nothing without setting error if user is not found.
 825
 826 =cut
 827
 828 sub get_user {
 829   my ($self,$username) = @_;
 830   warn "GETTING USER $username\n" if $self->debug;
 831   my $result = $self->request('GET','/user/'.uri_escape_utf8($username));
 832   if ($result->{'error'}) {
 833     return if $result->{'error'}->{'code'} eq 'account.error.not_found';
 834   }
 835   return if $self->check_for_error($result);
 836   return $result->{'user'};
 837 }
 838
 839 =head2 get_users
 840
 841 Accepts I<$account_id>.  Returns a hashref, keys are username, values
 842 are hashrefs of user details.
 843
 844 =cut
 845
 846 sub get_users {
 847   my ($self,$account_id) = @_;
 848   warn "GETTING ALL USERS FOR ACCOUNT $account_id\n" if $self->debug;
 849   my $result = $self->request('GET','/user','ForceArray' => ['user'],'account' => $account_id);
 850   return if $self->check_for_error($result);
 851   return $result->{'users'}->{'user'} || {};
 852 }
 853
 854 =head2 update_user
 855
 856 Accepts I<$account_id>, I<$username> and the same options as L</add_user>.
 857 Updates an existing user.
 858 Returns a hashref containing the updated user details.
 859
 860 =cut
 861
 862 sub update_user {
 863   my ($self,$account_id,$username,%opt) = @_;
 864   warn "UPDATING USER $username\n" if $self->debug;
 865   my %args;
 866   foreach my $field ( qw( first_name last_name memo password password_type ) ) {
 867     $args{$field} = $opt{$field} if $opt{$field};
 868   }
 869   if ($args{'password_type'} && !grep(/$args{'password_type'}/,('plain','encrypted'))) {
 870     return if $self->error("Illegal password_type $args{'password_type'}");
 871   }
 872   $args{'account'} = $account_id;
 873   my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), %args, action => 'update' );
 874   return if $self->check_for_error($result);
 875   return $result->{'user'};
 876 }
 877
 878 =head2 make_master_user
 879
 880 Accepts I<$username>.  Sets user to be master user for account.
 881 Returns a hashref containing the updated user details.
 882
 883 Caution: does not unmake existing master user.
 884
 885 =cut
 886
 887 sub make_master_user {
 888   my ($self,$username) = @_;
 889   warn "MAKING MASTER USER $username\n" if $self->debug;
 890   my $result = $self->request('POST', '/user/'.uri_escape_utf8($username),
 891     master_user => 'Y',
 892     action => 'update'
 893   );
 894   return if $self->check_for_error($result);
 895   return $result->{'user'};
 896 }
 897
 898 =head2 suspend_user
 899
 900 Accepts I<$username>.  Sets user status to suspended.
 901 Returns a hashref containing the updated user details.
 902
 903 =cut
 904
 905 sub suspend_user {
 906   my ($self,$username) = @_;
 907   warn "SUSPENDING USER $username\n" if $self->debug;
 908   my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), status => 'suspended', action => 'update' );
 909   return if $self->check_for_error($result);
 910   return $result->{'user'};
 911 }
 912
 913 =head2 activate_user
 914
 915 Accepts I<$username>.  Sets user status to active.
 916 Returns a hashref containing the updated user details.
 917
 918 =cut
 919
 920 sub activate_user {
 921   my ($self,$username) = @_;
 922   warn "ACTIVATING USER $username\n" if $self->debug;
 923   my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), status => 'active', action => 'update' );
 924   return if $self->check_for_error($result);
 925   return $result->{'user'};
 926 }
 927
 928 =head2 delete_user
 929
 930 Accepts I<$username>.  Sets user status to deleted.
 931 Returns a hashref containing the updated user details.
 932
 933 =cut
 934
 935 sub delete_user {
 936   my ($self,$username) = @_;
 937   warn "DELETING USER $username\n" if $self->debug;
 938   my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), status => 'deleted', action => 'update' );
 939   return if $self->check_for_error($result);
 940   return $result->{'user'};
 941 }
 942
 943 =head2 purge_user
 944
 945 Accepts I<$username> and the following options:
 946
 947 I<force> - if true, purges user even if it wasn't first deleted
 948
 949 Purges user from system.
 950 No meaningful return value.
 951
 952 =cut
 953
 954 sub purge_user {
 955   my ($self,$username,%opt) = @_;
 956   my %args;
 957   $args{'force'} = 'true' if $opt{'force'};
 958   warn "PURGING USER $username\n" if $self->debug;
 959   my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), %args, action => 'purge' );
 960   $self->check_for_error($result);
 961   return;
 962 }
 963
 964 =head1 Package Methods
 965
 966 Make individual package-related API requests.
 967
 968 =head2 assign_package
 969
 970 Accepts I<$username> and I<$package>.  Assigns package to user.
 971 Returns a hashref of packages assigned to this user, keys are package names
 972 and values are hashrefs of details about those packages.
 973 Returns undef if none are found.
 974
 975 =cut
 976
 977 sub assign_package {
 978   my ($self,$username,$package) = @_;
 979   warn "ASSIGNING PACKAGE $package TO USER $username\n" if $self->debug;
 980   my $result = $self->request('POST', '/user_package/'.uri_escape_utf8($username),
 981     'ForceArray' => ['package'],
 982     'package' => $package,
 983   );
 984   return if $self->check_for_error($result);
 985   return $result->{'packages'}->{'package'};
 986 }
 987
 988 =head2 get_packages
 989
 990 Accepts I<$username>.
 991 Returns a hashref of packages assigned to this user, keys are package names
 992 and values are hashrefs of details about those packages.
 993
 994 =cut
 995
 996 sub get_packages {
 997   my ($self,$username) = @_;
 998   warn "GETTING PACKAGES ASSIGNED TO USER $username\n" if $self->debug;
 999   my $result = $self->request('GET', '/user_package/'.uri_escape_utf8($username),
1000     'ForceArray' => ['package'],
1001   );
1002   return if $self->check_for_error($result);
1003   return $result->{'packages'}->{'package'} || {};
1004 }
1005
1006 =head2 remove_package
1007
1008 Accepts I<$username> and I<$package>.  Removes package from user.
1009 No meaningful return value.
1010
1011 =cut
1012
1013 sub remove_package {
1014   my ($self,$username,$package) = @_;
1015   warn "REMOVING PACKAGE $package FROM USER $username\n" if $self->debug;
1016   my $result = $self->request('POST', '/user_package/'.uri_escape_utf8($username),
1017     'package' => $package,
1018         'action' => 'purge'
1019   );
1020   $self->check_for_error($result);
1021   return;
1022 }
1023
1024 =head1 Domain Methods
1025
1026 Make individual account-related API requests.
1027
1028 =cut
1029
1030 ### DOMAIN METHODS HAVEN'T BEEN THOROUGLY TESTED, AREN'T CURRENTLY USED ###
1031
1032 =head2 add_domain
1033
1034 Accepts I<$account_id> and I<$domain>.  Creates domain for that account.
1035
1036 =cut
1037
1038 sub add_domain {
1039   my ($self,$account_id,$domain) = @_;
1040   warn "CREATING DOMAIN $domain FOR ACCOUNT $account_id\n" if $self->debug;
1041   my $result = $self->request('POST','/domain/'.uri_escape_utf8($domain), 'account' => $account_id);
1042   return if $self->check_for_error($result);
1043   return $result->{'domain'};
1044 }
1045
1046 =head2 get_domain
1047
1048 Accepts I<$domain>.  Returns hasref of domain info if it exists,
1049 or empty if it doesn't exist or permission denied.
1050 Returns nothing without setting error if domain is not found.
1051
1052 =cut
1053
1054 sub get_domain {
1055   my ($self, $domain) = @_;
1056   warn "GETTING DOMAIN $domain\n" if $self->debug;
1057   my $result = $self->request('GET','/domain/'.uri_escape_utf8($domain));
1058   if ($result->{'error'}) {
1059     #unfortunately, no difference between 'does not exist' and true 'permission denied'
1060     return if $result->{'error'}->{'code'} eq 'error.permission_denied';
1061   }
1062   return if $self->check_for_error($result);
1063   return $result->{'domain'};
1064 }
1065
1066 =head2 get_domains
1067
1068 Accepts I<$account_id>.  Returns hasref of domains for that account,
1069 keys are domains, values are hashrefs of info about each domain.
1070
1071 =cut
1072
1073 sub get_domains {
1074   my ($self, $account_id) = @_;
1075   warn "GETTING DOMAINS FOR ACCOUNT $account_id\n" if $self->debug;
1076   my $result = $self->request('GET','/domain',
1077     'ForceArray' => ['domain'],
1078     'account' => $account_id
1079   );
1080   return if $self->check_for_error($result);
1081   return $result->{'domains'}->{'domain'} || {};
1082 }
1083
1084 =head2 remove_domain
1085
1086 Accepts I<$domain>.  Removes domain.
1087 No meaningful return value.
1088
1089 =cut
1090
1091 sub remove_domain {
1092   my ($self,$domain) = @_;
1093   warn "REMOVING DOMAIN $domain\n" if $self->debug;
1094   my $result = $self->request('POST', '/domain/'.uri_escape_utf8($domain), action => 'purge');
1095   $self->check_for_error($result);
1096   return;
1097 }
1098
1099 =head1 Email Address Methods
1100
1101 Make individual emailaddress-related API requests.
1102
1103 =head2 add_email_address
1104
1105 Accepts I<$username> and I<$address>.  Adds address for that user.
1106 Returns hashref of details for new address.
1107
1108 =cut
1109
1110 sub add_email_address {
1111   my ($self, $username, $address) = @_;
1112   warn "ADDING ADDRESS $address FOR USER $username\n" if $self->debug;
1113   my $result = $self->request('POST','/emailaddress/'.uri_escape_utf8($address),
1114     'user' => $username
1115   );
1116   return if $self->check_for_error($result);
1117   return $result->{'emailaddress'};
1118 }
1119
1120 =head2 get_email_address
1121
1122 Accepts I<$address>.  Returns hasref of address info if it exists,
1123 or empty if it doesn't exist or permission denied.
1124 Returns nothing without setting error if address is not found.
1125
1126 =cut
1127
1128 sub get_email_address {
1129   my ($self, $address) = @_;
1130   warn "GETTING ADDRESS $address\n" if $self->debug;
1131   my $result = $self->request('GET','/emailaddress/'.uri_escape_utf8($address));
1132   if ($result->{'error'}) {
1133     #unfortunately, no difference between 'does not exist' and true 'permission denied'
1134     return if $result->{'error'}->{'code'} eq 'error.permission_denied';
1135   }
1136   return if $self->check_for_error($result);
1137   return $result->{'emailaddress'};
1138 }
1139
1140 =head2 get_email_addresses
1141
1142 Accepts I<$username>.  Returns hasref of email addresses for that account,
1143 keys are domains, values are hashrefs of info about each domain.
1144
1145 =cut
1146
1147 sub get_email_addresses {
1148   my ($self, $username) = @_;
1149   warn "GETTING ADDRESSES FOR USER $username\n" if $self->debug;
1150   my $result = $self->request('GET','/emailaddress',
1151     'ForceArray' => ['emailaddress'],
1152     'user' => $username,
1153   );
1154   return if $self->check_for_error($result);
1155   return $result->{'emailaddresses'}->{'emailaddress'} || {};
1156 }
1157
1158 =head2 remove_email_address
1159
1160 Accepts I<$address>.  Removes address.
1161 No meaningful return value.
1162
1163 =cut
1164
1165 sub remove_email_address {
1166   my ($self,$address) = @_;
1167   warn "REMOVING ADDRESS $address\n" if $self->debug;
1168   my $result = $self->request('POST', '/emailaddress/'.uri_escape_utf8($address), action => 'purge');
1169   $self->check_for_error($result);
1170   return;
1171 }
1172
1173 =head1 Error Methods
1174
1175 Used to track errors during a request, for precision control over when
1176 and how those errors are returned.
1177
1178 =head2 error
1179
1180 Accepts optional I<$message>, which will be appended to the internal error message on this
1181 object if defined (use L</init_error> to clear the message.)  Returns current contents of
1182 internal error message on this object.
1183
1184 =cut
1185
1186 sub error {
1187   my ($self,$message) = @_;
1188   if (defined($message)) {
1189     $self->{'_error'} .= "\n" if $self->{'_error'};
1190     $self->{'_error'} .= $message;
1191   }
1192   return $self->{'_error'};
1193 }
1194
1195 =head2 check_for_error
1196
1197 Accepts I<$result> returned by L</request>.  Sets error if I<$result>
1198 does not exist or contains an error message.  Returns L</error>.
1199
1200 =cut
1201
1202 sub check_for_error {
1203   my ($self,$result) = @_;
1204   return $self->error("Unknown error, no result found")
1205     unless $result;
1206   return $self->error($result->{'error'}->{'code'} . ': ' . $result->{'error'}->{'message'})
1207     if $result->{'error'};
1208   return $self->error;
1209 }
1210
1211 =head2 error_init
1212
1213 Resets error message in object to blank string.
1214 Should only be used at the start of L</Hook Methods>.
1215 No meaningful return value.
1216
1217 =cut
1218
1219 sub error_init {
1220   my ($self) = @_;
1221   $self->{'_error'} = '';
1222   return;
1223 }
1224
1225 =head2 error_warn
1226
1227 Accepts optional I<$message>, which will be appended to the internal error message on this
1228 object if defined.
1229
1230 Outputs L</error> (if there is one) using warn, then runs L</error_init>.
1231 Returns blank string.
1232
1233 =cut
1234
1235 sub error_warn {
1236   my $self = shift;
1237   my $message = shift;
1238   $self->error($message) if defined($message);
1239   warn $self->error if $self->error;
1240   $self->error_init;
1241   return '';
1242 }
1243
1244 =head2 debug
1245
1246 Returns true if debug is set, either as an export option or in the module code.
1247
1248 =cut
1249
1250 sub debug {
1251   my $self = shift;
1252   return $DEBUG || $self->option('debug');
1253 }
1254
1255 =head2 rollback
1256
1257 Accepts hashref with the following fields, use for undoing recent changes:
1258
1259 I<remove_package> - arrayref of username and package to remove
1260
1261 I<purge_user> - username to be forcefully purged
1262
1263 I<suspend_account> - account_id to be suspended
1264
1265 I<delete_account> - account_id to be deleted
1266
1267 I<purge_account> - account_id to be forcefully purged
1268
1269 Indicated actions will be performed in the order listed above.
1270 Sets generic error message if no message is found, and returns L</error>.
1271
1272 =cut
1273
1274 sub rollback {
1275   my ($self,$r) = @_;
1276   $self->error('Unknown error') unless $self->error;
1277   $self->remove_package(@{$$r{'remove_package'}}) if $$r{'remove_package'};
1278   $self->purge_user($$r{'purge_user'}, 'force' => 1) if $$r{'purge_user'};
1279   $self->suspend_account($$r{'suspend_account'}) if $$r{'suspend_account'};
1280   $self->delete_account($$r{'delete_account'}) if $$r{'delete_account'};
1281   $self->purge_account($$r{'purge_account'}, 'force' => 1) if $$r{'purge_account'};
1282   return $self->error;
1283 }
1284
1285 =head1 SEE ALSO
1286
1287 L<FS::part_export>
1288
1289 =head1 AUTHOR
1290
1291 Jonathan Prykop
1292 jonathan@freeside.biz
1293
1294 =cut
1295
1296 1;
1297
1298