X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=1c9d8e136fbb57bfd6696fe179266b81fbe4df10;hb=20c649e7838f9448e53e0ba1c8e49820f031fc3e;hp=374cf7a12b085acf066aca83bb9a53515de507e9;hpb=6a42226f7f1779974316111cb178a3c6a6d74931;p=freeside.git

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 374cf7a12..1c9d8e136 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -1,7 +1,8 @@
 package FS::cust_pkg;
 
 use strict;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin
+use base qw( FS::otaker_Mixin FS::cust_main_Mixin
+             FS::contact_Mixin FS::location_Mixin
              FS::m2m_Common FS::option_Common );
 use vars qw($disable_agentcheck $DEBUG $me);
 use Carp qw(cluck);
@@ -10,13 +11,14 @@ use List::Util qw(min max);
 use Tie::IxHash;
 use Time::Local qw( timelocal timelocal_nocheck );
 use MIME::Entity;
-use FS::UID qw( getotaker dbh driver_name );
+use FS::UID qw( dbh driver_name );
 use FS::Misc qw( send_email );
 use FS::Record qw( qsearch qsearchs fields );
 use FS::CurrentUser;
 use FS::cust_svc;
 use FS::part_pkg;
 use FS::cust_main;
+use FS::contact;
 use FS::cust_location;
 use FS::pkg_svc;
 use FS::cust_bill_pkg;
@@ -225,7 +227,7 @@ Create a new billing item.  To add the item to the database, see L<"insert">.
 =cut
 
 sub table { 'cust_pkg'; }
-sub cust_linked { $_[0]->cust_main_custnum; } 
+sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum } 
 sub cust_unlinked_msg {
   my $self = shift;
   "WARNING: can't find cust_main.custnum ". $self->custnum.
@@ -253,7 +255,8 @@ The following options are available:
 
 =item change
 
-If set true, supresses any referral credit to a referring customer.
+If set true, supresses actions that should only be taken for new package
+orders.  (Currently this includes: intro periods when delay_setup is on.)
 
 =item options
 
@@ -267,6 +270,12 @@ a ticket will be added to this customer with this subject
 
 an optional queue name for ticket additions
 
+=item allow_pkgpart
+
+Don't check the legality of the package definition.  This should be used
+when performing a package change that doesn't change the pkgpart (i.e. 
+a location change).
+
 =back
 
 =cut
@@ -274,7 +283,8 @@ an optional queue name for ticket additions
 sub insert {
   my( $self, %options ) = @_;
 
-  my $error = $self->check_pkgpart;
+  my $error;
+  $error = $self->check_pkgpart unless $options{'allow_pkgpart'};
   return $error if $error;
 
   my $part_pkg = $self->part_pkg;
@@ -294,8 +304,12 @@ sub insert {
     }
   }
 
