when canceling all packages for a customer, remove all services in cancel weight...
[freeside.git] / FS / FS / cust_main.pm
index be02f9c..5af1b31 100644 (file)
@@ -98,12 +98,15 @@ our @encrypted_fields = ('payinfo', 'paycvv');
 sub nohistory_fields { ('payinfo', 'paycvv'); }
 
 our $conf;
+our $default_agent_custid;
+our $custnum_display_length;
 #ask FS::UID to run this stuff for us later
 #$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)
-  $ignore_invalid_card = $conf->exists('allow_invalid_cards');
+  $ignore_invalid_card    = $conf->exists('allow_invalid_cards');
+  $default_agent_custid   = $conf->exists('cust_main-default_agent_custid');
+  $custnum_display_length = $conf->config('cust_main-custnum-display_length');
 };
 
 sub _cache {
@@ -529,6 +532,7 @@ sub insert {
     foreach my $prospect_contact ( $prospect_main->prospect_contact ) {
       my $cust_contact = new FS::cust_contact {
         'custnum' => $self->custnum,
+        'invoice_dest' => 'Y', # invoice_dest currently not set for prospect contacts
         map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment )
       };
       my $error =  $cust_contact->insert
@@ -551,7 +555,10 @@ sub insert {
         return $error;
       }
     }
-
+    # since we set invoice_dest on all migrated prospect contacts (for now),
+    # don't process invoicing_list.
+    delete $options{'invoicing_list'};
+    $invoicing_list = undef;
   }
 
   warn "  setting contacts\n"
@@ -575,8 +582,7 @@ sub insert {
               custnum       => $self->custnum,
           });
           $cust_contact->set('invoice_dest', 'Y');
