closing bracket helps

[freeside.git] / FS / FS / cust_pkg.pm

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index cd808d4..4976a2d 100644 (file)
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -2,9 +2,11 @@ package FS::cust_pkg;
 
 use strict;
 use vars qw(@ISA $disable_agentcheck @SVCDB_CANCEL_SEQ $DEBUG);
 
 use strict;
 use vars qw(@ISA $disable_agentcheck @SVCDB_CANCEL_SEQ $DEBUG);

+use Tie::IxHash;

 use FS::UID qw( getotaker dbh );
 use FS::UID qw( getotaker dbh );

-use FS::Record qw( qsearch qsearchs );

 use FS::Misc qw( send_email );
 use FS::Misc qw( send_email );

+use FS::Record qw( qsearch qsearchs );
+use FS::cust_main_Mixin;

 use FS::cust_svc;
 use FS::part_pkg;
 use FS::cust_main;
 use FS::cust_svc;
 use FS::part_pkg;
 use FS::cust_main;


@@ -16,7 +18,7 @@ use FS::reg_code;
 
 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
 # setup }
 
 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
 # setup }

-# because they load configuraion by setting FS::UID::callback (see TODO)
+# because they load configuration by setting FS::UID::callback (see TODO)

 use FS::svc_acct;
 use FS::svc_domain;
 use FS::svc_www;
 use FS::svc_acct;
 use FS::svc_domain;
 use FS::svc_www;


@@ -25,7 +27,7 @@ use FS::svc_forward;
 # for sending cancel emails in sub cancel
 use FS::Conf;
 
 # for sending cancel emails in sub cancel
 use FS::Conf;
 

-@ISA = qw( FS::Record );
+@ISA = qw( FS::cust_main_Mixin FS::Record );

 
 $DEBUG = 0;
 
 
 $DEBUG = 0;
 


@@ -141,6 +143,12 @@ Create a new billing item.  To add the item to the database, see L<"insert">.
 =cut
 
 sub table { 'cust_pkg'; }
 =cut
 
 sub table { 'cust_pkg'; }

+sub cust_linked { $_[0]->cust_main_custnum; } 
+sub cust_unlinked_msg {
+  my $self = shift;
+  "WARNING: can't find cust_main.custnum ". $self->custnum.
+  ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
+}

 
 =item insert [ OPTION => VALUE ... ]
 
 
 =item insert [ OPTION => VALUE ... ]
 


@@ -257,6 +265,8 @@ suspend is normally updated by the suspend and unsuspend methods.
 cancel is normally updated by the cancel method (and also the order subroutine
 in some cases).
 
 cancel is normally updated by the cancel method (and also the order subroutine
 in some cases).
 

