self-service interface: add proper password changer and prevent "Setup my services...
[freeside.git] / FS / FS / cust_main.pm
index 62e6a5c..f1d969c 100644 (file)
@@ -20,6 +20,7 @@ use Date::Parse;
 #use Date::Manip;
 use String::Approx qw(amatch);
 use Business::CreditCard 0.28;
+use Locale::Country;
 use FS::UID qw( getotaker dbh );
 use FS::Record qw( qsearchs qsearch dbdef );
 use FS::Misc qw( send_email );
@@ -79,7 +80,7 @@ sub _cache {
   my $self = shift;
   my ( $hashref, $cache ) = @_;
   if ( exists $hashref->{'pkgnum'} ) {
-#    #@{ $self->{'_pkgnum'} } = ();
+    #@{ $self->{'_pkgnum'} } = ();
     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
     $self->{'_pkgnum'} = $subcache;
     #push @{ $self->{'_pkgnum'} },
@@ -923,6 +924,8 @@ sub replace {
   my $self = shift;
   my $old = shift;
   my @param = @_;
+  warn "$me replace called\n"
+    if $DEBUG;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -941,10 +944,13 @@ sub replace {
     $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
   }
 
-  if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
-       && $conf->config('users-allow_comp')                  ) {
-    return "You are not permitted to create complimentary accounts."
-      unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
+  my $curuser = $FS::CurrentUser::CurrentUser;
+  if (    $self->payby eq 'COMP'
+       && $self->payby ne $old->payby
+       && ! $curuser->access_right('Complimentary customer')
+     )
+  {
+    return "You are not permitted to create complimentary accounts.";
   }
 
   local($ignore_expired_card) = 1
@@ -1213,7 +1219,12 @@ sub check {
       if cardtype($self->payinfo) eq "Unknown";
 
     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
-    return "Banned credit card" if $ban;
+    if ( $ban ) {
+      return 'Banned credit card: banned on '.
+             time2str('%a %h %o at %r', $ban->_date).
+             ' by '. $ban->otaker.
+             ' (ban# '. $ban->bannum. ')';
+    }
 
     if ( defined $self->dbdef_table->column('paycvv') ) {
       if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
@@ -1261,15 +1272,21 @@ sub check {
     $payinfo =~ s/[^\d\@]//g;
     if ( $conf->exists('echeck-nonus') ) {
       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
+      $payinfo = "$1\@$2";
     } else {
       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
+      $payinfo = "$1\@$2";
     }
-    $payinfo = "$1\@$2";
     $self->payinfo($payinfo);
     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 
     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
-    return "Banned ACH account" if $ban;
+    if ( $ban ) {
+      return 'Banned ACH account: banned on '.
+             time2str('%a %h %o at %r', $ban->_date).
+             ' by '. $ban->otaker.
+             ' (ban# '. $ban->bannum. ')';
+    }
 
   } elsif ( $self->payby eq 'LECB' ) {
 
@@ -1288,9 +1305,12 @@ sub check {
 
   } elsif ( $self->payby eq 'COMP' ) {
 
-    if ( !$self->custnum && $conf->config('users-allow_comp') ) {
+    my $curuser = $FS::CurrentUser::CurrentUser;
+    if (    ! $self->custnum
+         && ! $curuser->access_right('Complimentary customer')
+       )
+    {
       return "You are not permitted to create complimentary accounts."
-        unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
     }
 
     $error = $self->ut_textn('payinfo');
@@ -1311,7 +1331,7 @@ sub check {
   }
 
   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
-    return "Expriation date required"
+    return "Expiration date required"
       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
     $self->paydate('');
   } else {
@@ -1802,29 +1822,26 @@ sub bill {
 
         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
 
-          my @taxes = qsearch( 'cust_main_county', {
-                                 'state'    => $self->state,
-                                 'county'   => $self->county,
-                                 'country'  => $self->country,
-                                 'taxclass' => $part_pkg->taxclass,
-                                                                      } );
+          my $prefix = 
+            ( $conf->exists('tax-ship_address') && length($self->ship_last) )
+            ? 'ship_'
+            : '';
+          my %taxhash = map { $_ => $self->get("$prefix$_") }
+                            qw( state county country );
+
+          $taxhash{'taxclass'} = $part_pkg->taxclass;
+
+          my @taxes = qsearch( 'cust_main_county', \%taxhash );
+
           unless ( @taxes ) {
-            @taxes =  qsearch( 'cust_main_county', {
-                                  'state'    => $self->state,
-                                  'county'   => $self->county,
-                                  'country'  => $self->country,
-                                  'taxclass' => '',
-                                                                      } );
+            $taxhash{'taxclass'} = '';
+            @taxes =  qsearch( 'cust_main_county', \%taxhash );
           }
 
           #one more try at a whole-country tax rate
           unless ( @taxes ) {
-            @taxes =  qsearch( 'cust_main_county', {
-                                  'state'    => '',
-                                  'county'   => '',
-                                  'country'  => $self->country,
-                                  'taxclass' => '',
-                                                                      } );
+            $taxhash{$_} = '' foreach qw( state county );
+            @taxes =  qsearch( 'cust_main_county', \%taxhash );
           }
 
           # maybe eliminate this entirely, along with all the 0% records
@@ -1832,8 +1849,10 @@ sub bill {
             $dbh->rollback if $oldAutoCommit;
             return
               "fatal: can't find tax rate for state/county/country/taxclass ".
-              join('/', ( map $self->$_(), qw(state county country) ),
-                        $part_pkg->taxclass ).  "\n";
+              join('/', ( map $self->get("$prefix$_"),
+                              qw(state county country)
+                        ),
+                        $part_pkg->taxclass ). "\n";
           }
   
           foreach my $tax ( @taxes ) {
@@ -2027,6 +2046,8 @@ quiet - set true to surpress email card/ACH decline notices.
 freq - "1d" for the traditional, daily events (the default), or "1m" for the
 new monthly events
 
+payby - allows for one time override of normal customer billing method
+
 =cut
 
 sub collect {
@@ -2097,7 +2118,10 @@ sub collect {
              }
           qsearch( {
             'table'     => 'part_bill_event',
-            'hashref'   => { 'payby'    => $self->payby,
+            'hashref'   => { 'payby'    => (exists($options{'payby'})
+                                            ? $options{'payby'}
+                                            : $self->payby
+                                          ),
                              'disabled' => '',           },
             'extra_sql' => $extra_sql,
           } )
@@ -3124,6 +3148,29 @@ sub balance_date {
   );
 }
 
+=item in_transit_payments
+
+Returns the total of requests for payments for this customer pending in 
+batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
+
+=cut
+
+sub in_transit_payments {
+  my $self = shift;
+  my $in_transit_payments = 0;
+  foreach my $pay_batch ( qsearch('pay_batch', {
+    'status' => 'I',
+  } ) ) {
+    foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
+      'batchnum' => $pay_batch->batchnum,
+      'custnum' => $self->custnum,
+    } ) ) {
+      $in_transit_payments += $cust_pay_batch->amount;
+    }
+  }
+  sprintf( "%.2f", $in_transit_payments );
+}
+
 =item paydate_monthyear
 
 Returns a two-element list consisting of the month and year of this customer's
@@ -3174,6 +3221,7 @@ This interface may change in the future.
 
 sub invoicing_list {
   my( $self, $arrayref ) = @_;
+
   if ( $arrayref ) {
     my @cust_main_invoice;
     if ( $self->custnum ) {
@@ -3208,12 +3256,14 @@ sub invoicing_list {
       warn $error if $error;
     }
   }
+  
   if ( $self->custnum ) {
     map { $_->address }
       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
   } else {
     ();
   }
+
 }
 
 =item check_invoicing_list ARRAYREF
@@ -3291,6 +3341,18 @@ sub invoicing_list_addpost {
   $self->invoicing_list(\@invoicing_list);
 }
 
+=item invoicing_list_emailonly
+
+Returns the list of email invoice recipients (invoicing_list without non-email
+destinations such as POST and FAX).
+
+=cut
+
+sub invoicing_list_emailonly {
+  my $self = shift;
+  grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
+}
+
 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
 
 Returns an array of customers referred by this customer (referral_custnum set
@@ -3588,6 +3650,17 @@ sub ship_contact {
     : $self->contact;
 }
 
+=item country_full
+
+Returns this customer's full country name
+
+=cut
+
+sub country_full {
+  my $self = shift;
+  code2country($self->country);
+}
+
 =item status
 
 Returns a status string for this customer, currently:
@@ -3598,6 +3671,8 @@ Returns a status string for this customer, currently:
 
 =item active - One or more recurring packages is active
 
+=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
+
 =item suspended - All non-cancelled recurring packages are suspended
 
 =item cancelled - All recurring packages are cancelled
@@ -3608,7 +3683,7 @@ Returns a status string for this customer, currently:
 
 sub status {
   my $self = shift;
-  for my $status (qw( prospect active suspended cancelled )) {
+  for my $status (qw( prospect active inactive suspended cancelled )) {
     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;
@@ -3623,12 +3698,15 @@ Returns a hex triplet color string for this customer's status.
 
 =cut
 
-my %statuscolor = (
-  'prospect'  => '000000',
-  'active'    => '00CC00',
-  'suspended' => 'FF9900',
-  'cancelled' => 'FF0000',
+use vars qw(%statuscolor);
+%statuscolor = (
+  'prospect'  => '7e0079', #'000000', #black?  naw, purple
+  'active'    => '00CC00', #green
+  'inactive'  => '0000CC', #blue
+  'suspended' => 'FF9900', #yellow
+  'cancelled' => 'FF0000', #red
 );
+
 sub statuscolor {
   my $self = shift;
   $statuscolor{$self->status};
@@ -3647,25 +3725,44 @@ with no packages ever ordered)
 
 =cut
 
+use vars qw($select_count_pkgs);
+$select_count_pkgs =
+  "SELECT COUNT(*) FROM cust_pkg
+    WHERE cust_pkg.custnum = cust_main.custnum";
+
+sub select_count_pkgs_sql {
+  $select_count_pkgs;
+}
+
 sub prospect_sql { "
-  0 = ( SELECT COUNT(*) FROM cust_pkg
-          WHERE cust_pkg.custnum = cust_main.custnum
-      )
+  0 = ( $select_count_pkgs )
 "; }
 
 =item active_sql
 
-Returns an SQL expression identifying active cust_main records.
+Returns an SQL expression identifying active cust_main records (customers with
+no active recurring packages, but otherwise unsuspended/uncancelled).
 
 =cut
 
 sub active_sql { "
-  0 < ( SELECT COUNT(*) FROM cust_pkg
-          WHERE cust_pkg.custnum = cust_main.custnum
-            AND ". FS::cust_pkg->active_sql. "
+  0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
       )
 "; }
 
+=item inactive_sql
+
+Returns an SQL expression identifying inactive cust_main records (customers with
+active recurring packages).
+
+=cut
+
+sub inactive_sql { "
+  0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
+  AND
+  0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
+"; }
+
 =item susp_sql
 =item suspended_sql
 
@@ -3673,23 +3770,12 @@ Returns an SQL expression identifying suspended cust_main records.
 
 =cut
 
-#my $recurring_sql = FS::cust_pkg->recurring_sql;
-my $recurring_sql = "
-  '0' != ( select freq from part_pkg
-             where cust_pkg.pkgpart = part_pkg.pkgpart )
-";
 
 sub suspended_sql { susp_sql(@_); }
 sub susp_sql { "
-    0 < ( SELECT COUNT(*) FROM cust_pkg
-            WHERE cust_pkg.custnum = cust_main.custnum
-              AND $recurring_sql
-              AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
-        )
-    AND 0 = ( SELECT COUNT(*) FROM cust_pkg
-                WHERE cust_pkg.custnum = cust_main.custnum
-                  AND ". FS::cust_pkg->active_sql. "
-            )
+    0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
+    AND
+    0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
 "; }
 
 =item cancel_sql
@@ -3700,15 +3786,38 @@ Returns an SQL expression identifying cancelled cust_main records.
 =cut
 
 sub cancelled_sql { cancel_sql(@_); }
-sub cancel_sql { "
-  0 < ( SELECT COUNT(*) FROM cust_pkg
-          WHERE cust_pkg.custnum = cust_main.custnum
-      )
-  AND 0 = ( SELECT COUNT(*) FROM cust_pkg
-              WHERE cust_pkg.custnum = cust_main.custnum
-                AND $recurring_sql
-                AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
-          )
+sub cancel_sql {
+
+  my $recurring_sql = FS::cust_pkg->recurring_sql;
+  #my $recurring_sql = "
+  #  '0' != ( select freq from part_pkg
+  #             where cust_pkg.pkgpart = part_pkg.pkgpart )
+  #";
+
+  "
+    0 < ( $select_count_pkgs )
+    AND 0 = ( $select_count_pkgs AND $recurring_sql
+                  AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
+            )
+  ";
+}
+
+=item uncancel_sql
+=item uncancelled_sql
+
+Returns an SQL expression identifying un-cancelled cust_main records.
+
+=cut
+
+sub uncancelled_sql { uncancel_sql(@_); }
+sub uncancel_sql { "
+  ( 0 < ( $select_count_pkgs
+                   AND ( cust_pkg.cancel IS NULL
+                         OR cust_pkg.cancel = 0
+                       )
+        )
+    OR 0 = ( $select_count_pkgs )
+  )
 "; }
 
 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
@@ -3769,15 +3878,27 @@ Returns a (possibly empty) array of FS::cust_main objects.
 sub smart_search {
   my %options = @_;
   my $search = delete $options{'search'};
-  my @cust_main = ();
 
+  #here is the agent virtualization
+  my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
+
+  my @cust_main = ();
   if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
 
-    push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
+    push @cust_main, qsearch( {
+      'table'     => 'cust_main',
+      'hashref'   => { 'custnum' => $1, %options },
+      'extra_sql' => " AND $agentnums_sql", #agent virtualization
+    } );
 
   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
 
     my $value = lc($1);
+
+    # remove "(Last, First)" in "Company (Last, First"), otherwise the
+    # full strings the browser remembers won't work
+    $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
+    
     my $q_value = dbh->quote($value);
 
     #exact
@@ -3787,54 +3908,73 @@ sub smart_search {
       if defined dbdef->table('cust_main')->column('ship_last');
     $sql .= ' )';
 
-    push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
+    push @cust_main, qsearch( {
+      'table'     => 'cust_main',
+      'hashref'   => \%options,
+      'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
+    } );
 
     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
 
       #still some false laziness w/ search/cust_main.cgi
 
       #substring
-      push @cust_main, qsearch( 'cust_main',
-                                { 'last'     => { 'op'    => 'ILIKE',
-                                                  'value' => "%$q_value%" },
-                                  %options,
-                                }
-                              );
-      push @cust_main, qsearch( 'cust_main',
-                                { 'ship_last' => { 'op'    => 'ILIKE',
-                                                   'value' => "%$q_value%" },
-                                  %options,
-
-                                }
-                              )
+      push @cust_main, qsearch( {
+        'table'     => 'cust_main',
+        'hashref'   => { 'last'     => { 'op'    => 'ILIKE',
+                                         'value' => "%$value%" },
+                         %options,
+                       },
+        'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
+      } );
+      push @cust_main, qsearch( {
+        'table'     => 'cust_main',
+        'hashref'   => { 'ship_last' => { 'op'     => 'ILIKE',
+                                          'value' => "%$value%" },
+                         %options, 
+                       },
+        'extra_sql' => " AND $agentnums_sql", #agent virtualization
+      } )
         if defined dbdef->table('cust_main')->column('ship_last');
 
-      push @cust_main, qsearch( 'cust_main',
-                                { 'company'  => { 'op'    => 'ILIKE',
-                                                  'value' => "%$q_value%" },
-                                  %options,
-                                }
-                              );
-      push @cust_main, qsearch( 'cust_main',
-                                { 'ship_company' => { 'op' => 'ILIKE',
-                                                   'value' => "%$q_value%" },
-                                  %options,
-                                }
-                              )
+      push @cust_main, qsearch( {
+        'table'     => 'cust_main',
+        'hashref'   => { 'company'  => { 'op'    => 'ILIKE',
+                                         'value' => "%$value%" },
+                         %options,
+                       },
+        'extra_sql' => " AND $agentnums_sql", #agent virtualization
+      } );
+      push @cust_main, qsearch(  {
+        'table'     => 'cust_main',
+        'hashref'   => { 'ship_company' => { 'op'    => 'ILIKE',
+                                             'value' => "%$value%" },
+                         %options,
+                       },
+        'extra_sql' => " AND $agentnums_sql", #agent virtualization
+      } )
         if defined dbdef->table('cust_main')->column('ship_last');
 
       #fuzzy
       push @cust_main, FS::cust_main->fuzzy_search(
-        { 'last'     => $value },
-        \%options,
+        { 'last'     => $value }, #fuzzy hashref
+        \%options,                #hashref
+        '',                       #select
+        " AND $agentnums_sql",    #extra_sql  #agent virtualization
       );
       push @cust_main, FS::cust_main->fuzzy_search(
-        { 'company'  => $value },
-        \%options,
+        { 'company'  => $value }, #fuzzy hashref
+        \%options,                #hashref
+        '',                       #select
+        " AND $agentnums_sql",    #extra_sql  #agent virtualization
       );
 
     }
 
+    #eliminate duplicates
+    my %saw = ();
+    @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
+
   }
 
   @cust_main;
@@ -3860,6 +4000,7 @@ sub rebuild_fuzzyfiles {
   use Fcntl qw(:flock);
 
   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+  mkdir $dir, 0700 unless -d $dir;
 
   #last