-  my $free_days = $part_pkg->option('free_days',1);
-  if ( $free_days && $part_pkg->option('delay_setup',1) ) { #&& !$self->start_date
+  if (    ! $options{'change'}
+       && ( my $free_days = $part_pkg->option('free_days',1) )
+       && $part_pkg->option('delay_setup',1)
+       #&& ! $self->start_date
+     )
+  {
     my ($mday,$mon,$year) = (localtime(time) )[3,4,5];
     #my $start_date = ($self->start_date || timelocal(0,0,0,$mday,$mon,$year)) + 86400 * $free_days;
     my $start_date = timelocal(0,0,0,$mday,$mon,$year) + 86400 * $free_days;
@@ -567,9 +581,12 @@ sub replace {
 
   }
 
-  my $error = $new->SUPER::replace($old,
-                                   $options->{options} ? $options->{options} : ()
-                                  );
+  my $error =  $new->export_pkg_change($old)
+            || $new->SUPER::replace( $old,
+                                     $options->{options}
+                                       ? $options->{options}
+                                       : ()
+                                   );
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -613,7 +630,7 @@ sub check {
     $self->ut_numbern('pkgnum')
     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
     || $self->ut_numbern('pkgpart')
-    || $self->check_pkgpart
+    || $self->ut_foreign_keyn('contactnum',  'contact',       'contactnum' )
     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
     || $self->ut_numbern('start_date')
     || $self->ut_numbern('setup')
@@ -654,14 +671,19 @@ sub check {
 
 =item check_pkgpart
 
+Check the pkgpart to make sure it's allowed with the reg_code and/or
+promo_code of the package (if present) and with the customer's agent.
+Called from C<insert>, unless we are doing a package change that doesn't
+affect pkgpart.
+
 =cut
 
 sub check_pkgpart {
   my $self = shift;
 
-  my $error = $self->ut_numbern('pkgpart');
-  return $error if $error;
+  # my $error = $self->ut_numbern('pkgpart'); # already done
 
+  my $error;
   if ( $self->reg_code ) {
 
     unless ( grep { $self->pkgpart == $_->pkgpart }
@@ -848,6 +870,7 @@ sub cancel {
 
   my %hash = $self->hash;
   $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
+  $hash{'change_custnum'} = $options{'change_custnum'};
   my $new = new FS::cust_pkg ( \%hash );
   $error = $new->replace( $self, options => { $self->options } );
   if ( $error ) {
@@ -981,6 +1004,7 @@ sub uncancel {
 
   my $error = $cust_pkg->insert(
     'change' => 1, #supresses any referral credit to a referring customer
+    'allow_pkgpart' => 1, # allow this even if the package def is disabled
   );
   if ($error) {
     $dbh->rollback if $oldAutoCommit;
@@ -1022,15 +1046,20 @@ sub uncancel {
         $dbh->rollback if $oldAutoCommit;
         return $svc_error;
       } else {
+        # if we've failed to insert the svc_x object, svc_Common->insert 
+        # will have removed the cust_svc already.  if not, then both records
+        # were inserted but we failed for some other reason (export, most 
+        # likely).  in that case, report the error and delete the records.
         push @svc_errors, $svc_error;
-        # is this necessary? svc_Common::insert already deletes the 
-        # cust_svc if inserting svc_x fails.
         my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum });
         if ( $cust_svc ) {
-          my $cs_error = $cust_svc->delete;
-          if ( $cs_error ) {
+          # except if export_insert failed, export_delete probably won't be
+          # much better
+          local $FS::svc_Common::noexport_hack = 1;
+          my $cleanup_error = $svc_x->delete; # also deletes cust_svc
+          if ( $cleanup_error ) { # and if THAT fails, then run away
             $dbh->rollback if $oldAutoCommit;
-            return $cs_error;
+            return $cleanup_error;
           }
         }
       } # svc_fatal
@@ -1683,6 +1712,11 @@ New locationnum, to change the location for this package.
 New FS::cust_location object, to create a new location and assign it
 to this package.
 
+=item cust_main
+
+New FS::cust_main object, to create a new customer and assign the new package
+to it.
+
 =item pkgpart
 
 New pkgpart (see L<FS::part_pkg>).
@@ -1747,9 +1781,8 @@ sub change {
   $hash{"change_$_"}  = $self->$_()
     foreach qw( pkgnum pkgpart locationnum );
 
-  if ( $opt->{'cust_location'} &&
-       ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
-    $error = $opt->{'cust_location'}->insert;
+  if ( $opt->{'cust_location'} ) {
+    $error = $opt->{'cust_location'}->find_or_insert;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
       return "inserting cust_location (transaction rolled back): $error";
@@ -1757,6 +1790,12 @@ sub change {
     $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
   }
 
+  # whether to override pkgpart checking on the new package
+  my $same_pkgpart = 1;
+  if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) {
+    $same_pkgpart = 0;
+  }
+
   my $unused_credit = 0;
   my $keep_dates = $opt->{'keep_dates'};
   # Special case.  If the pkgpart is changing, and the customer is
@@ -1781,15 +1820,37 @@ sub change {
   # (i.e. customer default location)
   $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
 
+  # usually this doesn't matter.  the two cases where it does are:
+  # 1. unused_credit_change + pkgpart change + setup fee on the new package
+  # and
+  # 2. (more importantly) changing a package before it's billed
+  $hash{'waive_setup'} = $self->waive_setup;
+
+  my $custnum = $self->custnum;
+  if ( $opt->{cust_main} ) {
+    my $cust_main = $opt->{cust_main};
+    unless ( $cust_main->custnum ) { 
+      my $error = $cust_main->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "inserting cust_main (transaction rolled back): $error";
+      }
+    }
+    $custnum = $cust_main->custnum;
+  }
+
+  $hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'};
+
   # Create the new package.
   my $cust_pkg = new FS::cust_pkg {
-    custnum      => $self->custnum,
-    pkgpart      => ( $opt->{'pkgpart'}     || $self->pkgpart      ),
-    refnum       => ( $opt->{'refnum'}      || $self->refnum       ),
-    locationnum  => ( $opt->{'locationnum'}                        ),
+    custnum        => $custnum,
+    pkgpart        => ( $opt->{'pkgpart'}     || $self->pkgpart      ),
+    refnum         => ( $opt->{'refnum'}      || $self->refnum       ),
+    locationnum    => ( $opt->{'locationnum'}                        ),
     %hash,
   };
-  $error = $cust_pkg->insert( 'change' => 1 );
+  $error = $cust_pkg->insert( 'change' => 1,
+                              'allow_pkgpart' => $same_pkgpart );
   if ($error) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -1847,6 +1908,23 @@ sub change {
     }
   }
 
+  # transfer discounts, if we're not changing pkgpart
+  if ( $same_pkgpart ) {
+    foreach my $old_discount ($self->cust_pkg_discount_active) {
+      # don't remove the old discount, we may still need to bill that package.
+      my $new_discount = new FS::cust_pkg_discount {
+        'pkgnum'      => $cust_pkg->pkgnum,
+        'discountnum' => $old_discount->discountnum,
+        'months_used' => $old_discount->months_used,
+      };
+      $error = $new_discount->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "Error transferring discounts: $error";
+      }
+    }
+  }
+
   # Order any supplemental packages.
   my $part_pkg = $cust_pkg->part_pkg;
   my @old_supp_pkgs = $self->supplemental_pkgs;
@@ -1864,7 +1942,7 @@ sub change {
     my $new = FS::cust_pkg->new({
         pkgpart       => $link->dst_pkgpart,
         pkglinknum    => $link->pkglinknum,
-        custnum       => $self->custnum,
+        custnum       => $custnum,
         main_pkgnum   => $cust_pkg->pkgnum,
         locationnum   => $cust_pkg->locationnum,
         start_date    => $cust_pkg->start_date,
@@ -1874,14 +1952,14 @@ sub change {
         contract_end  => $cust_pkg->contract_end,
         refnum        => $cust_pkg->refnum,
         discountnum   => $cust_pkg->discountnum,
-        waive_setup   => $cust_pkg->waive_setup
+        waive_setup   => $cust_pkg->waive_setup,
     });
     if ( $old and $opt->{'keep_dates'} ) {
       foreach (qw(setup bill last_bill)) {
         $new->set($_, $old->get($_));
       }
     }
-    $error = $new->insert;
+    $error = $new->insert( allow_pkgpart => $same_pkgpart );
     # transfer services
     if ( $old ) {
       $error ||= $old->transfer($new);
@@ -1905,9 +1983,10 @@ sub change {
   #because the new package will be billed for the same date range.
   #Supplemental packages are also canceled here.
   $error = $self->cancel(
-    quiet         => 1, 
-    unused_credit => $unused_credit,
-    nobill        => $keep_dates
+    quiet          => 1, 
+    unused_credit  => $unused_credit,
+    nobill         => $keep_dates,
+    change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),
   );
   if ($error) {
     $dbh->rollback if $oldAutoCommit;
@@ -2079,6 +2158,18 @@ sub old_cust_pkg {
   qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
 }
 
+=item change_cust_main
+
+Returns the customter this package was detached to, if any.
+
+=cut
+
+sub change_cust_main {
+  my $self = shift;
+  return '' unless $self->change_custnum;
+  qsearchs('cust_main', { 'custnum' => $self->change_custnum } );
+}
+
 =item calc_setup
 
 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
@@ -2103,6 +2194,18 @@ sub calc_recur {
   $self->part_pkg->calc_recur($self, @_);
 }
 
+=item base_setup
+
+Calls the I<base_setup> of the FS::part_pkg object associated with this billing
+item.
+
+=cut
+
+sub base_setup {
+  my $self = shift;
+  $self->part_pkg->base_setup($self, @_);
+}
+
 =item base_recur
 
 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
@@ -2255,6 +2358,26 @@ sub num_cust_event {
   $sth->fetchrow_arrayref->[0];
 }
 
+=item part_pkg_currency_option OPTIONNAME
+
+Returns a two item list consisting of the currency of this customer, if any,
+and a value for the provided option.  If the customer has a currency, the value
+is the option value the given name and the currency (see
+L<FS::part_pkg_currency>).  Otherwise, if the customer has no currency, is the
+regular option value for the given name (see L<FS::part_pkg_option>).
+
+=cut
+
+sub part_pkg_currency_option {
+  my( $self, $optionname ) = @_;
+  my $part_pkg = $self->part_pkg;
+  if ( my $currency = $self->cust_main->currency ) {
+    ($currency, $part_pkg->part_pkg_currency_option($currency, $optionname) );
+  } else {
+    ('', $part_pkg->option($optionname) );
+  }
+}
+
 =item cust_svc [ SVCPART ] (old, deprecated usage)
 
 =item cust_svc [ OPTION => VALUE ... ] (current usage)
@@ -2639,7 +2762,7 @@ sub statuscolor {
 =item pkg_label
 
 Returns a label for this package.  (Currently "pkgnum: pkg - comment" or
-"pkg-comment" depending on user preference).
+"pkg - comment" depending on user preference).
 
 =cut
 
@@ -2666,6 +2789,17 @@ sub pkg_label_long {
   $label;
 }
 
+=item pkg_locale
+
+Returns a customer-localized label for this package.
+
+=cut
+
+sub pkg_locale {
+  my $self = shift;
+  $self->part_pkg->pkg_locale( $self->cust_main->locale );
+}
+
 =item primary_cust_svc
 
 Returns a primary service (as FS::cust_svc object) if one can be identified.
@@ -3097,6 +3231,46 @@ sub transfer {
   return $remaining;
 }
 
+=item grab_svcnums SVCNUM, SVCNUM ...
+
+Change the pkgnum for the provided services to this packages.  If there is an
+error, returns the error, otherwise returns false.
+
+=cut
+
+sub grab_svcnums {
+  my $self = shift;
+  my @svcnum = @_;
+
+  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 $svcnum (@svcnum) {
+    my $cust_svc = qsearchs('cust_svc', { svcnum=>$svcnum } ) or do {
+      $dbh->rollback if $oldAutoCommit;
+      return "unknown svcnum $svcnum";
+    };
+    $cust_svc->pkgnum( $self->pkgnum );
+    my $error = $cust_svc->replace;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
 =item reexport
 
 This method is deprecated.  See the I<depend_jobnum> option to the insert and
@@ -3104,6 +3278,8 @@ order_pkgs methods in FS::cust_main for a better way to defer provisioning.
 
 =cut
 
+#looks like this is still used by the order_pkg and change_pkg methods in
+# ClientAPI/MyAccount, need to look into those before removing
 sub reexport {
   my $self = shift;
 
@@ -3135,6 +3311,39 @@ sub reexport {
 
 }
 
+=item export_pkg_change OLD_CUST_PKG
+
+Calls the "pkg_change" export action for all services attached to this package.
+
+=cut
+
+sub export_pkg_change {
+  my( $self, $old )  = ( shift, 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 $svc_x ( map $_->svc_x, $self->cust_svc ) {
+    my $error = $svc_x->export('pkg_change', $self, $old);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
 =item insert_reason
 
 Associates this package with a (suspension or cancellation) reason (see