-          my $error = $cust_contact->contactnum ?
-                        $cust_contact->replace : $cust_contact->insert;
+          my $error = $cust_contact->insert;
           if ( $error ) {
             $dbh->rollback if $oldAutoCommit;
             return "$error (linking to email address $dest)";
@@ -1769,7 +1775,7 @@ sub check {
     || $self->ut_flag('message_noemail')
     || $self->ut_enum('locale', [ '', FS::Locales->locales ])
     || $self->ut_currencyn('currency')
-    || $self->ut_alphan('po_number')
+    || $self->ut_textn('po_number')
     || $self->ut_enum('complimentary', [ '', 'Y' ])
     || $self->ut_flag('invoice_ship_address')
     || $self->ut_flag('invoice_dest')
@@ -1951,8 +1957,13 @@ Returns all locations (see L<FS::cust_location>) for this customer.
 
 sub cust_location {
   my $self = shift;
-  qsearch('cust_location', { 'custnum'     => $self->custnum,
-                             'prospectnum' => '' } );
+  qsearch({
+    'table'   => 'cust_location',
+    'hashref' => { 'custnum'     => $self->custnum,
+                   'prospectnum' => '',
+                 },
+    'order_by' => 'ORDER BY country, LOWER(state), LOWER(city), LOWER(county), LOWER(address1), LOWER(address2)',
+  });
 }
 
 =item cust_contact
@@ -1983,7 +1994,9 @@ sub cust_payby {
     'hashref'  => { 'custnum' => $self->custnum },
     'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
   };
-  $search->{'extra_sql'} = ' AND payby IN ( ' . join(',', map { dbh->quote($_) } @payby) . ' ) '
+  $search->{'extra_sql'} = ' AND payby IN ( '.
+                               join(',', map dbh->quote($_), @payby).
+                             ' ) '
     if @payby;
 
   qsearch($search);
@@ -2137,6 +2150,9 @@ Always returns a list: an empty list on success or a list of errors.
 sub cancel {
   my( $self, %opt ) = @_;
 
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+
   warn "$me cancel called on customer ". $self->custnum. " with options ".
        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
     if $DEBUG;
@@ -2156,7 +2172,10 @@ sub cancel {
 
       my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
       my $error = $ban->insert;
-      return ( $error ) if $error;
+      if ($error) {
+        dbh->rollback if $oldAutoCommit;
+        return ( $error );
+      }
 
     }
 
@@ -2164,18 +2183,54 @@ sub cancel {
 
   my @pkgs = $self->ncancelled_pkgs;
 
+  # 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;
     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
-    warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
-      if $error;
+    if ($error) {
+      # we should return an error and exit in this case, yes?
+      warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
+      dbh->rollback if $oldAutoCommit;
+      return ( "Error billing during cancellation: $error" );
+    }
   }
 
-  warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
-       scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
+  my @errors;
+  # now cancel all services, the same way we would for individual packages
+  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) {
+    # then we won't get to the point of canceling packages
+    dbh->rollback if $oldAutoCommit;
+    return @errors;
+  }
+
+  warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ".
+    $self->custnum. "\n"
+    if $DEBUG;
+
+  @errors = grep { $_ } map { $_->cancel(%opt) } @pkgs;
+  if (@errors) {
+    dbh->rollback if $oldAutoCommit;
+    return @errors;
+  }
 
-  grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
+  return;
 }
 
 sub _banned_pay_hashref {
@@ -2328,6 +2383,8 @@ Removes the I<paycvv> field from the database directly.
 
 If there is an error, returns the error, otherwise returns false.
 
+DEPRECATED.  Use L</remove_cvv_from_cust_payby> instead.
+
 =cut
 
 sub remove_cvv {
@@ -2869,6 +2926,73 @@ sub invoicing_list_emailonly_scalar {
   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 the pseudo-classnum 'invoice' is given, returns contacts that
+are marked as invoice destinations. 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.*, cust_contact.invoice_dest',
+    addl_from   => ' JOIN cust_contact USING (contactnum)',
+    extra_sql   => ' WHERE cust_contact.custnum = '.$self->custnum,
+  };
+
+  my @orwhere;
+  my @classnums;
+  foreach (@_) {
+    if ( $_ eq 'invoice' ) {
+      push @orwhere, 'cust_contact.invoice_dest = \'Y\'';
+    } elsif ( $_ eq '0' ) {
+      push @orwhere, 'cust_contact.classnum is null';
+    } elsif ( /^\d+$/ ) {
+      push @classnums, $_;
+    } else {
+      die "bad classnum argument '$_'";
+    }
+  }
+
+  if (@classnums) {
+    push @orwhere, 'cust_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.
+
+=cut
+
+sub contact_list_email {
+  my $self = shift;
+  my @contacts = $self->contact_list(@_);
+  my @emails;
+  foreach my $contact (@contacts) {
+    foreach my $contact_email ($contact->contact_email) {
+      push @emails,
+        $contact->firstlast . ' <' . $contact_email->emailaddress . '>';
+    }
+  }
+  @emails;
+}
+
 =item referral_custnum_cust_main
 
 Returns the customer who referred this customer (or the empty string, if
@@ -3364,9 +3488,12 @@ Returns all the credits (see L<FS::cust_credit>) for this customer.
 
 sub cust_credit {
   my $self = shift;
-  map { $_ } #return $self->num_cust_credit unless wantarray;
-  sort { $a->_date <=> $b->_date }
-    qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
+
+  #return $self->num_cust_credit unless wantarray;
+
+  map { $_ } #behavior of sort undefined in scalar context
+    sort { $a->_date <=> $b->_date }
+      qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
 }
 
 =item cust_credit_pkgnum
@@ -3576,34 +3703,16 @@ cust_main-default_agent_custid is set and it has a value, custnum otherwise.
 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) || '';
-  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 . 
-           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;
   }
@@ -3810,13 +3919,17 @@ sub status { shift->cust_status(@_); }
 
 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;
-    return $status if $sth->fetchrow_arrayref->[0];
+    if ( $sth->fetchrow_arrayref->[0] ) {
+      $self->hashref->{cust_status} = $status;
+      return $status;
+    }
   }
 }
 
@@ -4308,7 +4421,10 @@ sub save_cust_payby {
 
   # compare to FS::cust_main::realtime_bop - check both to make sure working correctly
   if ( $payby eq 'CARD' &&
-       grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save') ) {
+       ( (grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save')) 
+         || $conf->exists('business-onlinepayment-verification') 
+       )
+  ) {
     $new->set( 'paycvv' => $opt{'paycvv'} );
   } else {
     $new->set( 'paycvv' => '');
@@ -4455,6 +4571,33 @@ PAYBYLOOP:
 
 }
 
+=item remove_cvv_from_cust_payby PAYINFO
+
+Removes paycvv from associated cust_payby with matching PAYINFO.
+
+=cut
+
+sub remove_cvv_from_cust_payby {
+  my ($self,$payinfo) = @_;
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  foreach my $cust_payby ( qsearch('cust_payby',{ custnum => $self->custnum }) ) {
+    next unless $cust_payby->payinfo eq $payinfo; # can't qsearch on payinfo
+    $cust_payby->paycvv('');
+    my $error = $cust_payby->replace;
+    if ($error) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+}
+
 =back
 
 =head1 CLASS METHODS