first try at duplicate checking on new export associations

3 files changed, 144 insertions, 5 deletions

diff --git a/FS/FS/export_svc.pm b/FS/FS/export_svc.pm
index da9ac698a..052ef2594 100644
--- a/FS/FS/export_svc.pm
+++ b/FS/FS/export_svc.pm
@@ -2,7 +2,7 @@ package FS::export_svc;
 
 use strict;
 use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
+use FS::Record qw( qsearch qsearchs dbh );
 use FS::part_export;
 use FS::part_svc;
 
@@ -67,7 +67,102 @@ otherwise returns false.
 
 =cut
 
-# the insert method can be inherited from FS::Record
+sub insert {
+  my $self = shift;
+  my $error;
+
+  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;
+
+  $error = $self->check;
+  return $error if $error;
+
+  #check for duplicates!
+
+  my $label = '';
+  my $method = '';
+  my $svcdb = $self->part_svc->svcdb;
+  if ( $svcdb eq 'svc_acct' ) { #XXX AND UID!  sheesh @method or %method not $method
+    if ( $self->part_export->nodomain =~ /^Y/i ) {
+      $label = 'usernames';
+      $method = 'username';
+    } else {
+      $label = 'username@domain';
+      $method = 'email';
+    }
+  } elsif ( $svcdb eq 'domain' ) {
+    $label = 'domains';
+    $method = 'domain';
+  } else {
+    warn "WARNING: XXX fill in this warning";
+  }
+
+  if ( $method ) {
+    my @current_svc = $self->part_export->svc_x;
+    my @new_svc = $self->part_svc->svc_x;
+    my %cur_svc = map { $_->$method() => 1 } @current_svc;
+    my @dup_svc = grep { $cur_svc{$_->method()} } @new_svc;
+
+    if ( @dup_svc ) { #aye, that's the rub
+      #error out for now, eventually accept different options of adjustments
+      # to make to allow us to continue forward
+      $dbh->rollback if $oldAutoCommit;
+      return "Can't export ".
+             $self->part_svc->svcpart.':'.$self->part_svc->svc. " service to ".
+             $self->part_export->exportnum.':'.$self->exporttype.
+               ' on '. $self->machine.
+             " : Duplicate $label: ".
+               join(', ', sort map { $_->method() } @dup_svc );
+             #XXX eventually a sort sub so usernames and domains are default alpha, username@domain is domain first then username, and uid is numeric
+    }
+  }
+
+  #end of duplicate check, whew
+
+  $error = $self->SUPER::insert;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+#  if ( $self->part_svc->svcdb eq 'svc_acct' ) {
+#
+#    if ( $self->part_export->nodomain =~ /^Y/i ) {
+#
+#      select username from svc_acct where svcpart = $svcpart
+#        group by username having count(*) > 1;
+#
+#    } else {
+#
+#      select username, domain
+#        from   svc_acct
+#          join svc_domain on ( svc_acct.domsvc = svc_domain.svcnum )
+#        group by username, domain having count(*) > 1;
+#
+#    }
+#
+#  } elsif ( $self->part_svc->svcdb eq 'svc_domain' ) {
+#
+#    #similar but easier domain checking one
+#
+#  } #etc.?
+#
+#  my @services =
+#    map  { $_->part_svc }
+#    grep { $_->svcpart != $self->svcpart }
+#         $self->part_export->export_svc;
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  ''; #no error
+}
 
 =item delete
 
@@ -108,6 +203,28 @@ sub check {
   ;
 }
 
+=item part_export
+
+Returns the FS::part_export object (see L<FS::part_export>).
+
+=cut
+
+sub part_export {
+  my $self = shift;
+  qsearchs( 'part_export', { 'exportnum' => $self->exportnum } );
+}
+
+=item part_svc
+
+Returns the FS::part_svc object (see L<FS::part_svc>).
+
+=cut
+
+sub part_svc {
+  my $self = shift;
+  qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
+}
+
 =back
 
 =head1 BUGS
diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm
index 552019acb..f7677d487 100644
--- a/FS/FS/part_svc.pm
+++ b/FS/FS/part_svc.pm
@@ -6,6 +6,7 @@ use FS::Record qw( qsearch qsearchs fields dbh );
 use FS::part_svc_column;
 use FS::part_export;
 use FS::export_svc;
+use FS::cust_svc;
 
 @ISA = qw(FS::Record);
 
@@ -326,6 +327,28 @@ sub part_export {
     qsearch('export_svc', { 'svcpart' => $self->svcpart } );
 }
 
+=item cust_svc
+
+Returns a list of associated FS::cust_svc records.
+
+=cut
+
+sub cust_svc {
+  my $self = shift;
+  qsearch('cust_svc', { 'svcpart' => $self->svcpart } );
+}
+
+=item svc_x
+
+Returns a list of associated FS::svc_* records.
+
+=cut
+
+sub svc_x {
+  my $self = shift;
+  map { $_->svc_x } $self->cust_svc;
+}
+
 =back
 
 =head1 BUGS
diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 0824fbe3a..806e793ea 100644
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -249,7 +249,7 @@ sub insert {
     $self->svcpart($cust_svc->svcpart);
   }
 
-  #new duplicate username checking
+  #new duplicate username/username@domain/uid checking
 
   my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
   unless ( $part_svc ) {
@@ -276,8 +276,7 @@ sub insert {
     foreach my $part_export ( $part_svc->part_export ) {
 
       #this will catch to the same exact export
-      my @svcparts = map { $_->svcpart }
-        qsearch('export_svc', { 'exportnum' => $part_export->exportnum });
+      my @svcparts = map { $_->svcpart } $part_export->export_svc;
 
       #this will catch to exports w/same exporthost+type ???
       #my @other_part_export = qsearch('part_export', {