X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=f49eb69341170c33abf6c711d34f5947fa1e2c3f;hp=d585b0dfa0332c88cdffe8c57ad1d603a9c57d43;hb=b429a422185206c645c84ec1c3540494d336b943;hpb=98b9624b75d092f9451132182bf17fdf24ce405e diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index d585b0dfa..f49eb6934 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,41 +2,45 @@ package FS::cust_main; require 5.006; use strict; -use base qw( FS::otaker_Mixin FS::payinfo_Mixin FS::Record ); -use vars qw( @EXPORT_OK $DEBUG $me $conf + #FS::cust_main:_Marketgear when they're ready to move to 2.1 +use base qw( FS::cust_main::Packages FS::cust_main::Status + FS::cust_main::Billing FS::cust_main::Billing_Realtime + FS::cust_main::Billing_Discount + FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin + FS::geocode_Mixin + FS::Record + ); +use vars qw( $DEBUG $me $conf @encrypted_fields - $import $ignore_expired_card - $skip_fuzzyfiles @fuzzyfields + $import + $ignore_expired_card $ignore_illegal_zip $ignore_banned_card + $skip_fuzzyfiles @paytypes ); -use vars qw( $realtime_bop_decline_quiet ); #ugh -use Safe; use Carp; -use Exporter; use Scalar::Util qw( blessed ); -use List::Util qw( min ); use Time::Local qw(timelocal); +use Storable qw(thaw); +use MIME::Base64; use Data::Dumper; use Tie::IxHash; use Digest::MD5 qw(md5_base64); use Date::Format; #use Date::Manip; -use File::Temp qw( tempfile ); -use String::Approx qw(amatch); +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::Misc qw( generate_email send_email generate_ps do_print ); use FS::Msgcat qw(gettext); +use FS::CurrentUser; +use FS::TicketSystem; use FS::payby; use FS::cust_pkg; use FS::cust_svc; use FS::cust_bill; -use FS::cust_bill_pkg; -use FS::cust_bill_pkg_display; -use FS::cust_bill_pkg_tax_location; -use FS::cust_bill_pkg_tax_rate_location; +use FS::legacy_cust_bill; use FS::cust_pay; use FS::cust_pay_pending; use FS::cust_pay_void; @@ -49,30 +53,23 @@ use FS::cust_location; use FS::cust_class; use FS::cust_main_exemption; use FS::cust_tax_adjustment; -use FS::tax_rate; -use FS::tax_rate_location; use FS::cust_tax_location; -use FS::part_pkg_taxrate; use FS::agent; use FS::cust_main_invoice; -use FS::cust_credit_bill; -use FS::cust_bill_pay; +use FS::cust_tag; use FS::prepay_credit; use FS::queue; use FS::part_pkg; -use FS::part_event; -use FS::part_event_condition; use FS::part_export; #use FS::cust_event; use FS::type_pkgs; use FS::payment_gateway; use FS::agent_payment_gateway; use FS::banned_pay; -use FS::TicketSystem; - -@EXPORT_OK = qw( smart_search ); - -$realtime_bop_decline_quiet = 0; +use FS::cust_main_note; +use FS::cust_attachment; +use FS::contact; +use FS::Locales; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -82,9 +79,10 @@ $me = '[FS::cust_main]'; $import = 0; $ignore_expired_card = 0; +$ignore_illegal_zip = 0; +$ignore_banned_card = 0; $skip_fuzzyfiles = 0; -@fuzzyfields = ( 'first', 'last', 'company', 'address1' ); @encrypted_fields = ('payinfo', 'paycvv'); sub nohistory_fields { ('payinfo', 'paycvv'); } @@ -213,6 +211,10 @@ phone (optional) phone (optional) +=item mobile + +phone (optional) + =item ship_first Shipping first name @@ -259,6 +261,10 @@ phone (optional) phone (optional) +=item ship_mobile + +phone (optional) + =item payby Payment Type (See L for valid payby values) @@ -327,6 +333,14 @@ A suggestion to events (see L) to delay until this unix ti Discourage individual CDR printing, empty or `Y' +=item edit_subject + +Allow self-service editing of ticket subjects, empty or 'Y' + +=item calling_list_exempt + +Do not call, empty or 'Y' + =back =head1 METHODS @@ -372,7 +386,8 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); -Currently available options are: I, I and I. +Currently available options are: I, I, +I and I. If I is set, all provisioning jobs will have a dependancy on the supplied jobnum (they will not run until the specific job completes). @@ -386,6 +401,8 @@ the B method.) The I option can be set to an arrayref of tax names. FS::cust_main_exemption records will be created and inserted. +If I is set, moves contacts and locations from that prospect. + =cut sub insert { @@ -471,6 +488,55 @@ sub insert { $self->invoicing_list( $invoicing_list ); } + warn " setting customer tags\n" + if $DEBUG > 1; + + foreach my $tagnum ( @{ $self->tagnum || [] } ) { + my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum, + 'custnum' => $self->custnum }; + my $error = $cust_tag->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $prospectnum = delete $options{'prospectnum'}; + if ( $prospectnum ) { + + warn " moving contacts and locations from prospect $prospectnum\n" + if $DEBUG > 1; + + my $prospect_main = + qsearchs('prospect_main', { 'prospectnum' => $prospectnum } ); + unless ( $prospect_main ) { + $dbh->rollback if $oldAutoCommit; + return "Unknown prospectnum $prospectnum"; + } + $prospect_main->custnum($self->custnum); + $prospect_main->disabled('Y'); + my $error = $prospect_main->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my @contact = $prospect_main->contact; + my @cust_location = $prospect_main->cust_location; + my @qual = $prospect_main->qual; + + foreach my $r ( @contact, @cust_location, @qual ) { + $r->prospectnum(''); + $r->custnum($self->custnum); + my $error = $r->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + warn " setting cust_main_exemption\n" if $DEBUG > 1; @@ -489,18 +555,12 @@ sub insert { } } - if ( $conf->config('cust_main-skeleton_tables') - && $conf->config('cust_main-skeleton_custnum') ) { - - warn " inserting skeleton records\n" - if $DEBUG > 1; - + if ( $self->can('start_copy_skel') ) { my $error = $self->start_copy_skel; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - } warn " ordering packages\n" @@ -623,332 +683,10 @@ sub auto_agent_custid { } -sub start_copy_skel { - my $self = shift; - - #'mg_user_preference' => {}, - #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, }, - #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' }, - #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' }, - #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } }, - my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables'))); - die $@ if $@; - - _copy_skel( 'cust_main', #tablename - $conf->config('cust_main-skeleton_custnum'), #sourceid - $self->custnum, #destid - @tables, #child tables - ); -} - -#recursive subroutine, not a method -sub _copy_skel { - my( $table, $sourceid, $destid, %child_tables ) = @_; - - my $primary_key; - if ( $table =~ /^(\w+)\.(\w+)$/ ) { - ( $table, $primary_key ) = ( $1, $2 ); - } else { - my $dbdef_table = dbdef->table($table); - $primary_key = $dbdef_table->primary_key - or return "$table has no primary key". - " (or do you need to run dbdef-create?)"; - } - - warn " _copy_skel: $table.$primary_key $sourceid to $destid for ". - join (', ', keys %child_tables). "\n" - if $DEBUG > 2; - - foreach my $child_table_def ( keys %child_tables ) { - - my $child_table; - my $child_pkey = ''; - if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) { - ( $child_table, $child_pkey ) = ( $1, $2 ); - } else { - $child_table = $child_table_def; - - $child_pkey = dbdef->table($child_table)->primary_key; - # or return "$table has no primary key". - # " (or do you need to run dbdef-create?)\n"; - } - - my $sequence = ''; - if ( keys %{ $child_tables{$child_table_def} } ) { - - return "$child_table has no primary key". - " (run dbdef-create or try specifying it?)\n" - unless $child_pkey; - - #false laziness w/Record::insert and only works on Pg - #refactor the proper last-inserted-id stuff out of Record::insert if this - # ever gets use for anything besides a quick kludge for one customer - my $default = dbdef->table($child_table)->column($child_pkey)->default; - $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i - or return "can't parse $child_table.$child_pkey default value ". - " for sequence name: $default"; - $sequence = $1; - - } - - my @sel_columns = grep { $_ ne $primary_key } - dbdef->table($child_table)->columns; - my $sel_columns = join(', ', @sel_columns ); - - my @ins_columns = grep { $_ ne $child_pkey } @sel_columns; - my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) '; - my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) '; - - my $sel_st = "SELECT $sel_columns FROM $child_table". - " WHERE $primary_key = $sourceid"; - warn " $sel_st\n" - if $DEBUG > 2; - my $sel_sth = dbh->prepare( $sel_st ) - or return dbh->errstr; - - $sel_sth->execute or return $sel_sth->errstr; - - while ( my $row = $sel_sth->fetchrow_hashref ) { - - warn " selected row: ". - join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n" - if $DEBUG > 2; - - my $statement = - "INSERT INTO $child_table $ins_columns VALUES $placeholders"; - my $ins_sth =dbh->prepare($statement) - or return dbh->errstr; - my @param = ( $destid, map $row->{$_}, @ins_columns ); - warn " $statement: [ ". join(', ', @param). " ]\n" - if $DEBUG > 2; - $ins_sth->execute( @param ) - or return $ins_sth->errstr; - - #next unless keys %{ $child_tables{$child_table} }; - next unless $sequence; - - #another section of that laziness - my $seq_sql = "SELECT currval('$sequence')"; - my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr; - $seq_sth->execute or return $seq_sth->errstr; - my $insertid = $seq_sth->fetchrow_arrayref->[0]; - - # don't drink soap! recurse! recurse! okay! - my $error = - _copy_skel( $child_table_def, - $row->{$child_pkey}, #sourceid - $insertid, #destid - %{ $child_tables{$child_table_def} }, - ); - return $error if $error; - - } - - } - - return ''; - -} - -=item order_pkg HASHREF | OPTION => VALUE ... - -Orders a single package. - -Options may be passed as a list of key/value pairs or as a hash reference. -Options are: - -=over 4 - -=item cust_pkg - -FS::cust_pkg object - -=item cust_location - -Optional FS::cust_location object - -=item svcs - -Optional arryaref of FS::svc_* service objects. - -=item depend_jobnum - -If this option is set to a job queue jobnum (see L), all provisioning -jobs will have a dependancy on the supplied job (they will not run until the -specific job completes). This can be used to defer provisioning until some -action completes (such as running the customer's credit card successfully). - -=item ticket_subject - -Optional subject for a ticket created and attached to this customer - -=item ticket_subject - -Optional queue name for ticket additions - -=back - -=cut - -sub order_pkg { - my $self = shift; - my $opt = ref($_[0]) ? shift : { @_ }; - - warn "$me order_pkg called with options ". - join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n" - if $DEBUG; - - my $cust_pkg = $opt->{'cust_pkg'}; - my $svcs = $opt->{'svcs'} || []; - - my %svc_options = (); - $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'} - if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'}; - - my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () } - qw( ticket_subject ticket_queue ); - - 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 $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - if ( $opt->{'cust_location'} && - ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) { - my $error = $opt->{'cust_location'}->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting cust_location (transaction rolled back): $error"; - } - $cust_pkg->locationnum($opt->{'cust_location'}->locationnum); - } - - $cust_pkg->custnum( $self->custnum ); - - my $error = $cust_pkg->insert( %insert_params ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting cust_pkg (transaction rolled back): $error"; - } - - foreach my $svc_something ( @{ $opt->{'svcs'} } ) { - if ( $svc_something->svcnum ) { - my $old_cust_svc = $svc_something->cust_svc; - my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash }; - $new_cust_svc->pkgnum( $cust_pkg->pkgnum); - $error = $new_cust_svc->replace($old_cust_svc); - } else { - $svc_something->pkgnum( $cust_pkg->pkgnum ); - if ( $svc_something->isa('FS::svc_acct') ) { - foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } } - qw( seconds upbytes downbytes totalbytes ) ) { - $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } ); - ${ $opt->{$_.'_ref'} } = 0; - } - } - $error = $svc_something->insert(%svc_options); - } - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting svc_ (transaction rolled back): $error"; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error - -} - -#deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ] -=item order_pkgs HASHREF [ , OPTION => VALUE ... ] - -Like the insert method on an existing record, this method orders multiple -packages and included services atomicaly. Pass a Tie::RefHash data structure -to this method containing FS::cust_pkg and FS::svc_I objects. -There should be a better explanation of this, but until then, here's an -example: - - use Tie::RefHash; - tie %hash, 'Tie::RefHash'; #this part is important - %hash = ( - $cust_pkg => [ $svc_acct ], - ... - ); - $cust_main->order_pkgs( \%hash, 'noexport'=>1 ); - -Services can be new, in which case they are inserted, or existing unaudited -services, in which case they are linked to the newly-created package. - -Currently available options are: I, I, I, -I, I, and I. - -If I is set, all provisioning jobs will have a dependancy -on the supplied jobnum (they will not run until the specific job completes). -This can be used to defer provisioning until some action completes (such -as running the customer's credit card successfully). - -The I option is deprecated. If I is set true, no -provisioning jobs (exports) are scheduled. (You can schedule them later with -the B method for each cust_pkg object. Using the B method -on the cust_main object is not recommended, as existing services will also be -reexported.) - -If I, I, I, or I is -provided, the scalars (provided by references) will be incremented by the -values of the prepaid card.` - -=cut - -sub order_pkgs { - my $self = shift; - my $cust_pkgs = shift; - my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated - my %options = @_; - $seconds_ref ||= $options{'seconds_ref'}; - - warn "$me order_pkgs called with options ". - join(', ', map { "$_: $options{$_}" } keys %options ). "\n" - if $DEBUG; - - 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 $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; - - foreach my $cust_pkg ( keys %$cust_pkgs ) { - - my $error = $self->order_pkg( - 'cust_pkg' => $cust_pkg, - 'svcs' => $cust_pkgs->{$cust_pkg}, - 'seconds_ref' => $seconds_ref, - map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref - depend_jobnum - ) - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - } +=item PACKAGE METHODS - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} +Documentation on customer package methods has been moved to +L. =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ] @@ -1051,7 +789,7 @@ sub get_prepay { $prepay_credit = qsearchs( 'prepay_credit', - { 'identifier' => $prepay_credit }, + { 'identifier' => $identifier }, '', 'FOR UPDATE' ); @@ -1274,7 +1012,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. @@ -1284,18 +1022,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'; @@ -1308,26 +1048,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 ( $self->cust_credit ) { - $dbh->rollback if $oldAutoCommit; - return "Can't delete a customer with credits"; + if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't delete a master agent customer"; } - 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"; @@ -1354,26 +1115,71 @@ sub delete { } } - foreach my $cust_main_invoice ( #(email invoice destinations, not invoices) - qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ) - ) { - my $error = $cust_main_invoice->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + #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; + return $error; + } } } - foreach my $cust_main_exemption ( - qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } ) - ) { - my $error = $cust_main_exemption->delete; - if ( $error ) { + 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 $error; - } + 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; @@ -1402,20 +1208,241 @@ sub delete { } -=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] +=item merge NEW_CUSTNUM [ , OPTION => VALUE ... ] +This merges this customer into the provided new custnum, and then deletes the +customer. If there is an error, returns the error, otherwise returns false. -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. +The source customer's name, company name, phone numbers, agent, +referring customer, customer class, advertising source, order taker, and +billing information (except balance) are discarded. -INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will -be set as the invoicing list (see L<"invoicing_list">). Errors return as -expected and rollback the entire transaction; it is not necessary to call -check_invoicing_list first. Here's an example: +All packages are moved to the target customer. Packages with package locations +are preserved. Packages without package locations are moved to a new package +location with the source customer's service/shipping address. - $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] ); +All invoices, statements, payments, credits and refunds are moved to the target +customer. The source customer's balance is added to the target customer. -Currently available options are: I. +All notes, attachments, tickets and customer tags are moved to the target +customer. + +Change history is not currently moved. + +=cut + +sub merge { + my( $self, $new_custnum, %opt ) = @_; + + return "Can't merge a customer into self" if $self->custnum == $new_custnum; + + unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) { + return "Invalid new customer number: $new_custnum"; + } + + 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 $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't merge a master agent customer"; + } + + #use FS::access_user + if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't merge a master employee customer"; + } + + if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum, + 'status' => { op=>'!=', value=>'done' }, + } + ) + ) { + $dbh->rollback if $oldAutoCommit; + return "Can't merge a customer with pending payments"; + } + + tie my %financial_tables, 'Tie::IxHash', + 'cust_bill' => 'invoices', + 'cust_statement' => 'statements', + 'cust_credit' => 'credits', + 'cust_pay' => 'payments', + 'cust_pay_void' => 'voided payments', + 'cust_refund' => 'refunds', + ; + + foreach my $table ( keys %financial_tables ) { + + my @records = $self->$table(); + + foreach my $record ( @records ) { + $record->custnum($new_custnum); + my $error = $record->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error merging ". $financial_tables{$table}. ": $error\n"; + } + } + + } + + my $name = $self->ship_name; + + my $locationnum = ''; + foreach my $cust_pkg ( $self->all_pkgs ) { + $cust_pkg->custnum($new_custnum); + + unless ( $cust_pkg->locationnum ) { + unless ( $locationnum ) { + my $cust_location = new FS::cust_location { + $self->location_hash, + 'custnum' => $new_custnum, + }; + my $error = $cust_location->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $locationnum = $cust_location->locationnum; + } + $cust_pkg->locationnum($locationnum); + } + + my $error = $cust_pkg->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + # add customer (ship) name to svc_phone.phone_name if blank + my @cust_svc = $cust_pkg->cust_svc; + foreach my $cust_svc (@cust_svc) { + my($label, $value, $svcdb) = $cust_svc->label; + next unless $svcdb eq 'svc_phone'; + my $svc_phone = $cust_svc->svc_x; + next if $svc_phone->phone_name; + $svc_phone->phone_name($name); + my $error = $svc_phone->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + + #not considered: + # cust_tax_exempt (texas tax exemptions) + # cust_recon (some sort of not-well understood thing for OnPac) + + #these are moved over + foreach my $table (qw( + cust_tag cust_location contact cust_attachment cust_main_note + cust_tax_adjustment cust_pay_batch queue + )) { + foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) { + $record->custnum($new_custnum); + my $error = $record->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + #these aren't preserved + foreach my $table (qw( + cust_main_exemption cust_main_invoice + )) { + foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) { + my $error = $record->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + + my $sth = $dbh->prepare( + 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?' + ) or do { + my $errstr = $dbh->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + $sth->execute($new_custnum, $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( + 'UPDATE Links SET Target = ? WHERE Target = ?' + ) or do { + my $errstr = $ticket_dbh->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum, + 'freeside://freeside/cust_main/'.$self->custnum) + or do { + my $errstr = $ticket_sth->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + + } + + #delete the customer record + + my $error = $self->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] + + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will +be set as the invoicing list (see L<"invoicing_list">). Errors return as +expected and rollback the entire transaction; it is not necessary to call +check_invoicing_list first. Here's an example: + + $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] ); + +Currently available options are: I. The I option can be set to an arrayref of tax names. FS::cust_main_exemption records will be deleted and inserted as appropriate. @@ -1443,11 +1470,50 @@ sub replace { return "You are not permitted to create complimentary accounts."; } + if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode') + && $conf->exists('enable_taxproducts') + ) + { + my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip) + ? 'ship_' : ''; + $self->set('geocode', '') + if $old->get($pre.'zip') ne $self->get($pre.'zip') + && length($self->get($pre.'zip')) >= 10; + } + + for my $pre ( grep $old->get($_.'coord_auto'), ( '', 'ship_' ) ) { + + $self->set($pre.'coord_auto', '') && next + if $self->get($pre.'latitude') && $self->get($pre.'longitude') + && ( $self->get($pre.'latitude') != $old->get($pre.'latitude') + || $self->get($pre.'longitude') != $old->get($pre.'longitude') + ); + + $self->set_coord($pre) + if $old->get($pre.'address1') ne $self->get($pre.'address1') + || $old->get($pre.'city') ne $self->get($pre.'city') + || $old->get($pre.'state') ne $self->get($pre.'state') + || $old->get($pre.'country') ne $self->get($pre.'country'); + + } + + $self->set_coord + if ! $self->coord_auto && ! $self->latitude && ! $self->longitude; + + $self->set_coord('ship_') + if $self->has_ship_address && ! $self->ship_coord_auto + && ! $self->ship_latitude && ! $self->ship_longitude; + local($ignore_expired_card) = 1 if $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/ && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask ); + local($ignore_banned_card) = 1 + if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/ + || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ ) + && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask ); + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -1476,6 +1542,28 @@ sub replace { $self->invoicing_list( $invoicing_list ); } + if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident + + #this could be more efficient than deleting and re-inserting, if it matters + foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) { + my $error = $cust_tag->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + foreach my $tagnum ( @{ $self->tagnum || [] } ) { + my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum, + 'custnum' => $self->custnum }; + my $error = $cust_tag->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + my %options = @param; my $tax_exemption = delete $options{'tax_exemption'}; @@ -1563,6 +1651,7 @@ Used by insert & replace to update the fuzzy search cache =cut +use FS::cust_main::Search; sub queue_fuzzyfiles_update { my $self = shift; @@ -1577,16 +1666,16 @@ sub queue_fuzzyfiles_update { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - my $error = $queue->insert( map $self->getfield($_), @fuzzyfields ); + my $queue = new FS::queue { 'job' => 'FS::cust_main::Search::append_fuzzyfiles' }; + my $error = $queue->insert( map $self->getfield($_), @FS::cust_main::Search::fuzzyfields ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } if ( $self->ship_last ) { - $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields ); + $queue = new FS::queue { 'job' => 'FS::cust_main::Search::append_fuzzyfiles' }; + $error = $queue->insert( map $self->getfield("ship_$_"), @FS::cust_main::Search::fuzzyfields ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -1630,6 +1719,9 @@ sub check { || $self->ut_textn('county') || $self->ut_textn('state') || $self->ut_country('country') + || $self->ut_coordn('latitude') + || $self->ut_coordn('longitude') + || $self->ut_enum('coord_auto', [ '', 'Y' ]) || $self->ut_anything('comments') || $self->ut_numbern('referral_custnum') || $self->ut_textn('stateid') @@ -1637,8 +1729,16 @@ sub check { || $self->ut_textn('invoice_terms') || $self->ut_alphan('geocode') || $self->ut_floatn('cdr_termination_percentage') + || $self->ut_floatn('credit_limit') + || $self->ut_numbern('billday') + || $self->ut_enum('edit_subject', [ '', 'Y' ] ) + || $self->ut_enum('calling_list_exempt', [ '', 'Y' ] ) + || $self->ut_enum('locale', [ '', FS::Locales->locales ]) ; + $self->set_coord + unless $import || ($self->latitude && $self->longitude); + #barf. need message catalogs. i18n. etc. $error .= "Please select an advertising source." if $error =~ /^Illegal or empty \(numeric\) refnum: /; @@ -1673,7 +1773,8 @@ sub check { # bad idea to disable, causes billing to fail because of no tax rates later -# unless ( $import ) { +# except we don't fail any more + unless ( $import ) { unless ( qsearch('cust_main_county', { 'country' => $self->country, 'state' => '', @@ -1686,18 +1787,23 @@ sub check { 'country' => $self->country, } ); } -# } + } $error = - $self->ut_phonen('daytime', $self->country) - || $self->ut_phonen('night', $self->country) - || $self->ut_phonen('fax', $self->country) - || $self->ut_zip('zip', $self->country) + $self->ut_phonen('daytime', $self->country) + || $self->ut_phonen('night', $self->country) + || $self->ut_phonen('fax', $self->country) + || $self->ut_phonen('mobile', $self->country) ; return $error if $error; + unless ( $ignore_illegal_zip ) { + $error = $self->ut_zip('zip', $self->country); + return $error if $error; + } + if ( $conf->exists('cust_main-require_phone') - && ! length($self->daytime) && ! length($self->night) + && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile) ) { my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/ @@ -1706,8 +1812,12 @@ sub check { my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/ ? 'Night Phone' : FS::Msgcat::_gettext('night'); - - return "$daytime_label or $night_label is required" + + my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/ + ? 'Mobile Phone' + : FS::Msgcat::_gettext('mobile'); + + return "$daytime_label, $night_label or $mobile_label is required" } @@ -1726,9 +1836,15 @@ sub check { || $self->ut_textn('ship_county') || $self->ut_textn('ship_state') || $self->ut_country('ship_country') + || $self->ut_coordn('ship_latitude') + || $self->ut_coordn('ship_longitude') + || $self->ut_enum('ship_coord_auto', [ '', 'Y' ] ) ; return $error if $error; + $self->set_coord('ship_') + unless $import || ($self->ship_latitude && $self->ship_longitude); + #false laziness with above unless ( qsearchs('cust_main_county', { 'country' => $self->ship_country, @@ -1745,13 +1861,17 @@ sub check { #eofalse $error = - $self->ut_phonen('ship_daytime', $self->ship_country) - || $self->ut_phonen('ship_night', $self->ship_country) - || $self->ut_phonen('ship_fax', $self->ship_country) - || $self->ut_zip('ship_zip', $self->ship_country) + $self->ut_phonen('ship_daytime', $self->ship_country) + || $self->ut_phonen('ship_night', $self->ship_country) + || $self->ut_phonen('ship_fax', $self->ship_country) + || $self->ut_phonen('ship_mobile', $self->ship_country) ; return $error if $error; + unless ( $ignore_illegal_zip ) { + $error = $self->ut_zip('ship_zip', $self->ship_country); + return $error if $error; + } return "Unit # is required." if $self->ship_address2 =~ /^\s*$/ && $conf->exists('cust_main-require_address2'); @@ -1795,7 +1915,7 @@ sub check { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; - $payinfo =~ /^(\d{13,16})$/ + $payinfo =~ /^(\d{13,16}|\d{8,9})$/ or return gettext('invalid_card'); # . ": ". $self->payinfo; $payinfo = $1; $self->payinfo($payinfo); @@ -1806,12 +1926,23 @@ sub check { if $self->payinfo !~ /^99\d{14}$/ #token && cardtype($self->payinfo) eq "Unknown"; - my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - if ( $ban ) { - return 'Banned credit card: banned on '. - time2str('%a %h %o at %r', $ban->_date). - ' by '. $ban->otaker. - ' (ban# '. $ban->bannum. ')'; + unless ( $ignore_banned_card ) { + my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } ); + if ( $ban ) { + if ( $ban->bantype eq 'warn' ) { + #or others depending on value of $ban->reason ? + return '_duplicate_card'. + ': disabled from'. time2str('%a %h %o at %r', $ban->_date). + ' until '. time2str('%a %h %o at %r', $ban->_end_date). + ' (ban# '. $ban->bannum. ')' + unless $self->override_ban_warn; + } else { + return 'Banned credit card: banned on '. + time2str('%a %h %o at %r', $ban->_date). + ' by '. $ban->otaker. + ' (ban# '. $ban->bannum. ')'; + } + } } if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { @@ -1855,8 +1986,11 @@ sub check { } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) { my $payinfo = $self->payinfo; - $payinfo =~ s/[^\d\@]//g; - if ( $conf->exists('echeck-nonus') ) { + $payinfo =~ s/[^\d\@\.]//g; + if ( $conf->exists('cust_main-require-bank-branch') ) { + $payinfo =~ /^(\d+)\@(\d+)\.(\d+)$/ or return 'invalid echeck account@branch.bank'; + $payinfo = "$1\@$2.$3"; + } elsif ( $conf->exists('echeck-nonus') ) { $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba'; $payinfo = "$1\@$2"; } else { @@ -1866,12 +2000,19 @@ sub check { $self->payinfo($payinfo); $self->paycvv(''); - my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - if ( $ban ) { - return 'Banned ACH account: banned on '. - time2str('%a %h %o at %r', $ban->_date). - ' by '. $ban->otaker. - ' (ban# '. $ban->bannum. ')'; + unless ( $ignore_banned_card ) { + my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } ); + if ( $ban ) { + if ( $ban->bantype eq 'warn' ) { + #or others depending on value of $ban->reason ? + return '_duplicate_ach' unless $self->override_ban_warn; + } else { + 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' ) { @@ -1931,6 +2072,7 @@ sub check { } else { return "Illegal expiration date: ". $self->paydate; } + $m = sprintf('%02d',$m); $self->paydate("$y-$m-01"); my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; return gettext('expired_card') @@ -1955,7 +2097,7 @@ sub check { $self->$flag($1); } - $self->otaker(getotaker) unless $self->otaker; + $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum; warn "$me check AFTER: \n". $self->_dump if $DEBUG > 2; @@ -1972,7 +2114,8 @@ Returns a list of fields which have ship_ duplicates. sub addr_fields { qw( last first company address1 address2 city county state zip country - daytime night fax + latitude longitude + daytime night fax mobile ); } @@ -1990,388 +2133,141 @@ sub has_ship_address { =item location_hash Returns a list of key/value pairs, with the following keys: address1, adddress2, -city, county, state, zip, country. The shipping address is used if present. +city, county, state, zip, country, and geocode. The shipping address is used if present. =cut -#geocode? dependent on tax-ship_address config, not available in cust_location -#mostly. not yet then. +=item cust_location -sub location_hash { - my $self = shift; - my $prefix = $self->has_ship_address ? 'ship_' : ''; +Returns all locations (see L) for this customer. + +=cut - map { $_ => $self->get($prefix.$_) } - qw( address1 address2 city county state zip country geocode ); - #fields that cust_location has +sub cust_location { + my $self = shift; + qsearch('cust_location', { 'custnum' => $self->custnum } ); } -=item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] +=item cust_contact -Returns all packages (see L) for this customer. +Returns all contacts (see L) for this customer. =cut -sub all_pkgs { +#already used :/ sub contact { +sub cust_contact { my $self = shift; - my $extra_qsearch = ref($_[0]) ? shift : {}; - - return $self->num_pkgs unless wantarray || keys(%$extra_qsearch); - - my @cust_pkg = (); - if ( $self->{'_pkgnum'} ) { - @cust_pkg = values %{ $self->{'_pkgnum'}->cache }; - } else { - @cust_pkg = $self->_cust_pkg($extra_qsearch); - } - - sort sort_packages @cust_pkg; + qsearch('contact', { 'custnum' => $self->custnum } ); } -=item cust_pkg +=item unsuspend -Synonym for B. +Unsuspends all unflagged suspended packages (see L +and L) for this customer. Always returns a list: an empty list +on success or a list of errors. =cut -sub cust_pkg { - shift->all_pkgs(@_); +sub unsuspend { + my $self = shift; + grep { $_->unsuspend } $self->suspended_pkgs; } -=item cust_location +=item suspend -Returns all locations (see L) for this customer. +Suspends all unsuspended packages (see L) for this customer. + +Returns a list: an empty list on success or a list of errors. =cut -sub cust_location { +sub suspend { my $self = shift; - qsearch('cust_location', { 'custnum' => $self->custnum } ); + grep { $_->suspend(@_) } $self->unsuspended_pkgs; } -=item location_label [ OPTION => VALUE ... ] - -Returns the label of the service location (see analog in L) for this customer. +=item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ] -Options are +Suspends all unsuspended packages (see L) matching the listed +PKGPARTs (see L). Preferred usage is to pass a hashref instead +of a list of pkgparts; the hashref has the following keys: =over 4 -=item join_string +=item pkgparts - listref of pkgparts -used to separate the address elements (defaults to ', ') +=item (other options are passed to the suspend method) -=item escape_function +=back -a callback used for escaping the text of the address elements -=back +Returns a list: an empty list on success or a list of errors. =cut -# false laziness with FS::cust_location::line - -sub location_label { +sub suspend_if_pkgpart { my $self = shift; - my %opt = @_; - - my $separator = $opt{join_string} || ', '; - my $escape = $opt{escape_function} || sub{ shift }; - my $line = ''; - my $cydefault = FS::conf->new->config('countrydefault') || 'US'; - my $prefix = length($self->ship_last) ? 'ship_' : ''; - - my $notfirst = 0; - foreach (qw ( address1 address2 ) ) { - my $method = "$prefix$_"; - $line .= ($notfirst ? $separator : ''). &$escape($self->$method) - if $self->$method; - $notfirst++; - } - $notfirst = 0; - foreach (qw ( city county state zip ) ) { - my $method = "$prefix$_"; - if ( $self->$method ) { - $line .= ' (' if $method eq 'county'; - $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method); - $line .= ' )' if $method eq 'county'; - $notfirst++; - } + my (@pkgparts, %opt); + if (ref($_[0]) eq 'HASH'){ + @pkgparts = @{$_[0]{pkgparts}}; + %opt = %{$_[0]}; + }else{ + @pkgparts = @_; } - $line .= $separator. &$escape(code2country($self->country)) - if $self->country ne $cydefault; - - $line; + grep { $_->suspend(%opt) } + grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts } + $self->unsuspended_pkgs; } -=item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] +=item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ] -Returns all non-cancelled packages (see L) for this customer. +Suspends all unsuspended packages (see L) unless they match the +given PKGPARTs (see L). Preferred usage is to pass a hashref +instead of a list of pkgparts; the hashref has the following keys: -=cut +=over 4 -sub ncancelled_pkgs { - my $self = shift; - my $extra_qsearch = ref($_[0]) ? shift : {}; +=item pkgparts - listref of pkgparts - return $self->num_ncancelled_pkgs unless wantarray; +=item (other options are passed to the suspend method) - my @cust_pkg = (); - if ( $self->{'_pkgnum'} ) { +=back - warn "$me ncancelled_pkgs: returning cached objects" - if $DEBUG > 1; +Returns a list: an empty list on success or a list of errors. - @cust_pkg = grep { ! $_->getfield('cancel') } - values %{ $self->{'_pkgnum'}->cache }; +=cut - } else { +sub suspend_unless_pkgpart { + my $self = shift; + my (@pkgparts, %opt); + if (ref($_[0]) eq 'HASH'){ + @pkgparts = @{$_[0]{pkgparts}}; + %opt = %{$_[0]}; + }else{ + @pkgparts = @_; + } + grep { $_->suspend(%opt) } + grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts } + $self->unsuspended_pkgs; +} - warn "$me ncancelled_pkgs: searching for packages with custnum ". - $self->custnum. "\n" - if $DEBUG > 1; +=item cancel [ OPTION => VALUE ... ] - $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) '; +Cancels all uncancelled packages (see L) for this customer. - @cust_pkg = $self->_cust_pkg($extra_qsearch); +Available options are: - } +=over 4 - sort sort_packages @cust_pkg; +=item quiet - can be set true to supress email cancellation notices. -} +=item reason - can be set to a cancellation reason (see L), 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, reason - Text of the new reason. -sub _cust_pkg { - my $self = shift; - my $extra_qsearch = ref($_[0]) ? shift : {}; +=item ban - can be set true to ban this customer's credit card or ACH information, if present. - $extra_qsearch->{'select'} ||= '*'; - $extra_qsearch->{'select'} .= - ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum ) - AS _num_cust_svc'; +=item nobill - can be set true to skip billing if it might otherwise be done. - map { - $_->{'_num_cust_svc'} = $_->get('_num_cust_svc'); - $_; - } - qsearch({ - %$extra_qsearch, - 'table' => 'cust_pkg', - 'hashref' => { 'custnum' => $self->custnum }, - }); - -} - -# This should be generalized to use config options to determine order. -sub sort_packages { - - my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 ); - return $locationsort if $locationsort; - - if ( $a->get('cancel') xor $b->get('cancel') ) { - return -1 if $b->get('cancel'); - return 1 if $a->get('cancel'); - #shouldn't get here... - return 0; - } else { - my $a_num_cust_svc = $a->num_cust_svc; - my $b_num_cust_svc = $b->num_cust_svc; - return 0 if !$a_num_cust_svc && !$b_num_cust_svc; - return -1 if $a_num_cust_svc && !$b_num_cust_svc; - return 1 if !$a_num_cust_svc && $b_num_cust_svc; - my @a_cust_svc = $a->cust_svc; - my @b_cust_svc = $b->cust_svc; - return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc); - return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc); - return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc); - $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label; - } - -} - -=item suspended_pkgs - -Returns all suspended packages (see L) for this customer. - -=cut - -sub suspended_pkgs { - my $self = shift; - grep { $_->susp } $self->ncancelled_pkgs; -} - -=item unflagged_suspended_pkgs - -Returns all unflagged suspended packages (see L) for this -customer (thouse packages without the `manual_flag' set). - -=cut - -sub unflagged_suspended_pkgs { - my $self = shift; - return $self->suspended_pkgs - unless dbdef->table('cust_pkg')->column('manual_flag'); - grep { ! $_->manual_flag } $self->suspended_pkgs; -} - -=item unsuspended_pkgs - -Returns all unsuspended (and uncancelled) packages (see L) for -this customer. - -=cut - -sub unsuspended_pkgs { - my $self = shift; - grep { ! $_->susp } $self->ncancelled_pkgs; -} - -=item next_bill_date - -Returns the next date this customer will be billed, as a UNIX timestamp, or -undef if no active package has a next bill date. - -=cut - -sub next_bill_date { - my $self = shift; - min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs ); -} - -=item num_cancelled_pkgs - -Returns the number of cancelled packages (see L) for this -customer. - -=cut - -sub num_cancelled_pkgs { - shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"); -} - -sub num_ncancelled_pkgs { - shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )"); -} - -sub num_pkgs { - my( $self ) = shift; - my $sql = scalar(@_) ? shift : ''; - $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i; - my $sth = dbh->prepare( - "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql" - ) or die dbh->errstr; - $sth->execute($self->custnum) or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; -} - -=item unsuspend - -Unsuspends all unflagged suspended packages (see L -and L) for this customer. Always returns a list: an empty list -on success or a list of errors. - -=cut - -sub unsuspend { - my $self = shift; - grep { $_->unsuspend } $self->suspended_pkgs; -} - -=item suspend - -Suspends all unsuspended packages (see L) for this customer. - -Returns a list: an empty list on success or a list of errors. - -=cut - -sub suspend { - my $self = shift; - grep { $_->suspend(@_) } $self->unsuspended_pkgs; -} - -=item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ] - -Suspends all unsuspended packages (see L) matching the listed -PKGPARTs (see L). Preferred usage is to pass a hashref instead -of a list of pkgparts; the hashref has the following keys: - -=over 4 - -=item pkgparts - listref of pkgparts - -=item (other options are passed to the suspend method) - -=back - - -Returns a list: an empty list on success or a list of errors. - -=cut - -sub suspend_if_pkgpart { - my $self = shift; - my (@pkgparts, %opt); - if (ref($_[0]) eq 'HASH'){ - @pkgparts = @{$_[0]{pkgparts}}; - %opt = %{$_[0]}; - }else{ - @pkgparts = @_; - } - grep { $_->suspend(%opt) } - grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts } - $self->unsuspended_pkgs; -} - -=item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ] - -Suspends all unsuspended packages (see L) unless they match the -given PKGPARTs (see L). Preferred usage is to pass a hashref -instead of a list of pkgparts; the hashref has the following keys: - -=over 4 - -=item pkgparts - listref of pkgparts - -=item (other options are passed to the suspend method) - -=back - -Returns a list: an empty list on success or a list of errors. - -=cut - -sub suspend_unless_pkgpart { - my $self = shift; - my (@pkgparts, %opt); - if (ref($_[0]) eq 'HASH'){ - @pkgparts = @{$_[0]{pkgparts}}; - %opt = %{$_[0]}; - }else{ - @pkgparts = @_; - } - grep { $_->suspend(%opt) } - grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts } - $self->unsuspended_pkgs; -} - -=item cancel [ OPTION => VALUE ... ] - -Cancels all uncancelled packages (see L) for this customer. - -Available options are: - -=over 4 - -=item quiet - can be set true to supress email cancellation notices. - -=item reason - can be set to a cancellation reason (see L), 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, reason - Text of the new reason. - -=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 +=back Always returns a list: an empty list on success or a list of errors. @@ -2396,7 +2292,7 @@ sub cancel { return ( "Can't (yet) ban encrypted credit cards" ) if $self->is_encrypted($self->payinfo); - my $ban = new FS::banned_pay $self->_banned_pay_hashref; + my $ban = new FS::banned_pay $self->_new_banned_pay_hashref; my $error = $ban->insert; return ( $error ) if $error; @@ -2430,11 +2326,18 @@ sub _banned_pay_hashref { { 'payby' => $payby2ban{$self->payby}, - 'payinfo' => md5_base64($self->payinfo), + 'payinfo' => $self->payinfo, #don't ever *search* on reason! #'reason' => }; } +sub _new_banned_pay_hashref { + my $self = shift; + my $hr = $self->_banned_pay_hashref; + $hr->{payinfo} = md5_base64($hr->{payinfo}); + $hr; +} + =item notes Returns all notes (see L) for this customer. @@ -2442,13 +2345,14 @@ Returns all notes (see L) for this customer. =cut sub notes { - my $self = shift; - #order by? + my($self,$orderby_classnum) = (shift,shift); + my $orderby = "_DATE DESC"; + $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum; qsearch( 'cust_main_note', { 'custnum' => $self->custnum }, - '', - 'ORDER BY _DATE DESC' - ); + '', + "ORDER BY $orderby", + ); } =item agent @@ -2462,6 +2366,42 @@ sub agent { qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); } +=item agent_name + +Returns the agent name (see L) for this customer. + +=cut + +sub agent_name { + my $self = shift; + $self->agent->agent; +} + +=item cust_tag + +Returns any tags associated with this customer, as FS::cust_tag objects, +or an empty list if there are no tags. + +=cut + +sub cust_tag { + my $self = shift; + qsearch('cust_tag', { 'custnum' => $self->custnum } ); +} + +=item part_tag + +Returns any tags associated with this customer, as FS::part_tag objects, +or an empty list if there are no tags. + +=cut + +sub part_tag { + my $self = shift; + map $_->part_tag, $self->cust_tag; +} + + =item cust_class Returns the customer class, as an FS::cust_class object, or the empty string @@ -2508,1409 +2448,1021 @@ sub classname { : ''; } +=item BILLING METHODS -=item bill_and_collect - -Cancels and suspends any packages due, generates bills, applies payments and -credits, and applies collection events to run cards, send bills and notices, -etc. +Documentation on billing methods has been moved to +L. -By default, warns on errors and continues with the next operation (but see the -"fatal" flag below). +=item REALTIME BILLING METHODS -Options are passed as name-value pairs. Currently available options are: +Documentation on realtime billing methods has been moved to +L. -=over 4 - -=item time - -Bills the customer as if it were that time. Specified as a UNIX timestamp; see L). Also see L and L for conversion functions. For example: - - use Date::Parse; - ... - $cust_main->bill( 'time' => str2time('April 20th, 2001') ); - -=item invoice_time +=item remove_cvv -Used in conjunction with the I