delete customers

diff --git a/htdocs/docs/config.html b/htdocs/docs/config.html
index fba745a..7994af8 100644 (file)
--- a/htdocs/docs/config.html
+++ b/htdocs/docs/config.html
@@ -25,6 +25,7 @@ All further configuration files and directories are located in
   <li>bsdshellmachines - Your BSD flavored shell (and mail) machines, one per line.  This enables export of `/etc/passwd' and `/etc/master.passwd'.
   <li>cybercash2 - <a href="http://www.cybercash.com/cybercash/services/cashreg214.html">CyberCash v2</a> support, four lines: paymentserverhost, paymentserverport, paymentserversecret, and transaction type (`mauthonly' or `mauthcapture').  CCLib.pm is required.
   <li>cybercash3.2 - <a href="http://www.cybercash.com/cybercash/services/technology.html">CyberCash v3.2</a> support.  Two lines: the full path and name of your merchant_conf file, and the transaction type (`mauthonly' or `mauthcapture').  CCMckLib3_2.pm, CCMckDirectLib3_2.pm and CCMckErrno3_2 are required.
   <li>bsdshellmachines - Your BSD flavored shell (and mail) machines, one per line.  This enables export of `/etc/passwd' and `/etc/master.passwd'.
   <li>cybercash2 - <a href="http://www.cybercash.com/cybercash/services/cashreg214.html">CyberCash v2</a> support, four lines: paymentserverhost, paymentserverport, paymentserversecret, and transaction type (`mauthonly' or `mauthcapture').  CCLib.pm is required.
   <li>cybercash3.2 - <a href="http://www.cybercash.com/cybercash/services/technology.html">CyberCash v3.2</a> support.  Two lines: the full path and name of your merchant_conf file, and the transaction type (`mauthonly' or `mauthcapture').  CCMckLib3_2.pm, CCMckDirectLib3_2.pm and CCMckErrno3_2 are required.

+  <li>deletecustomers - The existance of this file will enable customer deletions.

   <li>domain - Your domain name.
   <li>editreferrals - The existance of this file will allow you to change the referral of existing customers.
   <li>erpcdmachines - Your ERPCD authenticaion machines, one per line.  This enables export of `/usr/annex/acp_passwd' and `/usr/annex/acp_dialup'.
   <li>domain - Your domain name.
   <li>editreferrals - The existance of this file will allow you to change the referral of existing customers.
   <li>erpcdmachines - Your ERPCD authenticaion machines, one per line.  This enables export of `/usr/annex/acp_passwd' and `/usr/annex/acp_dialup'.

diff --git a/htdocs/misc/delete-customer.cgi b/htdocs/misc/delete-customer.cgi
new file mode 100755 (executable)
index 0000000..8addbd6
--- /dev/null
+++ b/htdocs/misc/delete-customer.cgi
@@ -0,0 +1,58 @@
+#!/usr/bin/perl -Tw
+#
+# $Id: delete-customer.cgi,v 1.1 1999-04-15 16:44:36 ivan Exp $
+#
+# $Log: delete-customer.cgi,v $
+# Revision 1.1  1999-04-15 16:44:36  ivan
+# delete customers
+#
+
+use strict;
+use vars qw( $cgi $conf $query $custnum $new_custnum $cust_main );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(header popurl);
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_main;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+die "Customer deletions not enabled" unless $conf->exists('deletecustomers');
+
+if ( $cgi->param('error') ) {
+  $custnum = $cgi->param('custnum');
+  $new_custnum = $cgi->param('new_custnum');
+} else {
+  ($query) = $cgi->keywords;
+  $query =~ /^(\d+)$/ or die "Illegal query: $query";
+  $custnum = $1;
+  $new_custnum = '';
+}
+$cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } )
+  or die "Customer not found: $custnum";
+
+print $cgi->header ( '-expires' => 'now' ), header('Delete customer');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+      "</FONT>"
+  if $cgi->param('error');
+
+print 
+  qq!<form action="!, popurl(1), qq!process/delete-customer.cgi" method=post>!,
+  qq!<input type="hidden" name="custnum" value="$custnum">!;
+
+if ( qsearch('cust_pkg', { 'custnum' => $custnum, 'cancel' => '' } ) ) {
+  print "Move uncancelled packages to customer number ",
+        qq!<input type="text" name="new_custnum" value="$new_custnum"><br><br>!;
+}
+
+print <<END;
+This will <b>completely remove</b> all traces of this customer record.
+<br>Are you <b>absolutely sure</b> you want to delete this customer?
+<br><input type="submit" value="Yes">
+</form></body></html>
+END
+

diff --git a/htdocs/misc/process/delete-customer.cgi b/htdocs/misc/process/delete-customer.cgi
new file mode 100755 (executable)
index 0000000..0a939c5
--- /dev/null
+++ b/htdocs/misc/process/delete-customer.cgi
@@ -0,0 +1,46 @@
+#!/usr/bin/perl -Tw
+#
+# $Id: delete-customer.cgi,v 1.1 1999-04-15 16:44:36 ivan Exp $
+#
+# $Log: delete-customer.cgi,v $
+# Revision 1.1  1999-04-15 16:44:36  ivan
+# delete customers
+#
+
+use strict;
+use vars qw ( $cgi $conf $custnum $new_custnum $cust_main $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearchs);
+use FS::CGI qw(popurl);
+use FS::cust_main;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+die "Customer deletions not enabled" unless $conf->exists('deletecustomers');
+
+$cgi->param('custnum') =~ /^(\d+)$/;
+$custnum = $1;
+if ( $cgi->param('new_custnum') ) {
+  $cgi->param('new_custnum') =~ /^(\d+)$/
+    or die "Illegal new customer number: ". $cgi->param('new_custnum');
+  $new_custnum = $1;
+} else {
+  $new_custnum = '';
+}
+$cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } )
+  or die "Customer not found: $custnum";
+
+$error = $cust_main->delete($new_custnum);
+
+if ( $error ) {
+  $cgi->param('error', $error);
+  print $cgi->redirect(popurl(2). "delete-customer.cgi?". $cgi->query_string );
+} elsif ( $new_custnum ) {
+  print $cgi->redirect(popurl(3). "view/cust_main.cgi?$new_custnum");
+} else {
+  print $cgi->redirect(popurl(3));
+}

