projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
fix applying a credit against an invoice which has had its tax config removed, RT...
[freeside.git] / FS / FS / export_svc.pm
diff --git a/FS/FS/export_svc.pm b/FS/FS/export_svc.pm
index f610b3c..b08f8f7 100644 (file)
--- a/FS/FS/export_svc.pm
+++ b/FS/FS/export_svc.pm
@@ -5,6 +5,7 @@ use vars qw( @ISA );
 use FS::Record qw( qsearch qsearchs dbh );
 use FS::part_export;
 use FS::part_svc;
 use FS::Record qw( qsearch qsearchs dbh );
 use FS::part_export;
 use FS::part_svc;
+use FS::svc_export_machine;
 
 @ISA = qw(FS::Record);
 
 
 @ISA = qw(FS::Record);
 
@@ -60,16 +61,21 @@ points to.  You can ask the object for a copy with the I<hash> method.
 
 sub table { 'export_svc'; }
 
 
 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.
 
 
 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;
 =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';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -82,62 +88,141 @@ sub insert {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  $error = $self->check;
+  my $error = $self->check;
   return $error if $error;
 
   #check for duplicates!
   return $error if $error;
 
   #check for duplicates!
-#TODO:
-#- XXX here
-#
-#- have edit/process/part_svc.cgi redirect with error back to 
-#edit/part_svc.cgi rather than eidiot out
-#
-#- rewrite in SQL for efficiency
-
-  my $label = '';
-  my $method = '';
+  my @checks = ();
   my $svcdb = $self->part_svc->svcdb;
   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 ) {
     if ( $self->part_export->nodomain =~ /^Y/i ) {
-      $label = 'usernames';
-      $method = 'username';
+      push @checks, {
+        label  => 'usernames',
+        method => 'username',
+        sortby => sub { $a cmp $b },
+      };
     } else {
     } 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 {
   } else {
-    warn "WARNING: XXX fill in this warning";
+    warn "WARNING: No duplicate checking done on merge of $svcdb exports";
   }
 
   }
 
-  #warn "$method\n";
-  if ( $method ) {
-    my @current_svc = $self->part_export->svc_x;
-    #warn "current: ". scalar(@current_svc). " $current_svc[0]\n";
-    my @new_svc = $self->part_svc->svc_x;
-    #warn "new: ". scalar(@new_svc). " $new_svc[0]\n";
-    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->part_export->exporttype.
-               ' on '. $self->part_export->machine.
-             ' : '. scalar(@dup_svc). " 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;
 
   $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;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -180,7 +265,23 @@ Delete this record from the database.
 
 =cut
 
 
 =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
 
 
 =item replace OLD_RECORD
 
@@ -236,6 +337,24 @@ sub part_svc {
   qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 }
 
   qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 }
 
+=item svc_export_machine
+
+Returns all export hostname records (L<FS::svc_export_machine>) for this
+combination of svcpart and exportnum.
+
+=cut
+
+sub svc_export_machine {
+  my $self = shift;
+  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
 
 =head1 BUGS
 =back
 
 =head1 BUGS
Freeside billing, trouble ticketing, network monitoring and provisioning