X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=168403482ecbc74aa428d75f69139ec7dff08d21;hb=397c392e39c4006361144db5e262779df80ac0c2;hp=002b0c1d182bc69ba0ef44823e53360328dc179d;hpb=e574b96088606fe1624223d977e8091b9eab0600;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 002b0c1d1..168403482 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1301,7 +1301,7 @@ sub reexport { } -=item delete NEW_CUSTNUM +=item delete [ OPTION => VALUE ... ] This deletes the customer. If there is an error, returns the error, otherwise returns false. @@ -1311,18 +1311,20 @@ what you want when a customer cancels service; for that, cancel all of the customer's packages (see L). If the customer has any uncancelled packages, you need to pass a new (valid) -customer number for those packages to be transferred to. Cancelled packages -will be deleted. Did I mention that this is NOT what you want when a customer -cancels service and that you really should be looking see L? +customer number for those packages to be transferred to, as the "new_customer" +option. Cancelled packages will be deleted. Did I mention that this is NOT +what you want when a customer cancels service and that you really should be +looking at L? You can't delete a customer with invoices (see L), -or credits (see L), payments (see L) or -refunds (see L). +statements (see L), credits (see L), +payments (see L) or refunds (see L), unless you +set the "delete_financials" option to a true value. =cut sub delete { - my $self = shift; + my( $self, %opt ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -1335,26 +1337,47 @@ sub delete { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - if ( $self->cust_bill ) { - $dbh->rollback if $oldAutoCommit; - return "Can't delete a customer with invoices"; + if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't delete a master agent customer"; } - if ( $self->cust_credit ) { - $dbh->rollback if $oldAutoCommit; - return "Can't delete a customer with credits"; - } - if ( $self->cust_pay ) { - $dbh->rollback if $oldAutoCommit; - return "Can't delete a customer with payments"; + + #use FS::access_user + if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't delete a master employee customer"; } - if ( $self->cust_refund ) { - $dbh->rollback if $oldAutoCommit; - return "Can't delete a customer with refunds"; + + tie my %financial_tables, 'Tie::IxHash', + 'cust_bill' => 'invoices', + 'cust_statement' => 'statements', + 'cust_credit' => 'credits', + 'cust_pay' => 'payments', + 'cust_refund' => 'refunds', + ; + + foreach my $table ( keys %financial_tables ) { + + my @records = $self->$table(); + + if ( @records && ! $opt{'delete_financials'} ) { + $dbh->rollback if $oldAutoCommit; + return "Can't delete a customer with ". $financial_tables{$table}; + } + + foreach my $record ( @records ) { + my $error = $record->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error deleting ". $financial_tables{$table}. ": $error\n"; + } + } + } my @cust_pkg = $self->ncancelled_pkgs; if ( @cust_pkg ) { - my $new_custnum = shift; + my $new_custnum = $opt{'new_custnum'}; unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) { $dbh->rollback if $oldAutoCommit; return "Invalid new customer number: $new_custnum"; @@ -1381,8 +1404,15 @@ sub delete { } } - foreach my $table (qw( cust_main_invoice cust_main_exemption cust_tag )) { - foreach my $record ( qsearch( 'table', { 'custnum' => $self->custnum } ) ) { + #cust_tax_adjustment in financials? + #cust_pay_pending? ouch + #cust_recon? + foreach my $table (qw( + cust_main_invoice cust_main_exemption cust_tag cust_attachment contact + cust_location cust_main_note cust_tax_adjustment + cust_pay_void cust_pay_batch queue cust_tax_exempt + )) { + foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) { my $error = $record->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -1391,6 +1421,54 @@ sub delete { } } + my $sth = $dbh->prepare( + 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?' + ) or do { + my $errstr = $dbh->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + $sth->execute($self->custnum) or do { + my $errstr = $sth->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + + #tickets + + my $ticket_dbh = ''; + if ($conf->config('ticket_system') eq 'RT_Internal') { + $ticket_dbh = $dbh; + } elsif ($conf->config('ticket_system') eq 'RT_External') { + my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc'); + $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }); + #or die "RT_External DBI->connect error: $DBI::errstr\n"; + } + + if ( $ticket_dbh ) { + + my $ticket_sth = $ticket_dbh->prepare( + 'DELETE FROM Links WHERE Target = ?' + ) or do { + my $errstr = $ticket_dbh->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum) + or do { + my $errstr = $ticket_sth->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + + #check and see if the customer is the only link on the ticket, and + #if so, set the ticket to deleted status in RT? + #maybe someday, for now this will at least fix tickets not displaying + + } + + #delete the customer record + my $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -2901,7 +2979,13 @@ sub bill { my $real_pkgpart = $cust_pkg->pkgpart; my %hash = $cust_pkg->hash; - foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) { + # we could implement this bit as FS::part_pkg::has_hidden, but we already + # suffer from performance issues + $options{has_hidden} = 0; + my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked; + $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden); + + foreach my $part_pkg ( @part_pkg ) { $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill ); @@ -2955,7 +3039,13 @@ sub bill { } elsif ( $postal_pkg ) { my $real_pkgpart = $postal_pkg->pkgpart; - foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) { + # we could implement this bit as FS::part_pkg::has_hidden, but we already + # suffer from performance issues + $options{has_hidden} = 0; + my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked; + $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden); + + foreach my $part_pkg ( @part_pkg ) { my %postal_options = %options; delete $postal_options{cancel}; my $error = @@ -3050,12 +3140,24 @@ sub bill { return "can't create invoice for customer #". $self->custnum. ": $error"; } + my @cust_bill_pkg_bundle = (); foreach my $cust_bill_pkg ( @cust_bill_pkg ) { $cust_bill_pkg->invnum($cust_bill->invnum); - my $error = $cust_bill_pkg->insert; + if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) { + $error = $self->_insert_cust_bill_pkg_bundle( @cust_bill_pkg_bundle ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + @cust_bill_pkg_bundle = (); + } + push @cust_bill_pkg_bundle, $cust_bill_pkg; + } + if (scalar(@cust_bill_pkg_bundle)) { + $error = $self->_insert_cust_bill_pkg_bundle( @cust_bill_pkg_bundle ); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "can't create invoice line item: $error"; + return $error; } } @@ -3075,6 +3177,22 @@ sub bill { ''; #no error } +#insert line items while discarding bundled packages of 0 value +sub _insert_cust_bill_pkg_bundle { + my $self = shift; + my @cust_bill_pkg = @_; + + my $sum = 0; + $sum += $_->setup + $_->recur foreach @cust_bill_pkg; + return '' unless $sum > 0; + + foreach my $cust_bill_pkg ( @cust_bill_pkg ) { + my $error = $cust_bill_pkg->insert; + return "can't create invoice line item: $error" if $error; + } + +} + =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME This is a weird one. Perhaps it should not even be exposed. @@ -3393,7 +3511,7 @@ sub _make_lines { # If $cust_pkg has been modified, update it (if we're a real pkgpart) ### - if ( $lineitems ) { + if ( $lineitems || $options{has_hidden} ) { if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) { # hmm.. and if just the options are modified in some weird price plan? @@ -3417,7 +3535,10 @@ sub _make_lines { return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; } - if ( $setup != 0 || $recur != 0 ) { + if ( $setup != 0 || + $recur != 0 || + !$part_pkg->hidden && $options{has_hidden} ) #include some $0 lines + { warn " charges (setup=$setup, recur=$recur); adding line items\n" if $DEBUG > 1; @@ -3584,16 +3705,15 @@ sub _handle_taxes { my @display = (); my $separate = $conf->exists('separate_usage'); - my $usage_mandate = $cust_pkg->part_pkg->option('usage_mandate', 'Hush!'); - if ( $separate || $cust_bill_pkg->hidden || $usage_mandate ) { + my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart }; + my $usage_mandate = $temp_pkg->part_pkg->option('usage_mandate', 'Hush!'); + my $section = $temp_pkg->part_pkg->categoryname; + if ( $separate || $section || $usage_mandate ) { - my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart }; - my %hash = $cust_bill_pkg->hidden # maybe for all bill linked? - ? ( 'section' => $temp_pkg->part_pkg->categoryname ) - : (); + my %hash = ( 'section' => $section ); - my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!'); - my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!'); + $section = $temp_pkg->part_pkg->option('usage_section', 'Hush!'); + my $summary = $temp_pkg->part_pkg->option('summarize_usage', 'Hush!'); if ( $separate ) { push @display, new FS::cust_bill_pkg_display { type => 'S', %hash }; push @display, new FS::cust_bill_pkg_display { type => 'R', %hash }; @@ -3615,8 +3735,10 @@ sub _handle_taxes { $hash{post_total} = 'Y'; } - $hash{section} = $section if ($separate || $usage_mandate); - push @display, new FS::cust_bill_pkg_display { type => 'U', %hash }; + if ($separate || $usage_mandate) { + $hash{section} = $section if ($separate || $usage_mandate); + push @display, new FS::cust_bill_pkg_display { type => 'U', %hash }; + } } $cust_bill_pkg->set('display', \@display); @@ -5116,8 +5238,11 @@ sub _realtime_bop_result { my $msgnum = $conf->config('decline_msgnum', $self->agentnum); my $error = ''; if ( $msgnum ) { + # include the raw error message in the transaction state + $cust_pay_pending->setfield('error', $transaction->error_message); my $msg_template = qsearchs('msg_template', { msgnum => $msgnum }); - $error = $msg_template->send( 'cust_main' => $self ); + $error = $msg_template->send( 'cust_main' => $self, + 'object' => $cust_pay_pending ); } else { #!$msgnum @@ -6272,7 +6397,7 @@ sub balance_date_range { my $self = shift; my $sql = 'SELECT SUM('. $self->balance_date_sql(@_). ') FROM cust_main WHERE custnum='. $self->custnum; - sprintf( "%.2f", $self->scalar_sql($sql) ); + sprintf( '%.2f', $self->scalar_sql($sql) ); } =item balance_pkgnum PKGNUM @@ -7097,6 +7222,26 @@ sub cust_pay_pending { ); } +=item cust_pay_pending_attempt + +Returns all payment attempts / declined payments for this customer, as pending +payments objects (see L), with status "done" but without +a corresponding payment (see L). + +=cut + +sub cust_pay_pending_attempt { + my $self = shift; + return $self->num_cust_pay_pending_attempt unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay_pending', { + 'custnum' => $self->custnum, + 'status' => 'done', + 'paynum' => '', + }, + ); +} + =item num_cust_pay_pending Returns the number of pending payments (see L) for this @@ -7107,11 +7252,28 @@ cust_pay_pending method is used in a scalar context. sub num_cust_pay_pending { my $self = shift; - my $sql = " SELECT COUNT(*) FROM cust_pay_pending ". - " WHERE custnum = ? AND status != 'done' "; - my $sth = dbh->prepare($sql) or die dbh->errstr; - $sth->execute($self->custnum) or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; + $self->scalar_sql( + " SELECT COUNT(*) FROM cust_pay_pending ". + " WHERE custnum = ? AND status != 'done' ", + $self->custnum + ); +} + +=item num_cust_pay_pending_attempt + +Returns the number of pending payments (see L) for this +customer, with status "done" but without a corresp. Also called automatically when the +cust_pay_pending method is used in a scalar context. + +=cut + +sub num_cust_pay_pending_attempt { + my $self = shift; + $self->scalar_sql( + " SELECT COUNT(*) FROM cust_pay_pending ". + " WHERE custnum = ? AND status = 'done' AND paynum IS NULL", + $self->custnum + ); } =item cust_refund @@ -7488,7 +7650,8 @@ recurring packages not yet setup). =cut sub ordered_sql { - " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) "; + FS::cust_main->none_active_sql. + " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) "; } =item active_sql @@ -7502,6 +7665,18 @@ sub active_sql { " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; } +=item none_active_sql + +Returns an SQL expression identifying cust_main records with no active +recurring packages. This includes customers of status prospect, ordered, +inactive, and suspended. + +=cut + +sub none_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 @@ -7509,11 +7684,10 @@ no active recurring packages, but otherwise unsuspended/uncancelled). =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. " ) -"; } +sub inactive_sql { + FS::cust_main->none_active_sql. + " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) "; +} =item susp_sql =item suspended_sql @@ -7524,11 +7698,10 @@ Returns an SQL expression identifying suspended cust_main records. sub suspended_sql { susp_sql(@_); } -sub susp_sql { " - 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) - AND - 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) -"; } +sub susp_sql { + FS::cust_main->none_active_sql. + " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) "; +} =item cancel_sql =item cancelled_sql @@ -8886,6 +9059,7 @@ I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or =cut +# a lot like cust_bill::print_latex sub generate_letter { my ($self, $template, %options) = @_; @@ -8936,8 +9110,13 @@ sub generate_letter { $letter_data{returnaddress} = $retadd; } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) { $letter_data{returnaddress} = - join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg, - $conf->config('company_address', $self->agentnum) + join( "\n", map { s/( {2,})/'~' x length($1)/eg; + s/$/\\\\\*/; + $_; + } + ( $conf->config('company_name', $self->agentnum), + $conf->config('company_address', $self->agentnum), + ) ); } else { $letter_data{returnaddress} = '~'; @@ -8949,6 +9128,17 @@ sub generate_letter { $letter_data{company_name} = $conf->config('company_name', $self->agentnum); my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc; + + my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX', + DIR => $dir, + SUFFIX => '.eps', + UNLINK => 0, + ) or die "can't open temp file: $!\n"; + print $lh $conf->config_binary('logo.eps', $self->agentnum) + or die "can't write temp file: $!\n"; + close $lh; + $letter_data{'logo_file'} = $lh->filename; + my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX', DIR => $dir, SUFFIX => '.tex', @@ -8958,7 +9148,8 @@ sub generate_letter { $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data ); close $fh; $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename; - return $1; + return ($1, $letter_data{'logo_file'}); + } =item print_ps TEMPLATE @@ -8969,8 +9160,12 @@ Returns an postscript letter filled in from TEMPLATE, as a scalar. sub print_ps { my $self = shift; - my $file = $self->generate_letter(@_); - FS::Misc::generate_ps($file); + my($file, $lfile) = $self->generate_letter(@_); + my $ps = FS::Misc::generate_ps($file); + unlink($file.'.tex'); + unlink($lfile); + + $ps; } =item print TEMPLATE