+Calls 
+

 =cut
 
 sub replace {
 =cut
 
 sub replace {


@@ -274,7 +284,51 @@ sub replace {
 
   local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
 
 
   local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
 

-  $new->SUPER::replace($old);
+  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;
+
+  #save off and freeze RADIUS attributes for any associated svc_acct records
+  my @svc_acct = ();
+  if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
+
+                #also check for specific exports?
+                # to avoid spurious modify export events
+    @svc_acct = map  { $_->svc_x }
+                grep { $_->part_svc->svcdb eq 'svc_acct' }
+                     $old->cust_svc;
+
+    $_->snapshot foreach @svc_acct;
+
+  }
+
+  my $error = $new->SUPER::replace($old);
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  #for prepaid packages,
+  #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
+  foreach my $old_svc_acct ( @svc_acct ) {
+    my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
+    my $s_error = $new_svc_acct->replace($old_svc_acct);
+    if ( $s_error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $s_error;
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+

 }
 
 =item check
 }
 
 =item check


@@ -306,7 +360,7 @@ sub check {
              qsearchs( 'reg_code', { 'code'     => $self->reg_code,
                                      'agentnum' => $self->cust_main->agentnum })
            ) {
              qsearchs( 'reg_code', { 'code'     => $self->reg_code,
                                      'agentnum' => $self->cust_main->agentnum })
            ) {

-      return "Unknown registraiton code";
+      return "Unknown registration code";

     }
 
   } elsif ( $self->promo_code ) {
     }
 
   } elsif ( $self->promo_code ) {


@@ -400,7 +454,7 @@ sub cancel {
   if ( $remaining_value > 0 ) {
     my $error = $self->cust_main->credit(
       $remaining_value,
   if ( $remaining_value > 0 ) {
     my $error = $self->cust_main->credit(
       $remaining_value,

-      'Credit for unused time on'. $self->part_pkg->pkg,
+      'Credit for unused time on '. $self->part_pkg->pkg,

     );
     if ($error) {
       $dbh->rollback if $oldAutoCommit;
     );
     if ($error) {
       $dbh->rollback if $oldAutoCommit;


@@ -423,7 +477,7 @@ sub cancel {
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   my $conf = new FS::Conf;
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   my $conf = new FS::Conf;

-  my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list;
+  my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;

   if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
     my $conf = new FS::Conf;
     my $error = send_email(
   if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
     my $conf = new FS::Conf;
     my $error = send_email(


@@ -502,18 +556,27 @@ sub suspend {
   ''; #no errors
 }
 
   ''; #no errors
 }
 

-=item unsuspend
+=item unsuspend [ OPTION => VALUE ... ]

 
 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 package, then unsuspends the package itself (clears the susp field).
 
 
 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 package, then unsuspends the package itself (clears the susp field).
 

+Available options are: I<adjust_next_bill>.
+
+I<adjust_next_bill> can be set true to adjust the next bill date forward by
+the amount of time the account was inactive.  This was set true by default
+since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
+explicitly requested.  Price plans for which this makes sense (anniversary-date
+based than prorate or subscription) could have an option to enable this
+behaviour?
+

 If there is an error, returns the error, otherwise returns false.
 
 =cut
 
 sub unsuspend {
 If there is an error, returns the error, otherwise returns false.
 
 =cut
 
 sub unsuspend {

-  my $self = shift;
-  my($error);
+  my( $self, %opt ) = @_;
+  my $error;

 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';


@@ -552,9 +615,12 @@ sub unsuspend {
   unless ( ! $self->getfield('susp') ) {
     my %hash = $self->hash;
     my $inactive = time - $hash{'susp'};
   unless ( ! $self->getfield('susp') ) {
     my %hash = $self->hash;
     my $inactive = time - $hash{'susp'};

-    $hash{'susp'} = '';
+

     $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
     $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive

-      if $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
+      if $opt{'adjust_next_bill'}
+      && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
+
+    $hash{'susp'} = '';

     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);
     if ( $error ) {
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);
     if ( $error ) {


@@ -748,6 +814,73 @@ sub available_part_svc {
       $self->part_pkg->pkg_svc;
 }
 
       $self->part_pkg->pkg_svc;
 }
 

+=item status
+
+Returns a short status string for this package, currently:
+
+=over 4
+
+=item not yet billed
+
+=item one-time charge
+
+=item active
+
+=item suspended
+
+=item cancelled
+
+=back
+
+=cut
+
+sub status {
+  my $self = shift;
+
+  my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
+
+  return 'cancelled' if $self->get('cancel');
+  return 'suspended' if $self->susp;
+  return 'not yet billed' unless $self->setup;
+  return 'one-time charge' if $freq =~ /^(0|$)/;
+  return 'active';
+}
+
+=item statuses
+
+Class method that returns the list of possible status strings for pacakges
+(see L<the status method|/status>).  For example:
+
+  @statuses = FS::cust_pkg->statuses();
+
+=cut
+
+tie my %statuscolor, 'Tie::IxHash', 
+  'not yet billed'  => '000000',
+  'one-time charge' => '000000',
+  'active'          => '00CC00',
+  'suspended'       => 'FF9900',
+  'cancelled'       => 'FF0000',
+;
+
+sub statuses {
+  my $self = shift; #could be class...
+  grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
+                                      # mayble split btw one-time vs. recur
+    keys %statuscolor;
+}
+
+=item statuscolor
+
+Returns a hex triplet color string for this package's status.
+
+=cut
+
+sub statuscolor {
+  my $self = shift;
+  $statuscolor{$self->status};
+}
+

 =item labels
 
 Returns a list of lists, calling the label method for all services
 =item labels
 
 Returns a list of lists, calling the label method for all services


@@ -1062,6 +1195,86 @@ sub reexport {
 
 =back
 
 
 =back
 

+=head1 CLASS METHODS
+
+=over 4
+
+=item recurring_sql
+
+Returns an SQL expression identifying recurring packages.
+
+=cut
+
+sub recurring_sql { "
+  '0' != ( select freq from part_pkg
+             where cust_pkg.pkgpart = part_pkg.pkgpart )
+"; }
+
+=item onetime_sql
+
+Returns an SQL expression identifying one-time packages.
+
+=cut
+
+sub onetime_sql { "
+  '0' = ( select freq from part_pkg
+            where cust_pkg.pkgpart = part_pkg.pkgpart )
+"; }
+
+=item active_sql
+
+Returns an SQL expression identifying active packages.
+
+=cut
+
+sub active_sql { "
+  ". $_[0]->recurring_sql(). "
+  AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
+  AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
+"; }
+
+=item inactive_sql
+
+Returns an SQL expression identifying inactive packages (one-time packages
+that are otherwise unsuspended/uncancelled).
+
+=cut
+
+sub inactive_sql { "
+  ". $_[0]->onetime_sql(). "
+  AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
+  AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
+"; }
+
+=item susp_sql
+=item suspended_sql
+
+Returns an SQL expression identifying suspended packages.
+
+=cut
+
+sub suspended_sql { susp_sql(@_); }
+sub susp_sql {
+  #$_[0]->recurring_sql(). ' AND '.
+  "
+        ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel = 0 )
+    AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp  != 0
+  ";
+}
+
+=item cancel_sql
+=item cancelled_sql
+
+Returns an SQL exprression identifying cancelled packages.
+
+=cut
+
+sub cancelled_sql { cancel_sql(@_); }
+sub cancel_sql { 
+  #$_[0]->recurring_sql(). ' AND '.
+  "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
+}
+

 =head1 SUBROUTINES
 
 =over 4
 =head1 SUBROUTINES
 
 =over 4


@@ -1106,12 +1319,23 @@ sub order {
   my $cust_main = qsearchs('cust_main', { custnum => $custnum });
   return "Customer not found: $custnum" unless $cust_main;
 
   my $cust_main = qsearchs('cust_main', { custnum => $custnum });
   return "Customer not found: $custnum" unless $cust_main;
 

-  my $change = scalar(@$remove_pkgnum) != 0;
+  my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
+                         @$remove_pkgnum;
+
+  my $change = scalar(@old_cust_pkg) != 0;
+
+  my %hash = (); 
+  if ( scalar(@old_cust_pkg) == 1 ) {
+    #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
+    $hash{'setup'} = time;
+  }

 
   # Create the new packages.
   foreach my $pkgpart (@$pkgparts) {
     my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
 
   # Create the new packages.
   foreach my $pkgpart (@$pkgparts) {
     my $cust_pkg = new FS::cust_pkg { custnum => $custnum,

-                                      pkgpart => $pkgpart };
+                                      pkgpart => $pkgpart,
+                                      %hash,
+                                    };

     $error = $cust_pkg->insert( 'change' => $change );
     if ($error) {
       $dbh->rollback if $oldAutoCommit;
     $error = $cust_pkg->insert( 'change' => $change );
     if ($error) {
       $dbh->rollback if $oldAutoCommit;


@@ -1123,8 +1347,7 @@ sub order {
   # created packages.
 
   # Transfer services and cancel old packages.
   # created packages.
 
   # Transfer services and cancel old packages.

-  foreach my $old_pkgnum (@$remove_pkgnum) {
-    my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum });
+  foreach my $old_pkg (@old_cust_pkg) {

 
     foreach my $new_pkg (@$return_cust_pkg) {
       $error = $old_pkg->transfer($new_pkg);
 
     foreach my $new_pkg (@$return_cust_pkg) {
       $error = $old_pkg->transfer($new_pkg);


@@ -1154,7 +1377,7 @@ sub order {
       $dbh->rollback if $oldAutoCommit;
       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
     }
       $dbh->rollback if $oldAutoCommit;
       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
     }

-    $error = $old_pkg->cancel;
+    $error = $old_pkg->cancel( quiet=>1 );

     if ($error) {
       $dbh->rollback;
       return $error;
     if ($error) {
       $dbh->rollback;
       return $error;