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