Merge branch 'master' of git.freeside.biz:/home/git/freeside
[freeside.git] / FS / FS / cust_pkg.pm
index c41f04b..627a7fc 100644 (file)
@@ -10,9 +10,9 @@ use List::Util qw(max);
 use Tie::IxHash;
 use Time::Local qw( timelocal timelocal_nocheck );
 use MIME::Entity;
-use FS::UID qw( getotaker dbh );
+use FS::UID qw( getotaker dbh driver_name );
 use FS::Misc qw( send_email );
-use FS::Record qw( qsearch qsearchs );
+use FS::Record qw( qsearch qsearchs fields );
 use FS::CurrentUser;
 use FS::cust_svc;
 use FS::part_pkg;
@@ -605,6 +605,7 @@ sub check {
     || $self->ut_numbern('susp')
     || $self->ut_numbern('cancel')
     || $self->ut_numbern('adjourn')
+    || $self->ut_numbern('resume')
     || $self->ut_numbern('expire')
     || $self->ut_numbern('dundate')
     || $self->ut_enum('no_auto', [ '', 'Y' ])
@@ -618,6 +619,9 @@ sub check {
   return "A package with both start date (future start) and setup date (already started) will never bill"
     if $self->start_date && $self->setup;
 
+  return "A future unsuspend date can only be set for a package with a suspend date"
+    if $self->resume and !$self->susp and !$self->adjourn;
+
   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
 
   if ( $self->dbdef_table->column('manual_flag') ) {
@@ -875,6 +879,154 @@ sub cancel_if_expired {
   '';
 }
 
+=item uncancel
+
+"Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
+locationnum, (other fields?).  Attempts to re-provision cancelled services
+using history information (errors at this stage are not fatal).
+
+cust_pkg: pass a scalar reference, will be filled in with the new cust_pkg object
+
+svc_fatal: service provisioning errors are fatal
+
+svc_errors: pass an array reference, will be filled in with any provisioning errors
+
+=cut
+
+sub uncancel {
+  my( $self, %options ) = @_;
+
+  #in case you try do do $uncancel-date = $cust_pkg->uncacel 
+  return '' unless $self->get('cancel');
+
+  ##
+  # Transaction-alize
+  ##
+
+  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;
+
+  ##
+  # insert the new package
+  ##
+
+  my $cust_pkg = new FS::cust_pkg {
+    last_bill       => ( $options{'last_bill'} || $self->get('last_bill') ),
+    bill            => ( $options{'bill'}      || $self->get('bill')      ),
+    uncancel        => time,
+    uncancel_pkgnum => $self->pkgnum,
+    map { $_ => $self->get($_) } qw(
+      custnum pkgpart locationnum
+      setup
+      susp adjourn resume expire start_date contract_end dundate
+      change_date change_pkgpart change_locationnum
+      manual_flag no_auto quantity agent_pkgid recur_show_zero setup_show_zero
+    ),
+  };
+
+  my $error = $cust_pkg->insert(
+    'change' => 1, #supresses any referral credit to a referring customer
+  );
+  if ($error) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  ##
+  # insert services
+  ##
+
+  #find historical services within this timeframe before the package cancel
+  # (incompatible with "time" option to cust_pkg->cancel?)
+  my $fuzz = 2 * 60; #2 minutes?  too much?   (might catch separate unprovision)
+                     #            too little? (unprovisioing export delay?)
+  my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
+  my @h_cust_svc = $self->h_cust_svc( $end, $start );
+
+  my @svc_errors;
+  foreach my $h_cust_svc (@h_cust_svc) {
+    my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
+    #next unless $h_svc_x; #should this happen?
+    (my $table = $h_svc_x->table) =~ s/^h_//;
+    require "FS/$table.pm";
+    my $class = "FS::$table";
+    my $svc_x = $class->new( {
+      'pkgnum'  => $cust_pkg->pkgnum,
+      'svcpart' => $h_cust_svc->svcpart,
+      map { $_ => $h_svc_x->get($_) } fields($table)
+    } );
+
+    # radius_usergroup
+    if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
+      $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
+    }
+
+    my $svc_error = $svc_x->insert;
+    if ( $svc_error && $options{svc_fatal} ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $svc_error;
+    } else {
+      my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum });
+      if ( $cust_svc ) {
+        my $cs_error = $cust_svc->delete;
+        if ( $cs_error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return $cs_error;
+        }
+      }
+    }
+    push @svc_errors, $svc_error if $svc_error;
+  }
+
+  #these are pretty rare, but should handle them
+  # - dsl_device (mac addresses)
+  # - phone_device (mac addresses)
+  # - dsl_note (ikano notes)
+  # - domain_record (i.e. restore DNS information w/domains)
+  # - inventory_item(?) (inventory w/un-cancelling service?)
+  # - nas (svc_broaband nas stuff)
+  #this stuff is unused in the wild afaik
+  # - mailinglistmember
+  # - router.svcnum?
+  # - svc_domain.parent_svcnum?
+  # - acct_snarf (ancient mail fetching config)
+  # - cgp_rule (communigate)
+  # - cust_svc_option (used by our Tron stuff)
+  # - acct_rt_transaction (used by our time worked stuff)
+
+  ##
+  # also move over any services that didn't unprovision at cancellation
+  ## 
+
+  foreach my $cust_svc ( qsearch('cust_svc', { pkgnum => $self->pkgnum } ) ) {
+    $cust_svc->pkgnum( $cust_pkg->pkgnum );
+    my $error = $cust_svc->replace;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  ##
+  # Finish
+  ##
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  ${ $options{cust_pkg} }   = $cust_pkg   if ref($options{cust_pkg});
+  @{ $options{svc_errors} } = @svc_errors if ref($options{svc_errors});
+
+  '';
+}
+
 =item unexpire
 
 Cancels any pending expiration (sets the expire field to null).
@@ -936,9 +1088,21 @@ Available options are:
 
 =over 4
 
-=item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
+=item reason - can be set to a cancellation reason (see L<FS:reason>), 
+either a reasonnum of an existing reason, or passing a hashref will create 
+a new reason.  The hashref should have the following keys: 
+- typenum - Reason type (see L<FS::reason_type>
+- reason - Text of the new reason.
+
+=item date - can be set to a unix style timestamp to specify when to 
+suspend (adjourn)
+
+=item time - can be set to override the current time, for calculation 
+of final invoices or unused-time credits
 
-=item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
+=item resume_date - can be set to a time when the package should be 
+unsuspended.  This may be more convenient than calling C<unsuspend()>
+separately.
 
 =back
 
@@ -976,7 +1140,7 @@ sub suspend {
 
   my $suspend_time = $options{'time'} || time;
   my $date = $options{date} if $options{date}; # adjourn/suspend later
-  $date = '' if ($date && $date <= time);      # complain instead?
+  $date = '' if ($date && $date <= $suspend_time); # complain instead?
 
   if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
     dbh->rollback if $oldAutoCommit;
@@ -1019,8 +1183,19 @@ sub suspend {
   } else {
     $hash{'susp'} = $suspend_time;
   }
+
+  my $resume_date = $options{'resume_date'} || 0;
+  if ( $resume_date > ($date || $suspend_time) ) {
+    $hash{'resume'} = $resume_date;
+  }
+
+  $options{options} ||= {};
+
   my $new = new FS::cust_pkg ( \%hash );
-  $error = $new->replace( $self, options => { $self->options } );
+  $error = $new->replace( $self, options => { $self->options,
+                                              %{ $options{options} },
+                                            }
+                        );
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -1098,7 +1273,7 @@ sub suspend {
 
 Generate a credit for this package for the time remaining in the current 
 billing period.  MODE is either "suspend" or "cancel" (determines the 
-credit type).  TIME is the time of suspension/cancellation.  Both options
+credit type).  TIME is the time of suspension/cancellation.  Both arguments
 are mandatory.
 
 =cut
@@ -1146,6 +1321,11 @@ Available options are:
 
 =over 4
 
+=item date
+
+Can be set to a date to unsuspend the package in the future (the 'resume' 
+field).
+
 =item adjust_next_bill
 
 Can be set true to adjust the next bill date forward by
@@ -1180,15 +1360,40 @@ sub unsuspend {
 
   my $pkgnum = $old->pkgnum;
   if ( $old->get('cancel') || $self->get('cancel') ) {
-    dbh->rollback if $oldAutoCommit;
+    $dbh->rollback if $oldAutoCommit;
     return "Can't unsuspend cancelled package $pkgnum";
   }
 
   unless ( $old->get('susp') && $self->get('susp') ) {
-    dbh->rollback if $oldAutoCommit;
+    $dbh->rollback if $oldAutoCommit;
     return "";  # no error                     # complain instead?
   }
 
+  my $date = $opt{'date'};
+  if ( $date and $date > time ) { # return an error if $date <= time?
+
+    if ( $old->get('expire') && $old->get('expire') < $date ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Package $pkgnum expires before it would be unsuspended.";
+    }
+
+    my $new = new FS::cust_pkg { $self->hash };
+    $new->set('resume', $date);
+    $error = $new->replace($self, options => $self->options);
+
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+    else {
+      $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+      return '';
+    }
+  
+  } #if $date 
+
+  my @labels = ();
+
   foreach my $cust_svc (
     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
   ) {
@@ -1208,6 +1413,8 @@ sub unsuspend {
         $dbh->rollback if $oldAutoCommit;
         return $error;
       }
+      my( $label, $value ) = $cust_svc->label;
+      push @labels, "$label: $value";
     }
 
   }
@@ -1229,7 +1436,8 @@ sub unsuspend {
   }
 
   $hash{'susp'} = '';
-  $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
+  $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
+  $hash{'resume'} = '' if !$hash{'adjourn'};
   my $new = new FS::cust_pkg ( \%hash );
   $error = $new->replace( $self, options => { $self->options } );
   if ( $error ) {
@@ -1237,6 +1445,29 @@ sub unsuspend {
     return $error;
   }
 
+  if ( $conf->config('unsuspend_email_admin') ) {
+    my $error = send_email(
+      'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
+                                 #invoice_from ??? well as good as any
+      'to'      => $conf->config('unsuspend_email_admin'),
+      'subject' => 'FREESIDE NOTIFICATION: Customer package unsuspended',       'body'    => [
+        "This is an automatic message from your Freeside installation\n",
+        "informing you that the following customer package has been unsuspended:\n",
+        "\n",
+        'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
+        'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
+        ( map { "Service : $_\n" } @labels ),
+      ],
+    );
+
+    if ( $error ) {
+      warn "WARNING: can't send unsuspension admin email (unsuspending anyway): ".
+           "$error\n";
+    }
+
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   ''; #no errors
@@ -1287,6 +1518,7 @@ sub unadjourn {
 
   my %hash = $self->hash;
   $hash{'adjourn'} = '';
+  $hash{'resume'}  = '';
   my $new = new FS::cust_pkg ( \%hash );
   $error = $new->replace( $self, options => { $self->options } );
   if ( $error ) {
@@ -1409,7 +1641,7 @@ sub change {
 
   if ( $keep_dates ) {
     foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire 
-                          start_date contract_end ) ) {
+                          resume start_date contract_end ) ) {
       $hash{$date} = $self->getfield($date);
     }
   }
@@ -1843,7 +2075,7 @@ sub cust_svc {
   }
   if ( $opt{'svcdb'} ) {
     $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) ';
-    $search{hashref}->{svcdb} = $opt{'svcdb'};
+    $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} );
   }
 
   cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
@@ -1977,11 +2209,14 @@ field, I<num_avail>, which specifies the number of available services.
 
 sub available_part_svc {
   my $self = shift;
+
+  my $pkg_quantity = $self->quantity || 1;
+
   grep { $_->num_avail > 0 }
     map {
           my $part_svc = $_->part_svc;
           $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
-            $_->quantity - $self->num_cust_svc($_->svcpart);
+            $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
 
          # more evil encapsulation breakage
          if($part_svc->{'Hash'}{'num_avail'} > 0) {
@@ -2023,6 +2258,8 @@ sub part_svc {
   my $self = shift;
   my %opt = @_;
 
+  my $pkg_quantity = $self->quantity || 1;
+
   #XXX some sort of sort order besides numeric by svcpart...
   my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
     my $pkg_svc = $_;
@@ -2030,7 +2267,7 @@ sub part_svc {
     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
     $part_svc->{'Hash'}{'num_avail'}    =
-      max( 0, $pkg_svc->quantity - $num_cust_svc );
+      max( 0, $pkg_quantity * $pkg_svc->quantity - $num_cust_svc );
     $part_svc->{'Hash'}{'cust_pkg_svc'} =
         $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
       unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
@@ -2389,6 +2626,39 @@ Returns the label of the location object (see L<FS::cust_location>).
 
 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
 
+=item tax_locationnum
+
+Returns the foreign key to a L<FS::cust_location> object for calculating  
+tax on this package, as determined by the C<tax-pkg_address> and 
+C<tax-ship_address> configuration flags.
+
+=cut
+
+sub tax_locationnum {
+  my $self = shift;
+  my $conf = FS::Conf->new;
+  if ( $conf->exists('tax-pkg_address') ) {
+    return $self->locationnum;
+  }
+  elsif ( $conf->exists('tax-ship_address') ) {
+    return $self->cust_main->ship_locationnum;
+  }
+  else {
+    return $self->cust_main->bill_locationnum;
+  }
+}
+
+=item tax_location
+
+Returns the L<FS::cust_location> object for tax_locationnum.
+
+=cut
+
+sub tax_location {
+  my $self = shift;
+  FS::cust_location->by_key( $self->tax_locationnum )
+}
+
 =item seconds_since TIMESTAMP
 
 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
@@ -3108,7 +3378,6 @@ sub search {
       } elsif ( @c_where ) {
         push @where, ' ( '. join(' OR ', @c_where). ' ) ';
       }
-      warn $where[-1];
 
     }
     
@@ -3249,7 +3518,7 @@ sub search {
       "NOT (".FS::cust_pkg->onetime_sql . ")";
   }
   else {
-    foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) {
+    foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
 
       next unless exists($params->{$field});
 
@@ -3376,6 +3645,25 @@ sub fcc_477_count {
 
 }
 
+=item tax_locationnum_sql
+
+Returns an SQL expression for the tax location for a package, based
+on the settings of 'tax-pkg_address' and 'tax-ship_address'.
+
+=cut
+
+sub tax_locationnum_sql {
+  my $conf = FS::Conf->new;
+  if ( $conf->exists('tax-pkg_address') ) {
+    'cust_pkg.locationnum';
+  }
+  elsif ( $conf->exists('tax-ship_address') ) {
+    'cust_main.ship_locationnum';
+  }
+  else {
+    'cust_main.bill_locationnum';
+  }
+}
 
 =item location_sql
 
@@ -3394,7 +3682,13 @@ sub location_sql {
 
   # '?' placeholders in _location_sql_where
   my $x = $ornull ? 3 : 2;
-  my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
+  my @bill_param = ( 
+    ('district')x3,
+    ('city')x3, 
+    ('county')x$x,
+    ('state')x$x,
+    'country'
+  );
 
   my $main_where;
   my @main_param;
@@ -3453,16 +3747,19 @@ sub _location_sql_where {
 
   $ornull = $ornull ? ' OR ? IS NULL ' : '';
 
-  my $or_empty_city   = " OR ( ? = '' AND $table.${prefix}city   IS NULL ) ";
-  my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
-  my $or_empty_state =  " OR ( ? = '' AND $table.${prefix}state  IS NULL ) ";
+  my $or_empty_city     = " OR ( ? = '' AND $table.${prefix}city     IS NULL )";
+  my $or_empty_county   = " OR ( ? = '' AND $table.${prefix}county   IS NULL )";
+  my $or_empty_state    = " OR ( ? = '' AND $table.${prefix}state    IS NULL )";
+
+  my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
 
 #        ( $table.${prefix}city    = ? $or_empty_city   $ornull )
   "
-        ( $table.${prefix}city    = ? OR ? = '' OR CAST(? AS text) IS NULL )
-    AND ( $table.${prefix}county  = ? $or_empty_county $ornull )
-    AND ( $table.${prefix}state   = ? $or_empty_state  $ornull )
-    AND   $table.${prefix}country = ?
+        ( $table.district = ? OR ? = '' OR CAST(? AS $text) IS NULL )
+    AND ( $table.${prefix}city     = ? OR ? = '' OR CAST(? AS $text) IS NULL )
+    AND ( $table.${prefix}county   = ? $or_empty_county $ornull )
+    AND ( $table.${prefix}state    = ? $or_empty_state  $ornull )
+    AND   $table.${prefix}country  = ?
   ";
 }