diff --git a/htdocs/view/cust_main.cgi b/htdocs/view/cust_main.cgi
index 6f6c335..de9ff7f 100755 (executable)
--- a/htdocs/view/cust_main.cgi
+++ b/htdocs/view/cust_main.cgi
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -Tw
 #
 #!/usr/bin/perl -Tw
 #

-# $Id: cust_main.cgi,v 1.16 1999-04-09 04:22:34 ivan Exp $
+# $Id: cust_main.cgi,v 1.17 1999-04-15 16:44:36 ivan Exp $

 #
 # Usage: cust_main.cgi custnum
 #        http://server.name/path/cust_main.cgi?custnum
 #
 # Usage: cust_main.cgi custnum
 #        http://server.name/path/cust_main.cgi?custnum


@@ -31,7 +31,10 @@
 # lose background, FS::CGI ivan@sisd.com 98-sep-2
 #
 # $Log: cust_main.cgi,v $
 # lose background, FS::CGI ivan@sisd.com 98-sep-2
 #
 # $Log: cust_main.cgi,v $

-# Revision 1.16  1999-04-09 04:22:34  ivan
+# Revision 1.17  1999-04-15 16:44:36  ivan
+# delete customers
+#
+# Revision 1.16  1999/04/09 04:22:34  ivan

 # also table()
 #
 # Revision 1.15  1999/04/09 03:52:55  ivan
 # also table()
 #
 # Revision 1.15  1999/04/09 03:52:55  ivan


@@ -82,7 +85,7 @@
 use strict;
 use vars qw ( $cgi $query $custnum $cust_main $hashref $agent $referral 
               @packages $package @history @bills $bill @credits $credit
 use strict;
 use vars qw ( $cgi $query $custnum $cust_main $hashref $agent $referral 
               @packages $package @history @bills $bill @credits $credit

-              $balance $item @agents @referrals @invoicing_list $n1 ); 
+              $balance $item @agents @referrals @invoicing_list $n1 $conf ); 

 use CGI;
 use CGI::Carp qw(fatalsToBrowser);
 use Date::Format;
 use CGI;
 use CGI::Carp qw(fatalsToBrowser);
 use Date::Format;


@@ -102,6 +105,8 @@ use FS::cust_refund;
 $cgi = new CGI;
 &cgisuidsetup($cgi);
 
 $cgi = new CGI;
 &cgisuidsetup($cgi);
 

+$conf = new FS::Conf;
+

 print $cgi->header( '-expires' => 'now' ), header("Customer View", menubar(
   'Main Menu' => popurl(2)
 ));
 print $cgi->header( '-expires' => 'now' ), header("Customer View", menubar(
   'Main Menu' => popurl(2)
 ));


@@ -117,8 +122,11 @@ $hashref = $cust_main->hashref;
 print &itable(), '<TR><TD><A NAME="cust_main"></A>';
 
 print qq!<A HREF="!, popurl(2), 
 print &itable(), '<TR><TD><A NAME="cust_main"></A>';
 
 print qq!<A HREF="!, popurl(2), 

