fix deletion of accounts connected to virtual hosts
[freeside.git] / FS / FS / cust_pkg.pm
index bd3d1f5..a62c44e 100644 (file)
@@ -1,8 +1,7 @@
 package FS::cust_pkg;
 
 use strict;
-use vars qw(@ISA $disable_agentcheck);
-use vars qw( $quiet );
+use vars qw(@ISA $disable_agentcheck $DEBUG);
 use FS::UID qw( getotaker dbh );
 use FS::Record qw( qsearch qsearchs );
 use FS::cust_svc;
@@ -16,6 +15,7 @@ use FS::cust_bill_pkg;
 # setup }
 # because they load configuraion by setting FS::UID::callback (see TODO)
 use FS::svc_acct;
+use FS::svc_acct_sm;
 use FS::svc_domain;
 use FS::svc_www;
 use FS::svc_forward;
@@ -29,6 +29,8 @@ use Mail::Header;
 
 @ISA = qw( FS::Record );
 
+$DEBUG = 0;
+
 $disable_agentcheck = 0;
 
 sub _cache {
@@ -150,7 +152,7 @@ sub insert {
   return $error if $error;
 
   my $cust_main = $self->cust_main;
-  return "Unknown customer ". $self->custnum unless $cust_main;
+  return "Unknown custnum: ". $self->custnum unless $cust_main;
 
   unless ( $disable_agentcheck ) {
     my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
@@ -246,25 +248,31 @@ sub check {
   $self->otaker($1);
 
   if ( $self->dbdef_table->column('manual_flag') ) {
-    $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag";
+    $self->manual_flag('') if $self->manual_flag eq ' ';
+    $self->manual_flag =~ /^([01]?)$/
+      or return "Illegal manual_flag ". $self->manual_flag;
     $self->manual_flag($1);
   }
 
   ''; #no error
 }
 
-=item cancel
+=item cancel [ OPTION => VALUE ... ]
 
 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
 in this package, then cancels the package itself (sets the cancel field to
 now).
 
+Available options are: I<quiet>
+
+I<quiet> can be set true to supress email cancellation notices.
+
 If there is an error, returns the error, otherwise returns false.
 
 =cut
 
 sub cancel {
-  my $self = shift;
+  my( $self, %options ) = @_;
   my $error;
 
   local $SIG{HUP} = 'IGNORE';
@@ -305,7 +313,7 @@ sub cancel {
 
   my $conf = new FS::Conf;
 
-  if ( !$quiet && $conf->exists('emailcancel')
+  if ( !$options{'quiet'} && $conf->exists('emailcancel')
        && grep { $_ ne 'POST' } $self->cust_main->invoicing_list) {
   
       my @invoicing_list = $self->cust_main->invoicing_list;
@@ -478,7 +486,7 @@ Useful for billing metered services.
 sub last_bill {
   my $self = shift;
   if ( $self->dbdef_table->column('last_bill') ) {
-    return $self->setfield('last_bill', $_[0]) if @_;
+    return $self->setfield('last_bill', $_[1]) if @_;
     return $self->getfield('last_bill') if $self->getfield('last_bill');
   }    
   my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
@@ -600,8 +608,7 @@ sub seconds_since_sqlradacct {
 
 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
 in this package for sessions ending between TIMESTAMP_START (inclusive) and
-TIMESTAMP_END
-(exclusive).
+TIMESTAMP_END (exclusive).
 
 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
@@ -628,6 +635,44 @@ sub attribute_since_sqlradacct {
 
 }
 
+=item reexport
+
+This method is deprecated.  See the I<depend_jobnum> option to the insert and
+order_pkgs methods in FS::cust_main for a better way to defer provisioning.
+
+=cut
+
+sub reexport {
+  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;
+
+  foreach my $cust_svc ( $self->cust_svc ) {
+    #false laziness w/svc_Common::insert
+    my $svc_x = $cust_svc->svc_x;
+    foreach my $part_export ( $cust_svc->part_svc->part_export ) {
+      my $error = $part_export->export_insert($svc_x);
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
 =back
 
 =head1 SUBROUTINES
@@ -678,6 +723,12 @@ sub order {
       push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
     }
   }
+  if ( $DEBUG ) {
+    foreach my $svcpart ( keys %svcnum ) {
+      warn "initial svcpart $svcpart: existing svcnums ".
+           join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n";
+    }
+  }
   
   my @cust_svc;
   #generate @cust_svc
@@ -691,13 +742,29 @@ sub order {
     }
     push @cust_svc, [
       map {
-        ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
-      } map { $_->svcpart }
+        my $svcnum = $svcnum{$_->{svcpart}};
+        if ( $svcnum && @$svcnum ) {
+          my $num = ( $_->{quantity} < scalar(@$svcnum) )
+                      ? $_->{quantity}
+                      : scalar(@$svcnum);
+          splice @$svcnum, 0, $num;
+        } else {
+          ();
+        }
+      } map { { 'svcpart'  => $_->svcpart,
+                'quantity' => $_->quantity } }
           qsearch('pkg_svc', { pkgpart  => $pkgpart,
                                quantity => { op=>'>', value=>'0', } } )
     ];
   }
 
+  if ( $DEBUG ) {
+    foreach my $svcpart ( keys %svcnum ) {
+      warn "after regular move svcpart $svcpart: existing svcnums ".
+           join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n";
+    }
+  }
+
   #special-case until this can be handled better
   # move services to new svcparts - even if the svcparts don't match (svcdb
   # needs to...)
@@ -734,7 +801,15 @@ sub order {
     }
 
   }
-  
+
+  if ( $DEBUG ) {
+    foreach my $svcpart ( keys %svcnum ) {
+      warn "after special-case move svcpart $svcpart: existing svcnums ".
+           join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n";
+    }
+  }
+
+
   #check for leftover services
   foreach (keys %svcnum) {
     next unless @{ $svcnum{$_} };
@@ -817,12 +892,11 @@ In sub order, the @pkgparts array (passed by reference) is clobbered.
 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
 method to pass dates to the recur_prog expression, it should do so.
 
-FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
-loaded via 'use' at compile time, rather than via 'require' in sub { setup,
-suspend, unsuspend, cancel } because they use %FS::UID::callback to load
-configuration values.  Probably need a subroutine which decides what to do
-based on whether or not we've fetched the user yet, rather than a hash.  See
-FS::UID and the TODO.
+FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at 
+compile time, rather than via 'require' in sub { setup, suspend, unsuspend,
+cancel } because they use %FS::UID::callback to load configuration values.
+Probably need a subroutine which decides what to do based on whether or not
+we've fetched the user yet, rather than a hash.  See FS::UID and the TODO.
 
 Now that things are transactional should the check in the insert method be
 moved to check ?