partially unwrap cust_main->cancel_pkgs
[freeside.git] / FS / FS / cust_main.pm
index d1e9a22..79e674d 100644 (file)
@@ -14,7 +14,7 @@ use base qw( FS::cust_main::Packages FS::cust_main::Status
              FS::o2m_Common
              FS::Record
            );
              FS::o2m_Common
              FS::Record
            );
-use vars qw( $DEBUG $me $conf
+use vars qw( $DEBUG $me $conf $default_agent_custid $custnum_display_length
              @encrypted_fields
              $import
              $ignore_expired_card $ignore_banned_card $ignore_illegal_zip
              @encrypted_fields
              $import
              $ignore_expired_card $ignore_banned_card $ignore_illegal_zip
@@ -33,10 +33,9 @@ use Date::Format;
 #use Date::Manip;
 use File::Temp; #qw( tempfile );
 use Business::CreditCard 0.28;
 #use Date::Manip;
 use File::Temp; #qw( tempfile );
 use Business::CreditCard 0.28;
-use Locale::Country;
 use FS::UID qw( getotaker dbh driver_name );
 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
 use FS::UID qw( getotaker dbh driver_name );
 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
-use FS::Misc qw( generate_email send_email generate_ps do_print money_pretty );
+use FS::Misc qw( generate_email send_email generate_ps do_print money_pretty card_types );
 use FS::Msgcat qw(gettext);
 use FS::CurrentUser;
 use FS::TicketSystem;
 use FS::Msgcat qw(gettext);
 use FS::CurrentUser;
 use FS::TicketSystem;
@@ -98,7 +97,8 @@ sub nohistory_fields { ('payinfo', 'paycvv'); }
 #$FS::UID::callback{'FS::cust_main'} = sub { 
 install_callback FS::UID sub { 
   $conf = new FS::Conf;
 #$FS::UID::callback{'FS::cust_main'} = sub { 
 install_callback FS::UID sub { 
   $conf = new FS::Conf;
-  #yes, need it for stuff below (prolly should be cached)
+  $default_agent_custid   = $conf->exists('cust_main-default_agent_custid');
+  $custnum_display_length = $conf->config('cust_main-custnum-display_length');
 };
 
 sub _cache {
 };
 
 sub _cache {
@@ -456,7 +456,8 @@ sub insert {
   $self->auto_agent_custid()
     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
 
   $self->auto_agent_custid()
     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
 
-  my $error = $self->SUPER::insert;
+  my $error =  $self->check_payinfo_cardtype
+            || $self->SUPER::insert;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     #return "inserting cust_main record (transaction rolled back): $error";
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     #return "inserting cust_main record (transaction rolled back): $error";
@@ -541,6 +542,16 @@ sub insert {
 
   }
 
 
   }
 
+  # validate card (needs custnum already set)
+  if ( $self->payby =~ /^(CARD|DCRD)$/
+       && $conf->exists('business-onlinepayment-verification') ) {
+    $error = $self->realtime_verify_bop({ 'method'=>'CC' });
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
   warn "  setting contacts\n"
     if $DEBUG > 1;
 
   warn "  setting contacts\n"
     if $DEBUG > 1;
 
@@ -1531,6 +1542,33 @@ sub replace {
          || $old->payby  =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
 
          || $old->payby  =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
 
+  if (    $self->payby =~ /^(CARD|DCRD)$/
+       && $old->payinfo ne $self->payinfo
+       && $old->paymask ne $self->paymask )
+  {
+    my $error = $self->check_payinfo_cardtype;
+    return $error if $error;
+
+    if ( $conf->exists('business-onlinepayment-verification') ) {
+      #need to standardize paydate for this, false laziness with check
+      my( $m, $y );
+      if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
+        ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
+      } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
+        ( $m, $y ) = ( $2, "19$1" );
+      } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
+        ( $m, $y ) = ( $3, "20$2" );
+      } else {
+        return "Illegal expiration date: ". $self->paydate;
+      }
+      $m = sprintf('%02d',$m);
+      $self->paydate("$y-$m-01");
+
+      $error = $self->realtime_verify_bop({ 'method'=>'CC' });
+      return $error if $error;
+    }
+  }
+
   return "Invoicing locale is required"
     if $old->locale
     && ! $self->locale
   return "Invoicing locale is required"
     if $old->locale
     && ! $self->locale
@@ -2121,6 +2159,25 @@ sub check {
   $self->SUPER::check;
 }
 
   $self->SUPER::check;
 }
 
+sub check_payinfo_cardtype {
+  my $self = shift;
+
+  return '' unless $self->payby =~ /^(CARD|DCRD)$/;
+
+  my $payinfo = $self->payinfo;
+  $payinfo =~ s/\D//g;
+
+  return '' if $payinfo =~ /^99\d{14}$/; #token
+
+  my %bop_card_types = map { $_=>1 } values %{ card_types() };
+  my $cardtype = cardtype($payinfo);
+
+  return "$cardtype not accepted" unless $bop_card_types{$cardtype};
+
+  '';
+
+}
+
 =item replace_check
 
 Additional checks for replace only.
 =item replace_check
 
 Additional checks for replace only.
@@ -2306,33 +2363,60 @@ sub suspend_unless_pkgpart {
 =item cancel [ OPTION => VALUE ... ]
 
 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
 =item cancel [ OPTION => VALUE ... ]
 
 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
+The cancellation time will be now.
 
 
-Available options are:
+=back
+
+Always returns a list: an empty list on success or a list of errors.
+
+=cut
+
+sub cancel {
+  my $self = shift;
+  my %opt = @_;
+  warn "$me cancel called on customer ". $self->custnum. " with options ".
+       join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
+    if $DEBUG;
+  my @pkgs = $self->ncancelled_pkgs;
+
+  $self->cancel_pkgs( %opt, 'cust_pkg' => \@pkgs );
+}
+
+=item cancel_pkgs OPTIONS
+
+Cancels a specified list of packages. OPTIONS can include:
 
 =over 4
 
 
 =over 4
 
+=item cust_pkg - an arrayref of the packages. Required.
+
+=item time - the cancellation time, used to calculate final bills and
+unused-time credits if any. Will be passed through to the bill() and
+FS::cust_pkg::cancel() methods.
+
 =item quiet - can be set true to supress email cancellation notices.
 
 =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 quiet - can be set true to supress email cancellation notices.
 
 =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 cust_pkg_reason - can be an arrayref of L<FS::cust_pkg_reason> objects
+for the individual packages, parallel to the C<cust_pkg> argument. The
+reason and reason_otaker arguments will be taken from those objects.
+
 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
 
 =item nobill - can be set true to skip billing if it might otherwise be done.
 
 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
 
 =item nobill - can be set true to skip billing if it might otherwise be done.
 
-=back
-
-Always returns a list: an empty list on success or a list of errors.
-
 =cut
 
 =cut
 
-# nb that dates are not specified as valid options to this method
-
-sub cancel {
+sub cancel_pkgs {
   my( $self, %opt ) = @_;
 
   my( $self, %opt ) = @_;
 
-  warn "$me cancel called on customer ". $self->custnum. " with options ".
-       join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
-    if $DEBUG;
+  # we're going to cancel services, which is not reversible
+  # but on 3.x, don't strictly enforce this
+  warn "cancel_pkgs should not be run inside a transaction"
+    if $FS::UID::AutoCommit == 0;
+
+  local $FS::UID::AutoCommit = 0;
 
   return ( 'access denied' )
     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
 
   return ( 'access denied' )
     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
@@ -2346,24 +2430,74 @@ sub cancel {
 
     my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
     my $error = $ban->insert;
 
     my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
     my $error = $ban->insert;
-    return ( $error ) if $error;
+    if ($error) {
+      dbh->rollback;
+      return ( $error );
+    }
 
   }
 
 
   }
 
-  my @pkgs = $self->ncancelled_pkgs;
+  my @pkgs = @{ delete $opt{'cust_pkg'} };
+  my $cancel_time = $opt{'time'} || time;
 
 
+  # bill all packages first, so we don't lose usage, service counts for
+  # bulk billing, etc.
   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
     $opt{nobill} = 1;
   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
     $opt{nobill} = 1;
-    my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
-    warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
-      if $error;
+    my $error = $self->bill( 'pkg_list' => [ @pkgs ],
+                             'cancel'   => 1,
+                             'time'     => $cancel_time );
+    if ($error) {
+      warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
+      dbh->rollback;
+      return ( "Error billing during cancellation: $error" );
+    }
+  }
+  dbh->commit;
+
+  $FS::UID::AutoCommit = 1;
+  my @errors;
+  # now cancel all services, the same way we would for individual packages.
+  # if any of them fail, cancel the rest anyway.
+  my @cust_svc = map { $_->cust_svc } @pkgs;
+  my @sorted_cust_svc =
+    map  { $_->[0] }
+    sort { $a->[1] <=> $b->[1] }
+    map  { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; } @cust_svc
+  ;
+  warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ".
+    $self->custnum."\n"
+    if $DEBUG;
+  foreach my $cust_svc (@sorted_cust_svc) {
+    my $part_svc = $cust_svc->part_svc;
+    next if ( defined($part_svc) and $part_svc->preserve );
+    my $error = $cust_svc->cancel; # immediate cancel, no date option
+    push @errors, $error if $error;
+  }
+  if (@errors) {
+    return @errors;
   }
 
   }
 
-  warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
-       scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
+  warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ".
+    $self->custnum. "\n"
     if $DEBUG;
 
     if $DEBUG;
 
-  grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
+  my @cprs;
+  if ($opt{'cust_pkg_reason'}) {
+    @cprs = @{ delete $opt{'cust_pkg_reason'} };
+  }
+  foreach (@pkgs) {
+    my %lopt = %opt;
+    if (@cprs) {
+      my $cpr = shift @cprs;
+      $lopt{'reason'}        = $cpr->reasonnum;
+      $lopt{'reason_otaker'} = $cpr->otaker;
+    }
+    my $error = $_->cancel(%lopt);
+    push @errors, 'pkgnum '.$_->pkgnum.': '.$error if $error;
+  }
+
+  return @errors;
 }
 
 sub _banned_pay_hashref {
 }
 
 sub _banned_pay_hashref {
@@ -2564,7 +2698,13 @@ sub batch_card {
   }else{
     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
   }
   }else{
     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
   }
-  return '' unless $amount > 0;
+  if ($amount <= 0) {
+    warn(sprintf("Customer balance %.2f - in transit amount %.2f is <= 0.\n",
+        $self->balance,
+        $self->in_transit_payments
+    ));
+    return;
+  }
   
   my $invnum = delete $options{invnum};
   my $payby = $options{payby} || $self->payby;  #still dubious
   
   my $invnum = delete $options{invnum};
   my $payby = $options{payby} || $self->payby;  #still dubious
@@ -2974,6 +3114,7 @@ sub in_transit_payments {
     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
       'batchnum' => $pay_batch->batchnum,
       'custnum' => $self->custnum,
     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
       'batchnum' => $pay_batch->batchnum,
       'custnum' => $self->custnum,
+      'status'  => '',
     } ) ) {
       $in_transit_payments += $cust_pay_batch->amount;
     }
     } ) ) {
       $in_transit_payments += $cust_pay_batch->amount;
     }
