This commit was generated by cvs2svn to compensate for changes in r6252,
[freeside.git] / FS / FS / cust_pkg.pm
index eca3af4..d413596 100644 (file)
@@ -21,6 +21,7 @@ use FS::reg_code;
 use FS::part_svc;
 use FS::cust_pkg_reason;
 use FS::reason;
+use FS::UI::Web;
 
 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
 # setup }
@@ -229,9 +230,11 @@ sub insert {
 
         my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq );
         my $error =
-          $referring_cust_main->credit( $amount,
-                                        'Referral credit for '. $cust_main->name
-                                      );
+          $referring_cust_main->
+            credit( $amount,
+                    'Referral credit for '.$cust_main->name,
+                    'reason_type' => $conf->config('referral_credit_type')
+                  );
         if ( $error ) {
           $dbh->rollback if $oldAutoCommit;
           return "Error crediting customer ". $cust_main->referral_custnum.
@@ -523,10 +526,12 @@ sub cancel {
     # Add a credit for remaining service
     my $remaining_value = $self->calc_remain(time=>$cancel_time);
     if ( $remaining_value > 0 && !$options{'no_credit'} ) {
+      my $conf = new FS::Conf;
       my $error = $self->cust_main->credit(
-                                           $remaining_value,
-                                           'Credit for unused time on '. $self->part_pkg->pkg,
-                                           );
+        $remaining_value,
+        'Credit for unused time on '. $self->part_pkg->pkg,
+        'reason_type' => $conf->config('cancel_credit_type'),
+      );
       if ($error) {
         $dbh->rollback if $oldAutoCommit;
         return "Error crediting customer \$$remaining_value for unused time on".
@@ -552,7 +557,7 @@ sub cancel {
     my $error = send_email(
       'from'    => $conf->config('invoice_from'),
       'to'      => \@invoicing_list,
-      'subject' => $conf->config('cancelsubject'),
+      'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
       'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
     );
     #should this do something on errors?
@@ -793,6 +798,18 @@ sub part_pkg {
     : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
 }
 
+=item old_cust_pkg
+
+Returns the cancelled package this package was changed from, if any.
+
+=cut
+
+sub old_cust_pkg {
+  my $self = shift;
+  return '' unless $self->change_pkgnum;
+  qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
+}
+
 =item calc_setup
 
 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
@@ -1535,6 +1552,228 @@ sub cancel_sql {
   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
 }
 
+=item search_sql HREF
+
+Returns a qsearch hash expression to search for parameters specified in HREF.
+Valid parameters are
+
+=over 4
+=item agentnum
+=item magic - /^(active|inactive|suspended|cancell?ed)$/
+=item status - /^(active|inactive|suspended|one-time charge|inactive|cancell?ed)$/
+=item classnum
+=item pkgpart - list specified how?
+=item setup     - arrayref of beginning and ending epoch date
+=item last_bill - arrayref of beginning and ending epoch date
+=item bill      - arrayref of beginning and ending epoch date
+=item adjourn   - arrayref of beginning and ending epoch date
+=item susp      - arrayref of beginning and ending epoch date
+=item expire    - arrayref of beginning and ending epoch date
+=item cancel    - arrayref of beginning and ending epoch date
+=item query - /^(pkgnum/APKG_pkgnum)$/
+=item cust_fields - a value suited to passing to FS::UI::Web::cust_header
+=item CurrentUser - specifies the user for agent virtualization
+=back
+
+=cut
+
+sub search_sql { 
+  my ($class, $params) = @_;
+  my @where = ();
+
+  ##
+  # parse agent
+  ##
+
+  if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
+    push @where,
+      "cust_main.agentnum = $1";
+  }
+
+  ##
+  # parse status
+  ##
+
+  if (    $params->{'magic'}  eq 'active'
+       || $params->{'status'} eq 'active' ) {
+
+    push @where, FS::cust_pkg->active_sql();
+
+  } elsif (    $params->{'magic'}  eq 'inactive'
+            || $params->{'status'} eq 'inactive' ) {
+
+    push @where, FS::cust_pkg->inactive_sql();
+
+  } elsif (    $params->{'magic'}  eq 'suspended'
+            || $params->{'status'} eq 'suspended'  ) {
+
+    push @where, FS::cust_pkg->suspended_sql();
+
+  } elsif (    $params->{'magic'}  =~ /^cancell?ed$/
+            || $params->{'status'} =~ /^cancell?ed$/ ) {
+
+    push @where, FS::cust_pkg->cancelled_sql();
+
+  } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) {
+
+    push @where, FS::cust_pkg->inactive_sql();
+
+  }
+
+  ###
+  # parse package class
+  ###
+
+  #false lazinessish w/graph/cust_bill_pkg.cgi
+  my $classnum = 0;
+  my @pkg_class = ();
+  if ( exists($params->{'classnum'})
+       && $params->{'classnum'} =~ /^(\d*)$/
+     )
+  {
+    $classnum = $1;
+    if ( $classnum ) { #a specific class
+      push @where, "classnum = $classnum";
+
+      #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
+      #die "classnum $classnum not found!" unless $pkg_class[0];
+      #$title .= $pkg_class[0]->classname.' ';
+
+    } elsif ( $classnum eq '' ) { #the empty class
+
+      push @where, "classnum IS NULL";
+      #$title .= 'Empty class ';
+      #@pkg_class = ( '(empty class)' );
+    } elsif ( $classnum eq '0' ) {
+      #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
+      #push @pkg_class, '(empty class)';
+    } else {
+      die "illegal classnum";
+    }
+  }
+  #eslaf
+
+  ###
+  # parse part_pkg
+  ###
+
+  my $pkgpart = join (' OR pkgpart=',
+                      grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
+  push @where,  '(pkgpart=' . $pkgpart . ')' if $pkgpart;
+
+  ###
+  # parse dates
+  ###
+
+  my $orderby = '';
+
+  #false laziness w/report_cust_pkg.html
+  my %disable = (
+    'all'             => {},
+    'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
+    'active'          => { 'susp'=>1, 'cancel'=>1 },
+    'suspended'       => { 'cancel' => 1 },
+    'cancelled'       => {},
+    ''                => {},
+  );
+
+  foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
+
+    next unless exists($params->{$field});
+
+    my($beginning, $ending) = @{$params->{$field}};
+
+    next if $beginning == 0 && $ending == 4294967295;
+
+    push @where,
+      "cust_pkg.$field IS NOT NULL",
+      "cust_pkg.$field >= $beginning",
+      "cust_pkg.$field <= $ending";
+
+    $orderby ||= "ORDER BY cust_pkg.$field";
+
+  }
+
+  $orderby ||= 'ORDER BY bill';
+
+  ###
+  # parse magic, legacy, etc.
+  ###
+
+  if ( $params->{'magic'} &&
+       $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
+  ) {
+
+    $orderby = 'ORDER BY pkgnum';
+
+    if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
+      push @where, "pkgpart = $1";
+    }
+
+  } elsif ( $params->{'query'} eq 'pkgnum' ) {
+
+    $orderby = 'ORDER BY pkgnum';
+
+  } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
+
+    $orderby = 'ORDER BY pkgnum';
+
+    push @where, '0 < (
+      SELECT count(*) FROM pkg_svc
+       WHERE pkg_svc.pkgpart =  cust_pkg.pkgpart
+         AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
+                                   WHERE cust_svc.pkgnum  = cust_pkg.pkgnum
+                                     AND cust_svc.svcpart = pkg_svc.svcpart
+                                )
+    )';
+  
+  }
+
+  ##
+  # setup queries, links, subs, etc. for the search
+  ##
+
+  # here is the agent virtualization
+  if ($params->{CurrentUser}) {
+    my $access_user =
+      qsearchs('access_user', { username => $params->{CurrentUser} });
+
+    if ($access_user) {
+      push @where, $access_user->agentnums_sql('table'=>'cust_main');
+    }else{
+      push @where, "1=0";
+    }
+  }else{
+    push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
+  }
+
+  my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
+
+  my $addl_from = 'LEFT JOIN cust_main USING ( custnum  ) '.
+                  'LEFT JOIN part_pkg  USING ( pkgpart  ) '.
+                  'LEFT JOIN pkg_class USING ( classnum ) ';
+
+  my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
+
+  my $sql_query = {
+    'table'       => 'cust_pkg',
+    'hashref'     => {},
+    'select'      => join(', ',
+                                'cust_pkg.*',
+                                ( map "part_pkg.$_", qw( pkg freq ) ),
+                                'pkg_class.classname',
+                                'cust_main.custnum as cust_main_custnum',
+                                FS::UI::Web::cust_sql_fields(
+                                  $params->{'cust_fields'}
+                                ),
+                     ),
+    'extra_sql'   => "$extra_sql $orderby",
+    'addl_from'   => $addl_from,
+    'count_query' => $count_query,
+  };
+
+}
+
 =head1 SUBROUTINES
 
 =over 4
