X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fexport_svc.pm;h=4579e6d4a535a8f2b1d21b61e89d412c7ba784a5;hp=9a7178e6e3725eedd9ec2dd7a0b61a0cd5c699c4;hb=57bb423fe457ba4e13726877f53bcdf944f828f8;hpb=5a588517044ae46cbfc4e544e9306f0aee8f34c3

diff --git a/FS/FS/export_svc.pm b/FS/FS/export_svc.pm
index 9a7178e6e..4579e6d4a 100644
--- a/FS/FS/export_svc.pm
+++ b/FS/FS/export_svc.pm
@@ -1,12 +1,9 @@
 package FS::export_svc;
+use base qw(FS::Record);
 
 use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::part_export;
-use FS::part_svc;
-
-@ISA = qw(FS::Record);
+use FS::Record qw( dbh qsearch ); #qsearchs );
+use FS::svc_export_machine;
 
 =head1 NAME
 
@@ -41,6 +38,8 @@ The following fields are currently supported:
 
 =item svcpart - service definition (see L<FS::part_svc>)
 
+=item role - export role (see export parameters)
+
 =back
 
 =head1 METHODS
@@ -60,16 +59,21 @@ points to.  You can ask the object for a copy with the I<hash> method.
 
 sub table { 'export_svc'; }
 
-=item insert
+=item insert [ JOB, OFFSET, MULTIPLIER ]
 
 Adds this record to the database.  If there is an error, returns the error,
 otherwise returns false.
 
+TODOC: JOB, OFFSET, MULTIPLIER
+
 =cut
 
 sub insert {
   my $self = shift;
-  my $error;
+  my( $job, $offset, $mult ) = ( '', 0, 100);
+  $job = shift if @_;
+  $offset = shift if @_;
+  $mult = shift if @_;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -82,52 +86,141 @@ sub insert {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  $error = $self->check;
+  my $error = $self->check;
   return $error if $error;
 
   #check for duplicates!
-
-  my $label = '';
-  my $method = '';
+  my @checks = ();
   my $svcdb = $self->part_svc->svcdb;
-  if ( $svcdb eq 'svc_acct' ) { #XXX AND UID!  sheesh @method or %method not $method
+  if ( $svcdb eq 'svc_acct' ) {
+
     if ( $self->part_export->nodomain =~ /^Y/i ) {
-      $label = 'usernames';
-      $method = 'username';
+      push @checks, {
+        label  => 'usernames',
+        method => 'username',
+        sortby => sub { $a cmp $b },
+      };
     } else {
-      $label = 'username@domain';
-      $method = 'email';
+      push @checks, {
+        label  => 'username@domain',
+        method => 'email',
+        sortby => sub {
+                        my($auser, $adomain) = split('@', $a);
+                        my($buser, $bdomain) = split('@', $b);
+                        $adomain cmp $bdomain || $auser cmp $buser;
+                      },
+      };
     }
-  } elsif ( $svcdb eq 'domain' ) {
-    $label = 'domains';
-    $method = 'domain';
+
+    unless ( $self->part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
+      push @checks, {
+        label  => 'uids',
+        method => 'uid',
+        sortby => sub { $a <=> $b },
+      };
+    }
+
+  } elsif ( $svcdb eq 'svc_domain' ) {
+    push @checks, {
+      label  => 'domains',
+      method => 'domain',
+      sortby => sub { $a cmp $b },
+    };
   } else {
-    warn "WARNING: XXX fill in this warning";
+    warn "WARNING: No duplicate checking done on merge of $svcdb exports";
   }
 
-  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
+  if ( @checks ) {
+  
+    my $done = 0;
+    my $percheck = $mult / scalar(@checks);
+
+    foreach my $check ( @checks ) {
+  
+      if ( $job ) {
+        $error = $job->update_statustext(int( $offset + ($done+.33) *$percheck ));
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return $error;
+        }
+      }
+  
+      my @current_svc = $self->part_export->svc_x;
+      #warn "current: ". scalar(@current_svc). " $current_svc[0]\n";
+  
+      if ( $job ) {
+        $error = $job->update_statustext(int( $offset + ($done+.67) *$percheck ));
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return $error;
+        }
+      }
+  
+      my @new_svc = $self->part_svc->svc_x;
+      #warn "new: ". scalar(@new_svc). " $new_svc[0]\n";
+  
+      if ( $job ) {
+        $error = $job->update_statustext(int( $offset + ($done+1) *$percheck ));
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return $error;
+        }
+      }
+  
+      my $method = $check->{'method'};
+      my %cur_svc = map { $_->$method() => $_ } @current_svc;
+      my @dup_svc = grep { $cur_svc{$_->$method()} } @new_svc;
+      #my @diff_customer = grep { 
+      #                           $_->cust_pkg->custnum != $cur_svc{$_->$method()}->cust_pkg->custnum
+      #                         } @dup_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;
+  
+        my @diff_customer_svc = grep {
+          my $cust_pkg = $_->cust_svc->cust_pkg;
+          my $custnum = $cust_pkg ? $cust_pkg->custnum : 0;
+          my $other_cust_pkg = $cur_svc{$_->$method()}->cust_svc->cust_pkg;
+          my $other_custnum = $other_cust_pkg ? $other_cust_pkg->custnum : 0;
+          $custnum != $other_custnum;
+        } @dup_svc;
+  
+        my $label = $check->{'label'};
+        my $sortby = $check->{'sortby'};
+        return "Can't export ".
+               $self->part_svc->svcpart.':'.$self->part_svc->svc. " service to ".
+               $self->part_export->exportnum.':'.$self->part_export->exporttype.
+                 ' on '. $self->part_export->machine.
+               ' : '. scalar(@dup_svc). " duplicate $label".
+               ' ('. scalar(@diff_customer_svc). " from different customers)".
+               ": ". join(', ', sort $sortby map { $_->$method() } @dup_svc )
+               #": ". join(', ', sort $sortby map { $_->$method() } @diff_customer_svc )
+               ;
+      }
+  
+      $done++;
     }