@@ -3328,6 +3469,91 @@ sub invoicing_list_emailonly_scalar {
   join(', ', $self->invoicing_list_emailonly);
 }
 
   join(', ', $self->invoicing_list_emailonly);
 }
 
+=item contact_list [ CLASSNUM, ... ]
+
+Returns a list of contacts (L<FS::contact> objects) for the customer. If
+a list of contact classnums is given, returns only contacts in those
+classes. If '0' is given, also returns contacts with no class.
+
+If no arguments are given, returns all contacts for the customer.
+
+=cut
+
+sub contact_list {
+  my $self = shift;
+  my $search = {
+    table       => 'contact',
+    select      => 'contact.*',
+    extra_sql   => ' WHERE contact.custnum = '.$self->custnum,
+  };
+
+  my @orwhere;
+  my @classnums;
+  foreach (@_) {
+    if ( $_ eq '0' ) {
+      push @orwhere, 'contact.classnum is null';
+    } elsif ( /^\d+$/ ) {
+      push @classnums, $_;
+    } else {
+      die "bad classnum argument '$_'";
+    }
+  }
+
+  if (@classnums) {
+    push @orwhere, 'contact.classnum IN ('.join(',', @classnums).')';
+  }
+  if (@orwhere) {
+    $search->{extra_sql} .= ' AND (' .
+                            join(' OR ', map "( $_ )", @orwhere) .
+                            ')';
+  }
+
+  qsearch($search);
+}
+
+=item contact_list_email [ CLASSNUM, ... ]
+
+Same as L</contact_list>, but returns email destinations instead of contact
+objects. Also accepts 'invoice' as an argument, in which case this will also
+return the invoice email address if any.
+
+=cut
+
+sub contact_list_email {
+  my $self = shift;
+  my @classnums;
+  my $and_invoice;
+  foreach (@_) {
+    if (/^invoice$/) {
+      $and_invoice = 1;
+    } else {
+      push @classnums, $_;
+    }
+  }
+  my %emails;
+  # if the only argument passed was 'invoice' then no classnums are
+  # intended, so skip this.
+  if ( @classnums ) {
+    my @contacts = $self->contact_list(@classnums);
+    foreach my $contact (@contacts) {
+      foreach my $contact_email ($contact->contact_email) {
+        # unlike on 4.x, we have a separate list of invoice email
+        # destinations.
+        # make sure they're not redundant with contact emails
+        my $dest = $contact->firstlast . ' <' . $contact_email->emailaddress . '>';
+        $emails{ $contact_email->emailaddress } = $dest;
+      }
+    }
+  }
+  if ( $and_invoice ) {
+    foreach my $email ($self->invoicing_list_emailonly) {
+      my $dest = $self->name_short . ' <' . $email . '>';
+      $emails{ $email } ||= $dest;
+    }
+  }
+  values %emails;
+}
+
 =item referral_custnum_cust_main
 
 Returns the customer who referred this customer (or the empty string, if
 =item referral_custnum_cust_main
 
 Returns the customer who referred this customer (or the empty string, if
@@ -4060,34 +4286,16 @@ cust_main-default_agent_custid is set and it has a value, custnum otherwise.
 sub display_custnum {
   my $self = shift;
 
 sub display_custnum {
   my $self = shift;
 
+  return $self->agent_custid
+    if $default_agent_custid && $self->agent_custid;
+
   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
-  if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
-    if ( $special eq 'CoStAg' ) {
-      $prefix = uc( join('',
-        $self->country,
-        ($self->state =~ /^(..)/),
-        $prefix || ($self->agent->agent =~ /^(..)/)
-      ) );
-    }
-    elsif ( $special eq 'CoStCl' ) {
-      $prefix = uc( join('',
-        $self->country,
-        ($self->state =~ /^(..)/),
-        ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
-      ) );
-    }
-    # add any others here if needed
-  }
 
 
-  my $length = $conf->config('cust_main-custnum-display_length');
-  if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
-    return $self->agent_custid;
-  } elsif ( $prefix ) {
-    $length = 8 if !defined($length);
+  if ( $prefix ) {
     return $prefix . 
     return $prefix . 
-           sprintf('%0'.$length.'d', $self->custnum)
-  } elsif ( $length ) {
-    return sprintf('%0'.$length.'d', $self->custnum);
+           sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
+  } elsif ( $custnum_display_length ) {
+    return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
   } else {
     return $self->custnum;
   }
   } else {
     return $self->custnum;
   }
@@ -4214,26 +4422,14 @@ sub ship_contact_firstlast {
   $contact->get('first') . ' '. $contact->get('last');
 }
 
   $contact->get('first') . ' '. $contact->get('last');
 }
 
-#XXX this doesn't work in 3.x+
-#=item country_full
-#
-#Returns this customer's full country name
-#
-#=cut
-#
-#sub country_full {
-#  my $self = shift;
-#  code2country($self->country);
-#}
-
 sub bill_country_full {
   my $self = shift;
 sub bill_country_full {
   my $self = shift;
-  code2country($self->bill_location->country);
+  $self->bill_location->country_full;
 }
 
 sub ship_country_full {
   my $self = shift;
 }
 
 sub ship_country_full {
   my $self = shift;
-  code2country($self->ship_location->country);
+  $self->ship_location->country_full;
 }
 
 =item county_state_county [ PREFIX ]
 }
 
 =item county_state_county [ PREFIX ]
@@ -4292,13 +4488,17 @@ sub status { shift->cust_status(@_); }
 
 sub cust_status {
   my $self = shift;
 
 sub cust_status {
   my $self = shift;
+  return $self->hashref->{cust_status} if $self->hashref->{cust_status};
   for my $status ( FS::cust_main->statuses() ) {
     my $method = $status.'_sql';
     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
     $sth->execute( ($self->custnum) x $numnum )
       or die "Error executing 'SELECT $sql': ". $sth->errstr;
   for my $status ( FS::cust_main->statuses() ) {
     my $method = $status.'_sql';
     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
     $sth->execute( ($self->custnum) x $numnum )
       or die "Error executing 'SELECT $sql': ". $sth->errstr;
-    return $status if $sth->fetchrow_arrayref->[0];
+    if ( $sth->fetchrow_arrayref->[0] ) {
+      $self->hashref->{cust_status} = $status;
+      return $status;
+    }
   }
 }
 
   }
 }
 
@@ -4395,6 +4595,30 @@ sub tickets {
   (@tickets);
 }
 
   (@tickets);
 }
 
