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 'debug' => { type => 'checkbox',
69 label => 'Enable debug warnings' },
74 'desc' => 'Export service to MagicMail, for svc_acct services',
75 'options' => \%options,
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.
88 Hook that is called when service is initially provisioned.
89 To avoid confusion, don't use for anything else.
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>.
99 On success, also runs L</sync_magic_packages> (does not cause fatal
102 Override this method when using this module as a base for other exports.
107 my ($self, $svc_acct) = @_;
109 my $cust_main = $svc_acct->cust_main;
110 my $username = $svc_acct->username;
111 my $r = {}; #rollback input
113 # create customer account if it doesn't exist
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;
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
124 return $self->error if $self->error;
125 $account_id = $account->{'id'};
126 $$r{'purge_account'} = $account_id;
129 # activate account if suspended/deleted
130 my $oldstatus = $account->{'status'};
131 unless ($oldstatus eq 'active') {
132 $account = $self->activate_account($account_id);
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';
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;
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];
156 my ($first,$last) = $svc_acct->finger =~ /(.*)\s(.*)/;
157 $first ||= $svc_acct->finger || '';
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'
168 # could also add memo
170 return $self->rollback($r) if $self->error;
171 $$r{'purge_user'} = $username;
173 # assign package if it hasn't been yet
175 die "Unexpected lack of master user on account, please contact a developer"
176 unless $user->{'master_user'} eq 'Y';
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];
190 $self->add_email_address($username,$username.'@'.$svc_acct->domain);
191 return $self->rollback($r) if $self->error;
193 # double-check packages (only throws warnings, no rollback on fail)
194 $self->sync_magic_packages($cust_main, 'include' => $svc_acct);
199 =head2 _export_delete
201 Hook that is called when service is unprovisioned.
202 To avoid confusion, don't use for anything else.
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
209 Also attempts to delete the associated account, if there
210 aren't any more users on the account.
212 If deleted user was master user for account and other
213 users exist on the account, attempts to make another user
216 Runs L</sync_magic_packages>.
218 If the I<autopurge> export option is set, also purges
219 newly deleted users/accounts.
221 Override this method when using this module as a base for other exports.
226 my ($self, $svc_acct) = @_;
228 my $cust_main = $svc_acct->cust_main;
229 my $username = $svc_acct->username;
232 my $user = $self->get_user($username);
234 $self->error("Could not remove user from magicmail, username $username not retrievable");
236 return ''; #non-fatal error, allow svc to be unprovisioned
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
242 # check for master change
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)
251 next unless $users->{uc($somesvc->username)};
252 $newmaster = $somesvc->username;
255 $self->error("Cannot find replacement master user for account $account_id")
258 $self->error_warn; #maybe this should be fatal?
261 # do the actual deleting
262 $self->delete_user($username);
263 return $self->error if $self->error;
265 ## no fatal errors after this point
267 # transfer master user
268 $self->make_master_user($newmaster) if $newmaster;
270 $self->sync_magic_packages($cust_main, 'ignore' => $svc_acct);
272 # purge user if configured to do so
273 $self->purge_user($username) if $self->option('autopurge');
276 # delete account if there are no more users
277 my $users = $self->get_users($account_id);
279 return '' unless $users;
280 return '' if keys %$users;
281 $self->delete_account($account_id);
282 return $self->error_warn if $self->error;
284 #purge account if configured to do so
285 $self->purge_account($account_id) if $self->option('autopurge');
286 return $self->error_warn;
289 =head2 _export_replace
291 Hook that is called when provisioned service is edited.
292 To avoid confusion, don't use for anything else.
294 Updates user info & password. Cannot be used to change user name.
296 Override this method when using this module as a base for other exports.
300 sub _export_replace {
301 my($self, $new, $old) = @_;
303 my $username = $new->username;
305 return "Cannot change username on a magicmail account"
306 unless $username eq $old->username;
309 my $user = $self->get_user($username);
310 return $self->error("Could not update user, username $username not retrievable")
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
317 my ($first,$last) = $new->finger =~ /(.*)\s(.*)/;
318 $first ||= $new->finger || '';
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
326 'password_type' => $new->_password_encryption eq 'plain'
329 # could also add memo
334 =head2 _export_suspend
336 Hook that is called when service is suspended.
337 To avoid confusion, don't use for anything else.
341 sub _export_suspend {
342 my ($self, $svc_acct) = @_;
344 my $username = $svc_acct->username;
347 my $user = $self->get_user($username);
348 return $self->error("Could not update user, username $username not retrievable")
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
355 $self->suspend_user($username);
359 =head2 _export_unsuspend
361 Hook that is called when service is unsuspended.
362 To avoid confusion, don't use for anything else.
366 sub _export_unsuspend {
367 my ($self, $svc_acct) = @_;
369 my $username = $svc_acct->username;
372 my $user = $self->get_user($username);
373 return $self->error("Could not update user, username $username not retrievable")
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
380 $self->activate_user($username);
384 =head1 Freeside Methods
386 These methods are specific to freeside, used to translate
387 freeside customers/services/exports
388 into magicmail accounts/users/packages.
390 =head2 cust_account_id
392 Accepts either I<$cust_main> or I<$svc_acct>.
393 Returns MagicMail account_id for this customer under this export.
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;
403 =head2 cust_magic_services
405 Accepts I<$cust_main> or I<$svc_acct> and the following options:
407 I<ignore> - I<$svc_acct> to be ignored
409 I<include> - I<$svc_acct> to be included
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.)
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.
421 sub cust_magic_services {
422 my ($self, $in, %opt) = @_;
423 my $cust_main = ref($in) eq 'FS::cust_main' ? $in : $in->cust_main;
426 $opt{'ignore'} ? ($_->svcnum != $opt{'ignore'}->svcnum) : 1;
429 qsearch('svc_acct', { 'svcnum' => $_->svcnum })
433 ($_->exporttype eq 'magicmail')
434 && ($_->option('account_prefix') eq $self->option('account_prefix'))
437 qsearch('part_export',{ 'exportnum' => $_->exportnum })
439 qsearch('export_svc',{ 'svcpart' => $_->svcpart })
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 }
446 push(@out,$opt{'include'})
447 unless grep { $opt{'include'} ? ($_->svcnum == $opt{'include'}->svcnum) : 1 } @out;
451 =head2 cust_magic_packages
453 Accepts I<$cust_main> or I<$svc_acct> and the same options as L</cust_magic_services>.
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.)
460 sub cust_magic_packages {
461 my ($self, $in, %opt) = @_;
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;
473 =head2 sync_magic_packages
475 Accepts I<$cust_main> or I<$svc_acct> and the same options as L</cust_magic_services>.
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.)
481 All errors will be immediately cleared by L</error_warn>.
482 No meaningful return value.
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)) {
500 $self->assign_package($musername,$want)
501 unless $have->{$want};
503 return $self->error_warn if $self->error;
504 foreach my $dont (keys %dont) {
505 $self->remove_package($musername,$dont)
507 return $self->error_warn;
510 =head1 Helper Methods
512 These methods combine account, user and package information
513 through multiple API requests.
515 =head2 get_accounts_and_users
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>
523 sub get_accounts_and_users {
525 my $accounts = $self->get_accounts() or return;
526 foreach my $account (keys %$accounts) {
527 $accounts->{$account}->{'users'} = $self->get_users($account) or return;
532 =head2 get_master_user
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.
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};
555 #send a request to https://machine/api/v2/some/function
556 my $result = $export->request('POST','/some/function',%args);
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>.
565 Used by other methods to send requests; unless you're editing
566 this module, you should probably be using those other methods instead.
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");
576 my $get = $method eq 'GET';
578 if (exists $args{'ForceArray'}) {
579 $forcearray = delete $args{'ForceArray'};
581 $args{'client_type'} = 'FREESIDE';
583 'host' => $self->machine,
584 'port' => $self->option('port'),
585 'path' => '/api/v2' . $path,
587 'Authorization' => 'Basic ' . MIME::Base64::encode(
588 $self->option('client_id')
590 . $self->option('client_password'),
594 my ( $page, $response, %reply_headers );
597 foreach my $field (keys %args) {
598 $pathargs .= $pathargs ? '&' : '?';
599 $pathargs .= $field . '=' . uri_escape_utf8($args{$field});
601 $request{'path'} .= $pathargs;
602 warn "Request = " . Dumper(\%request) if $self->debug;
603 ( $page, $response, %reply_headers ) = https_get(%request);
605 foreach my $field (keys %args) {
606 $request{'content'} .= '&' if $request{'content'};
607 $request{'content'} .= $field . '=' . uri_escape_utf8($args{$field});
609 warn "Request = " . Dumper(\%request) if $self->debug;
610 ( $page, $response, %reply_headers ) = https_post(%request);
612 unless ($response =~ /^(200|400|500)/) {
613 return if $self->error("Bad Response: $response");
615 warn "Response = " . Dumper($page) if $self->debug;
616 my $result = $page ? XMLin($page, ForceArray => $forcearray) : {};
617 warn "Result = " . Dumper($result) if $self->debug;
621 =head1 Account Methods
623 Make individual account-related API requests.
627 Accepts I<$account_id> and the following options:
637 Returns a hashref containing the created account details.
642 my ($self,$id,%opt) = @_;
643 warn "CREATING ACCOUNT $id\n" if $self->debug;
645 foreach my $field ( qw( first_name last_name phone memo ) ) {
646 $args{$field} = $opt{$field} if $opt{$field};
648 my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), %args );
649 return if $self->check_for_error($result);
650 return $result->{'account'};
655 Accepts I<$account_id>.
656 Returns a hashref containing account details.
657 Returns nothing without setting error if account is not found.
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';
668 return if $self->check_for_error($result);
669 return $result->{'account'};
674 No input. Returns a hashref, keys are account_id, values
675 are hashrefs of account details.
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'} || {};
687 =head2 update_account
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.
696 my ($self,$id,%opt) = @_;
697 warn "UPDATING ACCOUNT $id\n" if $self->debug;
699 foreach my $field ( qw( first_name last_name phone memo ) ) {
700 $args{$field} = $opt{$field} if $opt{$field};
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'};
707 =head2 suspend_account
709 Accepts I<$account_id>. Sets account status to suspended.
710 Returns a hashref containing the updated account details.
714 sub suspend_account {
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'};
722 =head2 activate_account
724 Accepts I<$account_id>. Sets account status to active.
725 Returns a hashref containing the updated account details.
729 sub activate_account {
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'};
737 =head2 delete_account
739 Accepts I<$account_id>. Sets account status to deleted.
740 Returns a hashref containing the updated account details.
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'};
754 Accepts account I<$id> and the following options:
756 I<force> - if true, purges account even if it wasn't first deleted
758 Purges account from system.
759 No meaningful return value.
764 my ($self,$id,%opt) = @_;
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);
775 Make individual user-related API requests.
779 Accepts I<$account_id>, I<$username> and the following options:
789 I<password_type> - plain or encrypted
791 Returns a hashref containing the created user details.
796 my ($self,$account_id,$username,%opt) = @_;
797 warn "CREATING USER $username FOR ACCOUNT $account_id\n" if $self->debug;
799 foreach my $field ( qw( first_name last_name memo password password_type ) ) {
800 $args{$field} = $opt{$field} if $opt{$field};
802 $args{'account'} = $account_id;
803 unless ($account_id) {
804 return if $self->error("Account ID required");
806 if ($args{'password_type'} && !grep(/$args{'password_type'}/,('plain','encrypted'))) {
807 return if $self->error("Illegal password_type $args{'password_type'}");
809 my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), %args );
810 return if $self->check_for_error($result);
811 return $result->{'user'};
816 Accepts I<$username>.
817 Returns a hashref containing user details.
818 Returns nothing without setting error if user is not found.
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';
829 return if $self->check_for_error($result);
830 return $result->{'user'};
835 Accepts I<$account_id>. Returns a hashref, keys are username, values
836 are hashrefs of user details.
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'} || {};
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.
857 my ($self,$account_id,$username,%opt) = @_;
858 warn "UPDATING USER $username\n" if $self->debug;
860 foreach my $field ( qw( first_name last_name memo password password_type ) ) {
861 $args{$field} = $opt{$field} if $opt{$field};
863 if ($args{'password_type'} && !grep(/$args{'password_type'}/,('plain','encrypted'))) {
864 return if $self->error("Illegal password_type $args{'password_type'}");
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'};
872 =head2 make_master_user
874 Accepts I<$username>. Sets user to be master user for account.
875 Returns a hashref containing the updated user details.
877 Caution: does not unmake existing master user.
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),
888 return if $self->check_for_error($result);
889 return $result->{'user'};
894 Accepts I<$username>. Sets user status to suspended.
895 Returns a hashref containing the updated user details.
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'};
909 Accepts I<$username>. Sets user status to active.
910 Returns a hashref containing the updated user details.
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'};
924 Accepts I<$username>. Sets user status to deleted.
925 Returns a hashref containing the updated user details.
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'};
939 Accepts I<$username> and the following options:
941 I<force> - if true, purges user even if it wasn't first deleted
943 Purges user from system.
944 No meaningful return value.
949 my ($self,$username,%opt) = @_;
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);
958 =head1 Package Methods
960 Make individual package-related API requests.
962 =head2 assign_package
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.
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,
978 return if $self->check_for_error($result);
979 return $result->{'packages'}->{'package'};
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.
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'],
996 return if $self->check_for_error($result);
997 return $result->{'packages'}->{'package'} || {};
1000 =head2 remove_package
1002 Accepts I<$username> and I<$package>. Removes package from user.
1003 No meaningful return value.
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,
1014 $self->check_for_error($result);
1018 =head1 Domain Methods
1020 Make individual account-related API requests.
1024 ### DOMAIN METHODS HAVEN'T BEEN THOROUGLY TESTED, AREN'T CURRENTLY USED ###
1028 Accepts I<$account_id> and I<$domain>. Creates domain for that account.
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'};
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.
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';
1056 return if $self->check_for_error($result);
1057 return $result->{'domain'};
1062 Accepts I<$account_id>. Returns hasref of domains for that account,
1063 keys are domains, values are hashrefs of info about each domain.
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
1074 return if $self->check_for_error($result);
1075 return $result->{'domains'}->{'domain'} || {};
1078 =head2 remove_domain
1080 Accepts I<$domain>. Removes domain.
1081 No meaningful return value.
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);
1093 =head1 Email Address Methods
1095 Make individual emailaddress-related API requests.
1097 =head2 add_email_address
1099 Accepts I<$username> and I<$address>. Adds address for that user.
1100 Returns hashref of details for new address.
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),
1110 return if $self->check_for_error($result);
1111 return $result->{'emailaddress'};
1114 =head2 get_email_address
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.
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';
1130 return if $self->check_for_error($result);
1131 return $result->{'emailaddress'};
1134 =head2 get_email_addresses
1136 Accepts I<$username>. Returns hasref of email addresses for that account,
1137 keys are domains, values are hashrefs of info about each domain.
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,
1148 return if $self->check_for_error($result);
1149 return $result->{'emailaddresses'}->{'emailaddress'} || {};
1152 =head2 remove_email_address
1154 Accepts I<$address>. Removes address.
1155 No meaningful return value.
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);
1167 =head1 Error Methods
1169 Used to track errors during a request, for precision control over when
1170 and how those errors are returned.
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.
1181 my ($self,$message) = @_;
1182 if (defined($message)) {
1183 $self->{'_error'} .= "\n" if $self->{'_error'};
1184 $self->{'_error'} .= $message;
1186 return $self->{'_error'};
1189 =head2 check_for_error
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>.
1196 sub check_for_error {
1197 my ($self,$result) = @_;
1198 return $self->error("Unknown error, no result found")
1200 return $self->error($result->{'error'}->{'code'} . ': ' . $result->{'error'}->{'message'})
1201 if $result->{'error'};
1202 return $self->error;
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.
1215 $self->{'_error'} = '';
1221 Accepts optional I<$message>, which will be appended to the internal error message on this
1224 Outputs L</error> (if there is one) using warn, then runs L</error_init>.
1225 Returns blank string.
1231 my $message = shift;
1232 $self->error($message) if defined($message);
1233 warn $self->error if $self->error;
1240 Returns true if debug is set, either as an export option or in the module code.
1246 return $DEBUG || $self->option('debug');
1251 Accepts hashref with the following fields, use for undoing recent changes:
1253 I<remove_package> - arrayref of username and package to remove
1255 I<purge_user> - username to be forcefully purged
1257 I<suspend_account> - account_id to be suspended
1259 I<delete_account> - account_id to be deleted
1261 I<purge_account> - account_id to be forcefully purged
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>.
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;
1286 jonathan@freeside.biz
1288 =head1 LICENSE AND COPYRIGHT
1290 Copyright 2015 Freeside Internet Services
1292 This program is free software; you can redistribute it and/or
1293 modify it under the terms of the GNU General Public License
1294 as published by the Free Software Foundation.