@@ -1591,9 +1830,17 @@ sub order {
   my $change = scalar(@old_cust_pkg) != 0;
 
   my %hash = (); 
-  if ( scalar(@old_cust_pkg) == 1 ) {
+  if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
+
+    my $time = time;
+
     #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
-    $hash{'setup'} = time;
+    
+    #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup );
+    $hash{'setup'} = $time if $old_cust_pkg[0]->setup;
+
+    $hash{'change_date'} = $time;
+    $hash{"change_$_"}  = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart );
   }
 
   # Create the new packages.
@@ -1674,6 +1921,64 @@ If there is an error, returns the error, otherwise returns false.
 
 =cut
 
+=item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
+
+PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
+L<FS::part_pkg>) to order for this customer.  Duplicates are of course
+permitted.
+
+REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
+replace.  The services (see L<FS::cust_svc>) are moved to the
+new billing items.  An error is returned if this is not possible (see
+L<FS::pkg_svc>).
+
+RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
+newly-created cust_pkg objects.
+
+=cut
+
+sub bulk_change {
+  my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
+
+  # Transactionize this whole mess
+  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;
+
+  my @errors;
+  my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
+                         @$remove_pkgnum;
+
+  while(scalar(@old_cust_pkg)) {
+    my @return = ();
+    my $custnum = $old_cust_pkg[0]->custnum;
+    my (@remove) = map { $_->pkgnum }
+                   grep { $_->custnum == $custnum } @old_cust_pkg;
+    @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
+
+    my $error = order $custnum, $pkgparts, \@remove, \@return;
+
+    push @errors, $error
+      if $error;
+    push @$return_cust_pkg, @return;
+  }
+
+  if (scalar(@errors)) {
+    $dbh->rollback if $oldAutoCommit;
+    return join(' / ', @errors);
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+}
+
 sub insert_reason {
   my ($self, %options) = @_;
 
@@ -1704,7 +2009,7 @@ sub insert_reason {
 
   my $cust_pkg_reason =
     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
-                              'reasonnum' => $options{'reason'}
+                              'reasonnum' => $reasonnum
                              'otaker'    => $otaker,
                              'date'      => $options{'date'}
                                               ? $options{'date'}
@@ -1734,6 +2039,26 @@ sub set_usage {
   }
 }
 
+=item recharge USAGE_VALUE_HASHREF 
+
+USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
+to which they should be set (see L<FS::svc_acct>).  Currently seconds,
+upbytes, downbytes, and totalbytes are appropriate keys.
+
+All svc_accts which are part of this package have their values incremented.
+
+=cut
+
+sub recharge {
+  my ($self, $valueref) = @_;
+
+  foreach my $cust_svc ($self->cust_svc){
+    my $svc_x = $cust_svc->svc_x;
+    $svc_x->recharge($valueref)
+      if $svc_x->can("recharge");
+  }
+}
+
 =back
 
 =head1 BUGS