1 package FS::part_export::magicmail;
5 use base qw( FS::part_export );
10 use Net::HTTPS::Any qw( https_get https_post );
14 use FS::Record qw (qsearch);
16 use vars qw( $DEBUG );
23 FS::part_export::magicmail
27 MagicMail integration for Freeside
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.
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>.)
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.
55 tie my %options, 'Tie::IxHash',
56 'client_id' => { label => 'API Client ID',
58 'client_password' => { label => 'API Client Password',
60 'account_prefix' => { label => 'Account Prefix',
61 default => 'FREESIDE' },
62 'package' => { label => 'Package',
64 'port' => { label => 'Port',
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' },
76 'desc' => 'Export service to MagicMail, for svc_acct services',
77 'options' => \%options,
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.
90 Hook that is called when service is initially provisioned.
91 To avoid confusion, don't use for anything else.
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>.
101 On success, also runs L</sync_magic_packages> (does not cause fatal
104 Override this method when using this module as a base for other exports.
109 my ($self, $svc_acct) = @_;
111 my $cust_main = $svc_acct->cust_main;
112 my $username = $svc_acct->username;
113 my $r = {}; #rollback input
115 # create customer account if it doesn't exist
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;
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
126 return $self->error if $self->error;
127 $account_id = $account->{'id'};
128 $$r{'purge_account'} = $account_id;
131 # activate account if suspended/deleted
132 my $oldstatus = $account->{'status'};
133 unless ($oldstatus eq 'active') {
134 $account = $self->activate_account($account_id);
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';
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;
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];
158 my ($first,$last) = $svc_acct->finger =~ /(.*)\s(.*)/;
159 $first ||= $svc_acct->finger || '';
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'
170 # could also add memo
172 return $self->rollback($r) if $self->error;
173 $$r{'purge_user'} = $username;
175 # assign package if it hasn't been yet
177 die "Unexpected lack of master user on account, please contact a developer"
178 unless $user->{'master_user'} eq 'Y';
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];
192 $self->add_email_address($username,$username.'@'.$svc_acct->domain);
193 return $self->rollback($r) if $self->error;
195 # double-check packages (only throws warnings, no rollback on fail)
196 $self->sync_magic_packages($cust_main, 'include' => $svc_acct);
201 =head2 _export_delete
203 Hook that is called when service is unprovisioned.
204 To avoid confusion, don't use for anything else.
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
211 Also attempts to delete the associated account, if there
212 aren't any more users on the account.
214 If deleted user was master user for account and other
215 users exist on the account, attempts to make another user
218 Runs L</sync_magic_packages>.
220 If the I<autopurge> export option is set, also purges
221 newly deleted users/accounts.
223 Override this method when using this module as a base for other exports.
228 my ($self, $svc_acct) = @_;
230 my $cust_main = $svc_acct->cust_main;
231 my $username = $svc_acct->username;
234 my $user = $self->get_user($username);
236 $self->error("Could not remove user from magicmail, username $username not retrievable");
238 return ''; #non-fatal error, allow svc to be unprovisioned
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
244 # check for master change
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)
253 next unless $users->{uc($somesvc->username)};
254 $newmaster = $somesvc->username;
257 $self->error("Cannot find replacement master user for account $account_id")
260 $self->error_warn; #maybe this should be fatal?
263 # do the actual deleting
264 $self->delete_user($username);
265 return $self->error if $self->error;
267 ## no fatal errors after this point
269 # transfer master user
270 $self->make_master_user($newmaster) if $newmaster;
272 $self->sync_magic_packages($cust_main, 'ignore' => $svc_acct);
274 # purge user if configured to do so
275 $self->purge_user($username) if $self->option('autopurge');
278 # delete account if there are no more users
279 my $users = $self->get_users($account_id);
281 return '' unless $users;
282 return '' if keys %$users;
283 $self->delete_account($account_id);
284 return $self->error_warn if $self->error;
286 #purge account if configured to do so
287 $self->purge_account($account_id) if $self->option('autopurge');
288 return $self->error_warn;
291 =head2 _export_replace
293 Hook that is called when provisioned service is edited.
294 To avoid confusion, don't use for anything else.
296 Updates user info & password. Cannot be used to change user name.
298 Override this method when using this module as a base for other exports.
302 sub _export_replace {
303 my($self, $new, $old) = @_;
305 my $username = $new->username;
307 return "Cannot change username on a magicmail account"
308 unless $username eq $old->username;
311 my $user = $self->get_user($username);
312 return $self->error("Could not update user, username $username not retrievable")
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
319 my ($first,$last) = $new->finger =~ /(.*)\s(.*)/;
320 $first ||= $new->finger || '';
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
328 'password_type' => $new->_password_encryption eq 'plain'
331 # could also add memo
336 =head2 _export_suspend
338 Hook that is called when service is suspended.
339 To avoid confusion, don't use for anything else.
343 sub _export_suspend {
344 my ($self, $svc_acct) = @_;
346 my $username = $svc_acct->username;
349 my $user = $self->get_user($username);
350 return $self->error("Could not update user, username $username not retrievable")
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
357 $self->suspend_user($username);
361 =head2 _export_unsuspend
363 Hook that is called when service is unsuspended.
364 To avoid confusion, don't use for anything else.
368 sub _export_unsuspend {
369 my ($self, $svc_acct) = @_;
371 my $username = $svc_acct->username;
374 my $user = $self->get_user($username);
375 return $self->error("Could not update user, username $username not retrievable")
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
382 $self->activate_user($username);
386 =head1 Freeside Methods
388 These methods are specific to freeside, used to translate
389 freeside customers/services/exports
390 into magicmail accounts/users/packages.
392 =head2 cust_account_id
394 Accepts either I<$cust_main> or I<$svc_acct>.
395 Returns MagicMail account_id for this customer under this export.
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
409 =head2 cust_magic_services
411 Accepts I<$cust_main> or I<$svc_acct> and the following options:
413 I<ignore> - I<$svc_acct> to be ignored
415 I<include> - I<$svc_acct> to be included
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.)
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.
427 sub cust_magic_services {
428 my ($self, $in, %opt) = @_;
429 my $cust_main = ref($in) eq 'FS::cust_main' ? $in : $in->cust_main;
432 $opt{'ignore'} ? ($_->svcnum != $opt{'ignore'}->svcnum) : 1;
435 qsearch('svc_acct', { 'svcnum' => $_->svcnum })
439 ($_->exporttype eq 'magicmail')
440 && ($_->option('account_prefix') eq $self->option('account_prefix'))
443 qsearch('part_export',{ 'exportnum' => $_->exportnum })
445 qsearch('export_svc',{ 'svcpart' => $_->svcpart })
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 }
452 push(@out,$opt{'include'})
453 unless grep { $opt{'include'} ? ($_->svcnum == $opt{'include'}->svcnum) : 1 } @out;
457 =head2 cust_magic_packages
459 Accepts I<$cust_main> or I<$svc_acct> and the same options as L</cust_magic_services>.
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.)
466 sub cust_magic_packages {
467 my ($self, $in, %opt) = @_;
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;
479 =head2 sync_magic_packages
481 Accepts I<$cust_main> or I<$svc_acct> and the same options as L</cust_magic_services>.
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.)
487 All errors will be immediately cleared by L</error_warn>.
488 No meaningful return value.
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)) {
506 $self->assign_package($musername,$want)
507 unless $have->{$want};
509 return $self->error_warn if $self->error;
510 foreach my $dont (keys %dont) {
511 $self->remove_package($musername,$dont)
513 return $self->error_warn;
516 =head1 Helper Methods
518 These methods combine account, user and package information
519 through multiple API requests.
521 =head2 get_accounts_and_users
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>
529 sub get_accounts_and_users {
531 my $accounts = $self->get_accounts() or return;
532 foreach my $account (keys %$accounts) {
533 $accounts->{$account}->{'users'} = $self->get_users($account) or return;
538 =head2 get_master_user
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.
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};
561 #send a request to https://machine/api/v2/some/function
562 my $result = $export->request('POST','/some/function',%args);
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>.
571 Used by other methods to send requests; unless you're editing
572 this module, you should probably be using those other methods instead.
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");
582 my $get = $method eq 'GET';
584 if (exists $args{'ForceArray'}) {
585 $forcearray = delete $args{'ForceArray'};
587 $args{'client_type'} = 'FREESIDE';
589 'host' => $self->machine,
590 'port' => $self->option('port'),
591 'path' => '/api/v2' . $path,
593 'Authorization' => 'Basic ' . MIME::Base64::encode(
594 $self->option('client_id')
596 . $self->option('client_password'),
600 my ( $page, $response, %reply_headers );
603 foreach my $field (keys %args) {
604 $pathargs .= $pathargs ? '&' : '?';
605 $pathargs .= $field . '=' . uri_escape_utf8($args{$field});
607 $request{'path'} .= $pathargs;
608 warn "Request = " . Dumper(\%request) if $self->debug;
609 ( $page, $response, %reply_headers ) = https_get(%request);
611 foreach my $field (keys %args) {
612 $request{'content'} .= '&' if $request{'content'};
613 $request{'content'} .= $field . '=' . uri_escape_utf8($args{$field});
615 warn "Request = " . Dumper(\%request) if $self->debug;
616 ( $page, $response, %reply_headers ) = https_post(%request);
618 unless ($response =~ /^(200|400|500)/) {
619 return if $self->error("Bad Response: $response");
621 warn "Response = " . Dumper($page) if $self->debug;
622 my $result = $page ? XMLin($page, ForceArray => $forcearray) : {};
623 warn "Result = " . Dumper($result) if $self->debug;
627 =head1 Account Methods
629 Make individual account-related API requests.
633 Accepts I<$account_id> and the following options:
643 Returns a hashref containing the created account details.
648 my ($self,$id,%opt) = @_;
649 warn "CREATING ACCOUNT $id\n" if $self->debug;
651 foreach my $field ( qw( first_name last_name phone memo ) ) {
652 $args{$field} = $opt{$field} if $opt{$field};
654 my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), %args );
655 return if $self->check_for_error($result);
656 return $result->{'account'};
661 Accepts I<$account_id>.
662 Returns a hashref containing account details.
663 Returns nothing without setting error if account is not found.
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';
674 return if $self->check_for_error($result);
675 return $result->{'account'};
680 No input. Returns a hashref, keys are account_id, values
681 are hashrefs of account details.
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'} || {};
693 =head2 update_account
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.
702 my ($self,$id,%opt) = @_;
703 warn "UPDATING ACCOUNT $id\n" if $self->debug;
705 foreach my $field ( qw( first_name last_name phone memo ) ) {
706 $args{$field} = $opt{$field} if $opt{$field};
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'};
713 =head2 suspend_account
715 Accepts I<$account_id>. Sets account status to suspended.
716 Returns a hashref containing the updated account details.
720 sub suspend_account {
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'};
728 =head2 activate_account
730 Accepts I<$account_id>. Sets account status to active.
731 Returns a hashref containing the updated account details.
735 sub activate_account {
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'};
743 =head2 delete_account
745 Accepts I<$account_id>. Sets account status to deleted.
746 Returns a hashref containing the updated account details.
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'};
760 Accepts account I<$id> and the following options:
762 I<force> - if true, purges account even if it wasn't first deleted
764 Purges account from system.
765 No meaningful return value.
770 my ($self,$id,%opt) = @_;
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);
781 Make individual user-related API requests.
785 Accepts I<$account_id>, I<$username> and the following options:
795 I<password_type> - plain or encrypted
797 Returns a hashref containing the created user details.
802 my ($self,$account_id,$username,%opt) = @_;
803 warn "CREATING USER $username FOR ACCOUNT $account_id\n" if $self->debug;
805 foreach my $field ( qw( first_name last_name memo password password_type ) ) {
806 $args{$field} = $opt{$field} if $opt{$field};
808 $args{'account'} = $account_id;
809 unless ($account_id) {
810 return if $self->error("Account ID required");
812 if ($args{'password_type'} && !grep(/$args{'password_type'}/,('plain','encrypted'))) {
813 return if $self->error("Illegal password_type $args{'password_type'}");
815 my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), %args );
816 return if $self->check_for_error($result);
817 return $result->{'user'};
822 Accepts I<$username>.
823 Returns a hashref containing user details.
824 Returns nothing without setting error if user is not found.
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';
835 return if $self->check_for_error($result);
836 return $result->{'user'};
841 Accepts I<$account_id>. Returns a hashref, keys are username, values
842 are hashrefs of user details.
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'} || {};
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.
863 my ($self,$account_id,$username,%opt) = @_;
864 warn "UPDATING USER $username\n" if $self->debug;
866 foreach my $field ( qw( first_name last_name memo password password_type ) ) {
867 $args{$field} = $opt{$field} if $opt{$field};
869 if ($args{'password_type'} && !grep(/$args{'password_type'}/,('plain','encrypted'))) {
870 return if $self->error("Illegal password_type $args{'password_type'}");
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'};
878 =head2 make_master_user
880 Accepts I<$username>. Sets user to be master user for account.
881 Returns a hashref containing the updated user details.
883 Caution: does not unmake existing master user.
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),
894 return if $self->check_for_error($result);
895 return $result->{'user'};
900 Accepts I<$username>. Sets user status to suspended.
901 Returns a hashref containing the updated user details.
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'};
915 Accepts I<$username>. Sets user status to active.
916 Returns a hashref containing the updated user details.
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'};
930 Accepts I<$username>. Sets user status to deleted.
931 Returns a hashref containing the updated user details.
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'};
945 Accepts I<$username> and the following options:
947 I<force> - if true, purges user even if it wasn't first deleted
949 Purges user from system.
950 No meaningful return value.
955 my ($self,$username,%opt) = @_;
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);
964 =head1 Package Methods
966 Make individual package-related API requests.
968 =head2 assign_package
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.
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,
984 return if $self->check_for_error($result);
985 return $result->{'packages'}->{'package'};
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.
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'],
1002 return if $self->check_for_error($result);
1003 return $result->{'packages'}->{'package'} || {};
1006 =head2 remove_package
1008 Accepts I<$username> and I<$package>. Removes package from user.
1009 No meaningful return value.
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,
1020 $self->check_for_error($result);
1024 =head1 Domain Methods
1026 Make individual account-related API requests.
1030 ### DOMAIN METHODS HAVEN'T BEEN THOROUGLY TESTED, AREN'T CURRENTLY USED ###
1034 Accepts I<$account_id> and I<$domain>. Creates domain for that account.
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'};
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.
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';
1062 return if $self->check_for_error($result);
1063 return $result->{'domain'};
1068 Accepts I<$account_id>. Returns hasref of domains for that account,
1069 keys are domains, values are hashrefs of info about each domain.
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
1080 return if $self->check_for_error($result);
1081 return $result->{'domains'}->{'domain'} || {};
1084 =head2 remove_domain
1086 Accepts I<$domain>. Removes domain.
1087 No meaningful return value.
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);
1099 =head1 Email Address Methods
1101 Make individual emailaddress-related API requests.
1103 =head2 add_email_address
1105 Accepts I<$username> and I<$address>. Adds address for that user.
1106 Returns hashref of details for new address.
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),
1116 return if $self->check_for_error($result);
1117 return $result->{'emailaddress'};
1120 =head2 get_email_address
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.
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';
1136 return if $self->check_for_error($result);
1137 return $result->{'emailaddress'};
1140 =head2 get_email_addresses
1142 Accepts I<$username>. Returns hasref of email addresses for that account,
1143 keys are domains, values are hashrefs of info about each domain.
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,
1154 return if $self->check_for_error($result);
1155 return $result->{'emailaddresses'}->{'emailaddress'} || {};
1158 =head2 remove_email_address
1160 Accepts I<$address>. Removes address.
1161 No meaningful return value.
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);
1173 =head1 Error Methods
1175 Used to track errors during a request, for precision control over when
1176 and how those errors are returned.
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.
1187 my ($self,$message) = @_;
1188 if (defined($message)) {
1189 $self->{'_error'} .= "\n" if $self->{'_error'};
1190 $self->{'_error'} .= $message;
1192 return $self->{'_error'};
1195 =head2 check_for_error
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>.
1202 sub check_for_error {
1203 my ($self,$result) = @_;
1204 return $self->error("Unknown error, no result found")
1206 return $self->error($result->{'error'}->{'code'} . ': ' . $result->{'error'}->{'message'})
1207 if $result->{'error'};
1208 return $self->error;
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.
1221 $self->{'_error'} = '';
1227 Accepts optional I<$message>, which will be appended to the internal error message on this
1230 Outputs L</error> (if there is one) using warn, then runs L</error_init>.
1231 Returns blank string.
1237 my $message = shift;
1238 $self->error($message) if defined($message);
1239 warn $self->error if $self->error;
1246 Returns true if debug is set, either as an export option or in the module code.
1252 return $DEBUG || $self->option('debug');
1257 Accepts hashref with the following fields, use for undoing recent changes:
1259 I<remove_package> - arrayref of username and package to remove
1261 I<purge_user> - username to be forcefully purged
1263 I<suspend_account> - account_id to be suspended
1265 I<delete_account> - account_id to be deleted
1267 I<purge_account> - account_id to be forcefully purged
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>.
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;
1292 jonathan@freeside.biz