export svc_mailinglist to CGP groups, RT#7514

4 files changed, 217 insertions, 9 deletions

diff --git a/FS/FS/mailinglist.pm b/FS/FS/mailinglist.pm
index db1502c..1294610 100644
--- a/FS/FS/mailinglist.pm
+++ b/FS/FS/mailinglist.pm
@@ -2,8 +2,9 @@ package FS::mailinglist;
 
 use strict;
 use base qw( FS::Record );
-use FS::Record qw( qsearch dbh ); # qsearchs );
+use FS::Record qw( qsearch qsearchs dbh );
 use FS::mailinglistmember;
+use FS::svc_mailinglist;
 
 =head1 NAME
 
@@ -148,6 +149,15 @@ sub mailinglistmember {
   qsearch('mailinglistmember', { 'listnum' => $self->listnum } );
 }
 
+=item svc_mailinglist
+
+=cut
+
+sub svc_mailinglist {
+  my $self = shift;
+  qsearchs('svc_mailinglist', { 'listnum' => $self->listnum } );
+}
+
 =back
 
 =head1 BUGS
diff --git a/FS/FS/mailinglistmember.pm b/FS/FS/mailinglistmember.pm
index ca73b88..49688d8 100644
--- a/FS/FS/mailinglistmember.pm
+++ b/FS/FS/mailinglistmember.pm
@@ -2,7 +2,8 @@ package FS::mailinglistmember;
 
 use strict;
 use base qw( FS::Record );
-use FS::Record qw( qsearchs ); # qsearch );
+use Scalar::Util qw( blessed );
+use FS::Record qw( dbh qsearchs ); # qsearch );
 use FS::mailinglist;
 use FS::svc_acct;
 use FS::contact_email;
@@ -82,7 +83,30 @@ otherwise returns false.
 
 =cut
 
-# the insert method can be inherited from FS::Record
+sub insert {
+  my $self = shift;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error =    $self->SUPER::insert
+              || $self->export('mailinglistmember_insert');
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+}
 
 =item delete
 
@@ -90,7 +114,30 @@ Delete this record from the database.
 
 =cut
 
-# the delete method can be inherited from FS::Record
+sub delete {
+  my $self = shift;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error =    $self->SUPER::delete
+              || $self->export('mailinglistmember_delete');
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+}
 
 =item replace OLD_RECORD
 
@@ -99,7 +146,34 @@ returns the error, otherwise returns false.
 
 =cut
 
-# the replace method can be inherited from FS::Record
+sub replace {
+  my $new = shift;
+
+  my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
+              ? shift
+              : $new->replace_old;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error =    $new->SUPER::replace($old)
+              || $new->export('mailinglistmember_replace', $old);
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+}
 
 =item check
 
@@ -136,6 +210,27 @@ sub mailinglist {
   qsearchs('mailinglist', { 'listnum' => $self->listnum } );
 }
 
+=item email_address
+
+=cut
+
+sub email_address {
+  my $self = shift;
+  #XXX svcnum, contactemailnum
+  $self->email;
+}
+
+=item export
+
+=cut
+
+sub export {
+  my( $self, $method ) = ( shift, shift );
+  my $svc_mailinglist = $self->mailinglist->svc_mailinglist
+    or return '';
+  $svc_mailinglist->export($method, $self, @_);
+}
+
 =back
 
 =head1 BUGS
diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm
index 2084f15..7f5cece 100644
--- a/FS/FS/part_export/communigate_pro.pm
+++ b/FS/FS/part_export/communigate_pro.pm
@@ -33,11 +33,11 @@ tie %options, 'Tie::IxHash',
 ;
 
 %info = (
-  'svc'     => [qw( svc_acct svc_domain svc_forward )],
-  'desc'    => 'Real-time export of accounts and domains to a CommuniGate Pro mail server',
+  'svc'     => [qw( svc_acct svc_domain svc_forward svc_mailinglist )],
+  'desc'    => 'Real-time export of accounts, domains, mail forwards and mailing lists to a CommuniGate Pro mail server',
   'options' => \%options,
   'notes'   => <<'END'
-Real time export of accounts and domains to a
+Real time export of accounts, domains, mail forwards and mailing lists to a
 <a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a>
 mail server.  The
 <a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a>
@@ -200,6 +200,31 @@ sub _export_insert_svc_forward {
   '';
 }
 
+sub _export_insert_svc_mailinglist {
+  my( $self, $svc_mlist ) = (shift, shift);
+
+  my @members = map $_->email_address,
+                    $svc_mlist->mailinglist->mailinglistmember;
+
+  #real-time here, presuming CGP does some dup detection
+  eval { $self->communigate_pro_runcommand(
+           'CreateGroup',
+           $svc_mlist->username.'@'.$svc_mlist->domain,
+           { 'RealName'      => $svc_mlist->listname,
+             'SetReplyTo'    => ( $svc_mlist->reply_to         ? 'YES' : 'NO' ),
+             'RemoveAuthor'  => ( $svc_mlist->remove_from      ? 'YES' : 'NO' ),
+             'RejectAuto'    => ( $svc_mlist->reject_auto      ? 'YES' : 'NO' ),
+             'RemoveToAndCc' => ( $svc_mlist->remove_to_and_cc ? 'YES' : 'NO' ),
+             'Members'       => \@members,
+           }
+         );
+       };
+  return $@ if $@;
+
+  '';
+
+}
+
 sub _export_replace {
   my( $self, $new, $old ) = (shift, shift, shift);
 
@@ -385,6 +410,39 @@ sub _export_replace_svc_forward {
   '';
 }
 
+sub _export_replace_svc_mailinglist {
+  my( $self, $new, $old ) = (shift, shift, shift);
+
+  my $oldGroupName = $old->username.'@'.$old->domain;
+  my $newGroupName = $new->username.'@'.$new->domain;
+
+  if ( $oldGroupName ne $newGroupName ) {
+    eval { $self->communigate_pro_runcommand(
+             'RenameGroup', $oldGroupName, $newGroupName ); };
+    return $@ if $@;
+  }
+
+  my @members = map $_->email_address,
+                $new->mailinglist->mailinglistmember;
+
+  #real-time here, presuming CGP does some dup detection
+  eval { $self->communigate_pro_runcommand(
+           'SetGroup', $newGroupName,
+           { 'RealName'      => $new->listname,
+             'SetReplyTo'    => ( $new->reply_to         ? 'YES' : 'NO' ),
+             'RemoveAuthor'  => ( $new->remove_from      ? 'YES' : 'NO' ),
+             'RejectAuto'    => ( $new->reject_auto      ? 'YES' : 'NO' ),
+             'RemoveToAndCc' => ( $new->remove_to_and_cc ? 'YES' : 'NO' ),
+             'Members'       => \@members,
+           }
+         );
+       };
+  return $@ if $@;
+
+  '';
+
+}
+
 sub _export_delete {
   my( $self, $svc_x ) = (shift, shift);
 
@@ -418,6 +476,21 @@ sub _export_delete_svc_forward {
   );
 }
 
+sub _export_delete_svc_mailinglist {
+  my( $self, $svc_mailinglist ) = (shift, shift);
+
+  #real-time here, presuming CGP does some dup detection
+  eval { $self->communigate_pro_runcommand(
+           'DeleteGroup',
+           $svc_mailinglist->username.'@'.$svc_mailinglist->domain,
+         );
+       };
+  return $@ if $@;
+
+  '';
+
+}
+
 sub _export_suspend {
   my( $self, $svc_x ) = (shift, shift);
 
@@ -479,6 +552,20 @@ sub _export_unsuspend_svc_domain {
 
 }
 
+sub export_mailinglistmember_insert {
+  my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift);
+  $svc_mailinglist->replace();
+}
+
+sub export_mailinglistmember_replace {
+  my( $self, $svc_mailinglist, $new, $old ) = (shift, shift, shift, shift);
+  die "no way to do this from the UI right now";
+}
+
+sub export_mailinglistmember_delete {
+  my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift);
+  $svc_mailinglist->replace();
+}
 
 sub export_getsettings {
   my($self, $svc_x) = (shift, shift);
@@ -647,6 +734,22 @@ sub export_getsettings_svc_acct {
 
 }
 
+sub export_getsettings_svc_mailinglist {
+  my($self, $svc_mailinglist, $settingsref, $defaultref ) = @_;
+
+  my $settings = eval { $self->communigate_pro_runcommand(
+    'GetGroup',
+    $svc_mailinglist->username.'@'.$svc_mailinglist->domain,
+  ) };
+  return $@ if $@;
+
+  $settings->{'Members'} = join(', ', @{ $settings->{'Members'} } );
+
+  %{$settingsref} = %$settings;
+
+  '';
+}
+
 sub communigate_pro_queue {
   my( $self, $svcnum, $method ) = (shift, shift, shift);
   my $jobnum = ''; #don't actually care
diff --git a/FS/FS/svc_mailinglist.pm b/FS/FS/svc_mailinglist.pm
index 9c1a09d..ba297ee 100644
--- a/FS/FS/svc_mailinglist.pm
+++ b/FS/FS/svc_mailinglist.pm
@@ -2,6 +2,7 @@ package FS::svc_mailinglist;
 
 use strict;
 use base qw( FS::svc_Domain_Mixin FS::svc_Common );
+use Scalar::Util qw( blessed );
 use FS::Record qw( qsearchs dbh ); # qsearch );
 use FS::svc_domain;
 use FS::mailinglist;
@@ -160,7 +161,6 @@ sub insert {
       $dbh->rollback if $oldAutoCommit;
       return $error;
     }
-    warn $mailinglist->listnum;
     $self->listnum($mailinglist->listnum);
   #}