-  }
 
-  #end of duplicate check, whew
+  } #end of duplicate check, whew
 
   $error = $self->SUPER::insert;
+
+  my $part_export = $self->part_export;
+  if ( !$error and $part_export->default_machine ) {
+    foreach my $cust_svc ( $self->part_svc->cust_svc ) {
+      my $svc_export_machine = FS::svc_export_machine->new({
+          'exportnum'   => $self->exportnum,
+          'svcnum'      => $cust_svc->svcnum,
+          'machinenum'  => $part_export->default_machine,
+      });
+      $error ||= $svc_export_machine->insert;
+    }
+  }
+
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -170,7 +263,23 @@ Delete this record from the database.
 
 =cut
 
-# the delete method can be inherited from FS::Record
+sub delete {
+  my $self = shift;
+  my $dbh = dbh;
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+
+  my $error = $self->SUPER::delete;
+  foreach ($self->svc_export_machine) {
+    $error ||= $_->delete;
+  }
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+}
+
 
 =item replace OLD_RECORD
 
@@ -200,30 +309,50 @@ sub check {
     || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum')
     || $self->ut_number('svcpart')
     || $self->ut_foreign_key('svcpart', 'part_svc', 'svcpart')
+    || $self->ut_alphan('role')
     || $self->SUPER::check
   ;
+
+  my $part_export = $self->part_export;
+  if ( exists $part_export->info->{roles} ) {
+    my $role = $self->get('role');
+    if ( ! $role ) {
+      return 'must select an export role'
+    }
+    if ( ! exists($part_export->info->{roles}->{$role}) ) {
+      return "invalid role for export '".$part_export->exporttype."'";
+    }
+  } else {
+    $self->set('role', '');
+  }
+
+  '';
 }
 
 =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>).
 
+=item svc_export_machine
+
+Returns all export hostname records (L<FS::svc_export_machine>) for this
+combination of svcpart and exportnum.
+
 =cut
 
-sub part_svc {
+sub svc_export_machine {
   my $self = shift;
-  qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
+  qsearch({
+    'table'     => 'svc_export_machine',
+    'select'    => 'svc_export_machine.*',
+    'addl_from' => 'JOIN cust_svc USING (svcnum)',
+    'hashref'   => { 'exportnum' => $self->exportnum },
+    'extra_sql' => ' AND cust_svc.svcpart = '.$self->svcpart,
+  });
 }
 
 =back