first part of ACL and re-skinning work and some other small stuff

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

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index cd808d4..783cc73 100644 (file)
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -3,8 +3,9 @@ package FS::cust_pkg;
 use strict;
 use vars qw(@ISA $disable_agentcheck @SVCDB_CANCEL_SEQ $DEBUG);
 use FS::UID qw( getotaker dbh );
 use strict;
 use vars qw(@ISA $disable_agentcheck @SVCDB_CANCEL_SEQ $DEBUG);
 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 +17,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 +26,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 +142,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 +264,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 +283,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 +359,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 +453,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 +476,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(


@@ -748,6 +801,54 @@ 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;
+
+  return 'cancelled' if $self->get('cancel');
+  return 'suspended' if $self->susp;
+  return 'not yet billed' unless $self->setup;
+  return 'one-time charge' if $self->part_pkg->freq =~ /^(0|$)/;
+  return 'active';
+}
+
+=item statuscolor
+
+Returns a hex triplet color string for this package's status.
+
+=cut
+
+my %statuscolor = (
+  'not yet billed'  => '000000',
+  'one-time charge' => '000000',
+  'active'          => '00CC00',
+  'suspended'       => 'FF9900',
+  'cancelled'       => 'FF0000',
+);
+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 +1163,60 @@ sub reexport {
 
 =back
 
 
 =back
 

+=head1 CLASS METHOD
+
+=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 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 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 +1261,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 +1289,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);