+=item appointments [ STATUS ]
+
+Returns an array of hashes representing the customer's RT tickets which
+are appointments.
+
+=cut
+
+sub appointments {
+  my $self = shift;
+  my $status = ( @_ && $_[0] ) ? shift : '';
+
+  return () unless $conf->config('ticket_system');
+
+  my $queueid = $conf->config('ticket_system-appointment-queueid');
+
+  @{ FS::TicketSystem->customer_tickets( $self->custnum,
+                                         99,
+                                         undef,
+                                         $status,
+                                         $queueid,
+                                       )
+  };
+}
+
 # Return services representing svc_accts in customer support packages
 sub support_services {
   my $self = shift;
 # Return services representing svc_accts in customer support packages
 sub support_services {
   my $self = shift;
@@ -5138,6 +5362,8 @@ I<extra_fields> - a hashref of name/value pairs which will be substituted
    into the template.  These values may override values mentioned below
    and those from the customer record.
 
    into the template.  These values may override values mentioned below
    and those from the customer record.
 
+I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
+
 The following variables are available in the template instead of or in addition
 to the fields of the customer record.
 
 The following variables are available in the template instead of or in addition
 to the fields of the customer record.
 
@@ -5153,11 +5379,16 @@ I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or
 sub generate_letter {
   my ($self, $template, %options) = @_;
 
 sub generate_letter {
   my ($self, $template, %options) = @_;
 
-  return unless $conf->exists($template);
+  warn "Template $template does not exist" && return
+    unless $conf->exists($template) || $options{'template_text'};
+
+  my $template_source = $options{'template_text'} 
+                        ? [ $options{'template_text'} ] 
+                        : [ map "$_\n", $conf->config($template) ];
 
   my $letter_template = new Text::Template
                         ( TYPE       => 'ARRAY',
 
   my $letter_template = new Text::Template
                         ( TYPE       => 'ARRAY',
-                          SOURCE     => [ map "$_\n", $conf->config($template)],
+                          SOURCE     => $template_source,
                           DELIMITERS => [ '[@--', '--@]' ],
                         )
     or die "can't create new Text::Template object: Text::Template::ERROR";
                           DELIMITERS => [ '[@--', '--@]' ],
                         )
     or die "can't create new Text::Template object: Text::Template::ERROR";