-      qq!edit/cust_main.cgi?$custnum">Edit this customer</A>!,
-      &ntable("#c0c0c0"), "<TR><TD>", &ntable("#c0c0c0",2),
+      qq!edit/cust_main.cgi?$custnum">Edit this customer</A>!;
+print qq! | <A HREF="!, popurl(2), 
+      qq!misc/delete-customer.cgi?$custnum"> Delete this customer</A>!
+  if $conf->exists('deletecustomers');
+print &ntable("#c0c0c0"), "<TR><TD>", &ntable("#c0c0c0",2),

       '<TR><TD ALIGN="right">Customer number</TD><TD BGCOLOR="#ffffff">',
       $custnum, '</TD></TR>',
 ;
       '<TR><TD ALIGN="right">Customer number</TD><TD BGCOLOR="#ffffff">',
       $custnum, '</TD></TR>',
 ;

diff --git a/site_perl/cust_main.pm b/site_perl/cust_main.pm
index 7bdbc08..b5cb271 100644 (file)
--- a/site_perl/cust_main.pm
+++ b/site_perl/cust_main.pm
@@ -177,18 +177,61 @@ sub table { 'cust_main'; }
 Adds this customer to the database.  If there is an error, returns the error,
 otherwise returns false.
 
 Adds this customer to the database.  If there is an error, returns the error,
 otherwise returns false.
 

-=item delete
+=item delete NEW_CUSTNUM

 
 

-Currently unimplemented.  Maybe cancel all of this customer's
-packages (cust_pkg)?
+This deletes the customer.  If there is an error, returns the error, otherwise
+returns false.

 
 

-I don't remove the customer record in the database because there would then
-be no record the customer ever existed (which is bad, no?)
+This will completely remove all traces of the customer record.  This is not
+what you want when a customer cancels service; for that, cancel all of the
+customer's packages (see L<FS::cust_pkg/cancel>).
+
+If the customer has any packages, you need to pass a new (valid) customer
+number for those packages to be transferred to.
+
+You can't delete a customer with invoices (see L<FS::cust_bill>),
+or credits (see L<FS::cust_credit>).

 
 =cut
 
 sub delete {
 
 =cut
 
 sub delete {

-   return "Can't (yet?) delete customers.";
+  my $self = shift;
+
+  if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
+    return "Can't delete a customer with invoices";
+  }
+  if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
+    return "Can't delete a customer with credits";
+  }
+
+  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 @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
+  if ( @cust_pkg ) {
+    my $new_custnum = shift;
+    return "Invalid new customer number: $new_custnum"
+      unless qsearchs( 'cust_main', { 'custnum' => $new_custnum } );
+    foreach my $cust_pkg ( @cust_pkg ) {
+      my %hash = $cust_pkg->hash;
+      $hash{'custnum'} = $new_custnum;
+      my $new_cust_pkg = new FS::cust_pkg ( \%hash );
+      my $error = $new_cust_pkg->replace($cust_pkg);
+      return $error if $error;
+    }
+  }
+  foreach my $cust_main_invoice (
+    qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
+  ) {
+    my $error = $cust_main_invoice->delete;
+    return $error if $error;
+  }
+
+  $self->SUPER::delete;

 }
 
 =item replace OLD_RECORD
 }
 
 =item replace OLD_RECORD


@@ -885,12 +928,15 @@ sub check_invoicing_list {
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-$Id: cust_main.pm,v 1.21 1999-04-14 07:47:53 ivan Exp $
+$Id: cust_main.pm,v 1.22 1999-04-15 16:44:36 ivan Exp $

 
 =head1 BUGS
 
 The delete method.
 
 
 =head1 BUGS
 
 The delete method.
 

+The delete method should possibly take an FS::cust_main object reference
+instead of a scalar customer number.
+

 Bill and collect options should probably be passed as references instead of a
 list.
 
 Bill and collect options should probably be passed as references instead of a
 list.
 


@@ -941,7 +987,10 @@ enable cybercash, cybercash v3 support, don't need to import
 FS::UID::{datasrc,checkruid} ivan@sisd.com 98-sep-19-21
 
 $Log: cust_main.pm,v $
 FS::UID::{datasrc,checkruid} ivan@sisd.com 98-sep-19-21
 
 $Log: cust_main.pm,v $

-Revision 1.21  1999-04-14 07:47:53  ivan
+Revision 1.22  1999-04-15 16:44:36  ivan
+delete customers
+
+Revision 1.21  1999/04/14 07:47:53  ivan

 i18n fixes
 
 Revision 1.20  1999/04/10 08:35:14  ivan
 i18n fixes
 
 Revision 1.20  1999/04/10 08:35:14  ivan