X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=4dced54619957651d6110569777e38ea811d6dd7;hp=54586343df1cbba0b79cbce1962621783f8a78dc;hb=63973c641c4be00765fa27e55c57cc5b9aa4da19;hpb=89b5540310ed5687fcadc85e37338e2263f86a06 diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 54586343d..4dced5461 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,26 +1,30 @@ package FS::cust_pkg; use strict; -use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin +use base qw( FS::otaker_Mixin FS::cust_main_Mixin + FS::contact_Mixin FS::location_Mixin FS::m2m_Common FS::option_Common ); use vars qw($disable_agentcheck $DEBUG $me); use Carp qw(cluck); use Scalar::Util qw( blessed ); -use List::Util qw(max); +use List::Util qw(min max); use Tie::IxHash; use Time::Local qw( timelocal timelocal_nocheck ); use MIME::Entity; -use FS::UID qw( getotaker dbh ); +use FS::UID qw( dbh driver_name ); use FS::Misc qw( send_email ); -use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearch qsearchs fields ); use FS::CurrentUser; use FS::cust_svc; use FS::part_pkg; use FS::cust_main; +use FS::contact; use FS::cust_location; use FS::pkg_svc; use FS::cust_bill_pkg; use FS::cust_pkg_detail; +use FS::cust_pkg_usage; +use FS::cdr_cust_pkg_usage; use FS::cust_event; use FS::h_cust_svc; use FS::reg_code; @@ -197,6 +201,15 @@ Previous locationnum =item waive_setup +=item main_pkgnum + +The pkgnum of the package that this package is supplemental to, if any. + +=item pkglinknum + +The package link (L) that defines this supplemental +package, if it is one. + =back Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date @@ -214,7 +227,7 @@ Create a new billing item. To add the item to the database, see L<"insert">. =cut sub table { 'cust_pkg'; } -sub cust_linked { $_[0]->cust_main_custnum; } +sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum } sub cust_unlinked_msg { my $self = shift; "WARNING: can't find cust_main.custnum ". $self->custnum. @@ -256,6 +269,12 @@ a ticket will be added to this customer with this subject an optional queue name for ticket additions +=item allow_pkgpart + +Don't check the legality of the package definition. This should be used +when performing a package change that doesn't change the pkgpart (i.e. +a location change). + =back =cut @@ -263,7 +282,8 @@ an optional queue name for ticket additions sub insert { my( $self, %options ) = @_; - my $error = $self->check_pkgpart; + my $error; + $error = $self->check_pkgpart unless $options{'allow_pkgpart'}; return $error if $error; my $part_pkg = $self->part_pkg; @@ -338,6 +358,9 @@ sub insert { if ( $conf->config('ticket_system') && $options{ticket_subject} ) { + #this init stuff is still inefficient, but at least its limited to + # the small number (any?) folks using ticket emailing on pkg order + #eval ' # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" ); # use RT; @@ -591,13 +614,15 @@ replace methods. sub check { my $self = shift; - $self->locationnum('') if !$self->locationnum || $self->locationnum == -1; + if ( !$self->locationnum or $self->locationnum == -1 ) { + $self->set('locationnum', $self->cust_main->ship_locationnum); + } my $error = $self->ut_numbern('pkgnum') || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') || $self->ut_numbern('pkgpart') - || $self->check_pkgpart + || $self->ut_foreign_keyn('contactnum', 'contact', 'contactnum' ) || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum') || $self->ut_numbern('start_date') || $self->ut_numbern('setup') @@ -605,6 +630,7 @@ sub check { || $self->ut_numbern('susp') || $self->ut_numbern('cancel') || $self->ut_numbern('adjourn') + || $self->ut_numbern('resume') || $self->ut_numbern('expire') || $self->ut_numbern('dundate') || $self->ut_enum('no_auto', [ '', 'Y' ]) @@ -612,12 +638,17 @@ sub check { || $self->ut_numbern('agent_pkgid') || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ]) || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ]) + || $self->ut_foreign_keyn('main_pkgnum', 'cust_pkg', 'pkgnum') + || $self->ut_foreign_keyn('pkglinknum', 'part_pkg_link', 'pkglinknum') ; return $error if $error; return "A package with both start date (future start) and setup date (already started) will never bill" if $self->start_date && $self->setup; + return "A future unsuspend date can only be set for a package with a suspend date" + if $self->resume and !$self->susp and !$self->adjourn; + $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum; if ( $self->dbdef_table->column('manual_flag') ) { @@ -632,14 +663,19 @@ sub check { =item check_pkgpart +Check the pkgpart to make sure it's allowed with the reg_code and/or +promo_code of the package (if present) and with the customer's agent. +Called from C, unless we are doing a package change that doesn't +affect pkgpart. + =cut sub check_pkgpart { my $self = shift; - my $error = $self->ut_numbern('pkgpart'); - return $error if $error; + # my $error = $self->ut_numbern('pkgpart'); # already done + my $error; if ( $self->reg_code ) { unless ( grep { $self->pkgpart == $_->pkgpart } @@ -723,6 +759,11 @@ sub cancel { my( $self, %options ) = @_; my $error; + # pass all suspend/cancel actions to the main package + if ( $self->main_pkgnum and !$options{'from_main'} ) { + return $self->main_pkg->cancel(%options); + } + my $conf = new FS::Conf; warn "cust_pkg::cancel called with options". @@ -810,7 +851,7 @@ sub cancel { $do_credit = $self->part_pkg->option('unused_credit_cancel', 1); } if ( $do_credit ) { - my $error = $self->credit_remaining($cancel_time); + my $error = $self->credit_remaining('cancel', $cancel_time); if ($error) { $dbh->rollback if $oldAutoCommit; return $error; @@ -821,6 +862,7 @@ sub cancel { my %hash = $self->hash; $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time); + $hash{'change_custnum'} = $options{'change_custnum'}; my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace( $self, options => { $self->options } ); if ( $error ) { @@ -828,6 +870,22 @@ sub cancel { return $error; } + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + $error = $supp_pkg->cancel(%options, 'from_main' => 1); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + + foreach my $usage ( $self->cust_pkg_usage ) { + $error = $usage->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "deleting usage pools: $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; return '' if $date; #no errors @@ -875,6 +933,186 @@ sub cancel_if_expired { ''; } +=item uncancel + +"Un-cancels" this package: Orders a new package with the same custnum, pkgpart, +locationnum, (other fields?). Attempts to re-provision cancelled services +using history information (errors at this stage are not fatal). + +cust_pkg: pass a scalar reference, will be filled in with the new cust_pkg object + +svc_fatal: service provisioning errors are fatal + +svc_errors: pass an array reference, will be filled in with any provisioning errors + +main_pkgnum: link the package as a supplemental package of this one. For +internal use only. + +=cut + +sub uncancel { + my( $self, %options ) = @_; + + #in case you try do do $uncancel-date = $cust_pkg->uncacel + return '' unless $self->get('cancel'); + + if ( $self->main_pkgnum and !$options{'main_pkgnum'} ) { + return $self->main_pkg->uncancel(%options); + } + + ## + # Transaction-alize + ## + + 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; + + ## + # insert the new package + ## + + my $cust_pkg = new FS::cust_pkg { + last_bill => ( $options{'last_bill'} || $self->get('last_bill') ), + bill => ( $options{'bill'} || $self->get('bill') ), + uncancel => time, + uncancel_pkgnum => $self->pkgnum, + main_pkgnum => ($options{'main_pkgnum'} || ''), + map { $_ => $self->get($_) } qw( + custnum pkgpart locationnum + setup + susp adjourn resume expire start_date contract_end dundate + change_date change_pkgpart change_locationnum + manual_flag no_auto quantity agent_pkgid recur_show_zero setup_show_zero + ), + }; + + my $error = $cust_pkg->insert( + 'change' => 1, #supresses any referral credit to a referring customer + 'allow_pkgpart' => 1, # allow this even if the package def is disabled + ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + ## + # insert services + ## + + #find historical services within this timeframe before the package cancel + # (incompatible with "time" option to cust_pkg->cancel?) + my $fuzz = 2 * 60; #2 minutes? too much? (might catch separate unprovision) + # too little? (unprovisioing export delay?) + my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz ); + my @h_cust_svc = $self->h_cust_svc( $end, $start ); + + my @svc_errors; + foreach my $h_cust_svc (@h_cust_svc) { + my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start ); + #next unless $h_svc_x; #should this happen? + (my $table = $h_svc_x->table) =~ s/^h_//; + require "FS/$table.pm"; + my $class = "FS::$table"; + my $svc_x = $class->new( { + 'pkgnum' => $cust_pkg->pkgnum, + 'svcpart' => $h_cust_svc->svcpart, + map { $_ => $h_svc_x->get($_) } fields($table) + } ); + + # radius_usergroup + if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) { + $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] ); + } + + my $svc_error = $svc_x->insert; + if ( $svc_error ) { + if ( $options{svc_fatal} ) { + $dbh->rollback if $oldAutoCommit; + return $svc_error; + } else { + # if we've failed to insert the svc_x object, svc_Common->insert + # will have removed the cust_svc already. if not, then both records + # were inserted but we failed for some other reason (export, most + # likely). in that case, report the error and delete the records. + push @svc_errors, $svc_error; + my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum }); + if ( $cust_svc ) { + # except if export_insert failed, export_delete probably won't be + # much better + local $FS::svc_Common::noexport_hack = 1; + my $cleanup_error = $svc_x->delete; # also deletes cust_svc + if ( $cleanup_error ) { # and if THAT fails, then run away + $dbh->rollback if $oldAutoCommit; + return $cleanup_error; + } + } + } # svc_fatal + } # svc_error + } #foreach $h_cust_svc + + #these are pretty rare, but should handle them + # - dsl_device (mac addresses) + # - phone_device (mac addresses) + # - dsl_note (ikano notes) + # - domain_record (i.e. restore DNS information w/domains) + # - inventory_item(?) (inventory w/un-cancelling service?) + # - nas (svc_broaband nas stuff) + #this stuff is unused in the wild afaik + # - mailinglistmember + # - router.svcnum? + # - svc_domain.parent_svcnum? + # - acct_snarf (ancient mail fetching config) + # - cgp_rule (communigate) + # - cust_svc_option (used by our Tron stuff) + # - acct_rt_transaction (used by our time worked stuff) + + ## + # also move over any services that didn't unprovision at cancellation + ## + + foreach my $cust_svc ( qsearch('cust_svc', { pkgnum => $self->pkgnum } ) ) { + $cust_svc->pkgnum( $cust_pkg->pkgnum ); + my $error = $cust_svc->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + ## + # Uncancel any supplemental packages, and make them supplemental to the + # new one. + ## + + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + my $new_pkg; + $error = $supp_pkg->uncancel(%options, 'main_pkgnum' => $cust_pkg->pkgnum); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + + ## + # Finish + ## + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ${ $options{cust_pkg} } = $cust_pkg if ref($options{cust_pkg}); + @{ $options{svc_errors} } = @svc_errors if ref($options{svc_errors}); + + ''; +} + =item unexpire Cancels any pending expiration (sets the expire field to null). @@ -936,9 +1174,24 @@ Available options are: =over 4 -=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 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 date - can be set to a unix style timestamp to specify when to +suspend (adjourn) + +=item time - can be set to override the current time, for calculation +of final invoices or unused-time credits + +=item resume_date - can be set to a time when the package should be +unsuspended. This may be more convenient than calling C +separately. -=item date - can be set to a unix style timestamp to specify when to suspend (adjourn) +=item from_main - allows a supplemental package to be suspended, rather +than redirecting the method call to its main package. For internal use. =back @@ -950,6 +1203,11 @@ sub suspend { my( $self, %options ) = @_; my $error; + # pass all suspend/cancel actions to the main package + if ( $self->main_pkgnum and !$options{'from_main'} ) { + return $self->main_pkg->suspend(%options); + } + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -976,7 +1234,7 @@ sub suspend { my $suspend_time = $options{'time'} || time; my $date = $options{date} if $options{date}; # adjourn/suspend later - $date = '' if ($date && $date <= time); # complain instead? + $date = '' if ($date && $date <= $suspend_time); # complain instead? if ( $date && $old->get('expire') && $old->get('expire') < $date ) { dbh->rollback if $oldAutoCommit; @@ -1019,8 +1277,19 @@ sub suspend { } else { $hash{'susp'} = $suspend_time; } + + my $resume_date = $options{'resume_date'} || 0; + if ( $resume_date > ($date || $suspend_time) ) { + $hash{'resume'} = $resume_date; + } + + $options{options} ||= {}; + my $new = new FS::cust_pkg ( \%hash ); - $error = $new->replace( $self, options => { $self->options } ); + $error = $new->replace( $self, options => { $self->options, + %{ $options{options} }, + } + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -1029,7 +1298,7 @@ sub suspend { unless ( $date ) { # credit remaining time if appropriate if ( $self->part_pkg->option('unused_credit_suspend', 1) ) { - my $error = $self->credit_remaining($suspend_time); + my $error = $self->credit_remaining('suspend', $suspend_time); if ($error) { $dbh->rollback if $oldAutoCommit; return $error; @@ -1089,16 +1358,38 @@ sub suspend { } + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + $error = $supp_pkg->suspend(%options, 'from_main' => 1); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "suspending supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no errors } +=item credit_remaining MODE TIME + +Generate a credit for this package for the time remaining in the current +billing period. MODE is either "suspend" or "cancel" (determines the +credit type). TIME is the time of suspension/cancellation. Both arguments +are mandatory. + +=cut + sub credit_remaining { # Add a credit for remaining service - my $self = shift; - my $time = shift or die 'no suspend/cancel time'; + my ($self, $mode, $time) = @_; + die 'credit_remaining requires suspend or cancel' + unless $mode eq 'suspend' or $mode eq 'cancel'; + die 'no suspend/cancel time' unless $time > 0; + my $conf = FS::Conf->new; + my $reason_type = $conf->config($mode.'_credit_type'); + my $last_bill = $self->getfield('last_bill') || 0; my $next_bill = $self->getfield('bill') || 0; if ( $last_bill > 0 # the package has been billed @@ -1112,8 +1403,8 @@ sub credit_remaining { my $error = $self->cust_main->credit( $remaining_value, 'Credit for unused time on '. $self->part_pkg->pkg, - 'reason_type' => $conf->config('cancel_credit_type'), - ); # need 'suspend_credit_type'? + 'reason_type' => $reason_type, + ); return "Error crediting customer \$$remaining_value for unused time". " on ". $self->part_pkg->pkg. ": $error" if $error; @@ -1126,12 +1417,18 @@ sub credit_remaining { Unsuspends all services (see L and L) in this package, then unsuspends the package itself (clears the susp field and the -adjourn field if it is in the past). +adjourn field if it is in the past). If the suspend reason includes an +unsuspension package, that package will be ordered. Available options are: =over 4 +=item date + +Can be set to a date to unsuspend the package in the future (the 'resume' +field). + =item adjust_next_bill Can be set true to adjust the next bill date forward by @@ -1151,6 +1448,11 @@ sub unsuspend { my( $self, %opt ) = @_; my $error; + # pass all suspend/cancel actions to the main package + if ( $self->main_pkgnum and !$opt{'from_main'} ) { + return $self->main_pkg->unsuspend(%opt); + } + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -1166,15 +1468,40 @@ sub unsuspend { my $pkgnum = $old->pkgnum; if ( $old->get('cancel') || $self->get('cancel') ) { - dbh->rollback if $oldAutoCommit; + $dbh->rollback if $oldAutoCommit; return "Can't unsuspend cancelled package $pkgnum"; } unless ( $old->get('susp') && $self->get('susp') ) { - dbh->rollback if $oldAutoCommit; + $dbh->rollback if $oldAutoCommit; return ""; # no error # complain instead? } + my $date = $opt{'date'}; + if ( $date and $date > time ) { # return an error if $date <= time? + + if ( $old->get('expire') && $old->get('expire') < $date ) { + $dbh->rollback if $oldAutoCommit; + return "Package $pkgnum expires before it would be unsuspended."; + } + + my $new = new FS::cust_pkg { $self->hash }; + $new->set('resume', $date); + $error = $new->replace($self, options => $self->options); + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + else { + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; + } + + } #if $date + + my @labels = (); + foreach my $cust_svc ( qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } ) ) { @@ -1194,10 +1521,15 @@ sub unsuspend { $dbh->rollback if $oldAutoCommit; return $error; } + my( $label, $value ) = $cust_svc->label; + push @labels, "$label: $value"; } } + my $cust_pkg_reason = $self->last_cust_pkg_reason('susp'); + my $reason = $cust_pkg_reason ? $cust_pkg_reason->reason : ''; + my %hash = $self->hash; my $inactive = time - $hash{'susp'}; @@ -1215,7 +1547,8 @@ sub unsuspend { } $hash{'susp'} = ''; - $hash{'adjourn'} = '' if $hash{'adjourn'} < time; + $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time; + $hash{'resume'} = '' if !$hash{'adjourn'}; my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace( $self, options => { $self->options } ); if ( $error ) { @@ -1223,6 +1556,69 @@ sub unsuspend { return $error; } + my $unsusp_pkg; + + if ( $reason && $reason->unsuspend_pkgpart ) { + my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart) + or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart. + " not found."; + my $start_date = $self->cust_main->next_bill_date + if $reason->unsuspend_hold; + + if ( $part_pkg ) { + $unsusp_pkg = FS::cust_pkg->new({ + 'custnum' => $self->custnum, + 'pkgpart' => $reason->unsuspend_pkgpart, + 'start_date' => $start_date, + 'locationnum' => $self->locationnum, + # discount? probably not... + }); + + $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg ); + } + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + if ( $conf->config('unsuspend_email_admin') ) { + + my $error = send_email( + 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), + #invoice_from ??? well as good as any + 'to' => $conf->config('unsuspend_email_admin'), + 'subject' => 'FREESIDE NOTIFICATION: Customer package unsuspended', 'body' => [ + "This is an automatic message from your Freeside installation\n", + "informing you that the following customer package has been unsuspended:\n", + "\n", + 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n", + 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n", + ( map { "Service : $_\n" } @labels ), + ($unsusp_pkg ? + "An unsuspension fee was charged: ". + $unsusp_pkg->part_pkg->pkg_comment."\n" + : '' + ), + ], + ); + + if ( $error ) { + warn "WARNING: can't send unsuspension admin email (unsuspending anyway): ". + "$error\n"; + } + + } + + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + $error = $supp_pkg->unsuspend(%opt, 'from_main' => 1); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "unsuspending supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no errors @@ -1273,6 +1669,7 @@ sub unadjourn { my %hash = $self->hash; $hash{'adjourn'} = ''; + $hash{'resume'} = ''; my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace( $self, options => { $self->options } ); if ( $error ) { @@ -1307,6 +1704,11 @@ New locationnum, to change the location for this package. New FS::cust_location object, to create a new location and assign it to this package. +=item cust_main + +New FS::cust_main object, to create a new customer and assign the new package +to it. + =item pkgpart New pkgpart (see L). @@ -1371,9 +1773,8 @@ sub change { $hash{"change_$_"} = $self->$_() foreach qw( pkgnum pkgpart locationnum ); - if ( $opt->{'cust_location'} && - ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) { - $error = $opt->{'cust_location'}->insert; + if ( $opt->{'cust_location'} ) { + $error = $opt->{'cust_location'}->find_or_insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting cust_location (transaction rolled back): $error"; @@ -1381,21 +1782,29 @@ sub change { $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum; } + # whether to override pkgpart checking on the new package + my $same_pkgpart = 1; + if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) { + $same_pkgpart = 0; + } + my $unused_credit = 0; my $keep_dates = $opt->{'keep_dates'}; # Special case. If the pkgpart is changing, and the customer is # going to be credited for remaining time, don't keep setup, bill, # or last_bill dates, and DO pass the flag to cancel() to credit # the customer. - if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) { + if ( $opt->{'pkgpart'} + and $opt->{'pkgpart'} != $self->pkgpart + and $self->part_pkg->option('unused_credit_change', 1) ) { + $unused_credit = 1; $keep_dates = 0; - $unused_credit = 1 if $self->part_pkg->option('unused_credit_change', 1); $hash{$_} = '' foreach qw(setup bill last_bill); } if ( $keep_dates ) { foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire - start_date contract_end ) ) { + resume start_date contract_end ) ) { $hash{$date} = $self->getfield($date); } } @@ -1403,16 +1812,37 @@ sub change { # (i.e. customer default location) $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'}); + # usually this doesn't matter. the two cases where it does are: + # 1. unused_credit_change + pkgpart change + setup fee on the new package + # and + # 2. (more importantly) changing a package before it's billed + $hash{'waive_setup'} = $self->waive_setup; + + my $custnum = $self->custnum; + if ( $opt->{cust_main} ) { + my $cust_main = $opt->{cust_main}; + unless ( $cust_main->custnum ) { + my $error = $cust_main->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main (transaction rolled back): $error"; + } + } + $custnum = $cust_main->custnum; + } + + $hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'}; + # Create the new package. my $cust_pkg = new FS::cust_pkg { - custnum => $self->custnum, - pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ), - refnum => ( $opt->{'refnum'} || $self->refnum ), - locationnum => ( $opt->{'locationnum'} ), + custnum => $custnum, + pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ), + refnum => ( $opt->{'refnum'} || $self->refnum ), + locationnum => ( $opt->{'locationnum'} ), %hash, }; - - $error = $cust_pkg->insert( 'change' => 1 ); + $error = $cust_pkg->insert( 'change' => 1, + 'allow_pkgpart' => $same_pkgpart ); if ($error) { $dbh->rollback if $oldAutoCommit; return $error; @@ -1458,6 +1888,84 @@ sub change { $dbh->rollback if $oldAutoCommit; return "Error setting usage values: $error"; } + } else { + # if NOT changing pkgpart, transfer any usage pools over + foreach my $usage ($self->cust_pkg_usage) { + $usage->set('pkgnum', $cust_pkg->pkgnum); + $error = $usage->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error transferring usage pools: $error"; + } + } + } + + # transfer discounts, if we're not changing pkgpart + if ( $same_pkgpart ) { + foreach my $old_discount ($self->cust_pkg_discount_active) { + # don't remove the old discount, we may still need to bill that package. + my $new_discount = new FS::cust_pkg_discount { + 'pkgnum' => $cust_pkg->pkgnum, + 'discountnum' => $old_discount->discountnum, + 'months_used' => $old_discount->months_used, + }; + $error = $new_discount->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error transferring discounts: $error"; + } + } + } + + # Order any supplemental packages. + my $part_pkg = $cust_pkg->part_pkg; + my @old_supp_pkgs = $self->supplemental_pkgs; + my @new_supp_pkgs; + foreach my $link ($part_pkg->supp_part_pkg_link) { + my $old; + foreach (@old_supp_pkgs) { + if ($_->pkgpart == $link->dst_pkgpart) { + $old = $_; + $_->pkgpart(0); # so that it can't match more than once + } + last if $old; + } + # false laziness with FS::cust_main::Packages::order_pkg + my $new = FS::cust_pkg->new({ + pkgpart => $link->dst_pkgpart, + pkglinknum => $link->pkglinknum, + custnum => $custnum, + main_pkgnum => $cust_pkg->pkgnum, + locationnum => $cust_pkg->locationnum, + start_date => $cust_pkg->start_date, + order_date => $cust_pkg->order_date, + expire => $cust_pkg->expire, + adjourn => $cust_pkg->adjourn, + contract_end => $cust_pkg->contract_end, + refnum => $cust_pkg->refnum, + discountnum => $cust_pkg->discountnum, + waive_setup => $cust_pkg->waive_setup, + }); + if ( $old and $opt->{'keep_dates'} ) { + foreach (qw(setup bill last_bill)) { + $new->set($_, $old->get($_)); + } + } + $error = $new->insert( allow_pkgpart => $same_pkgpart ); + # transfer services + if ( $old ) { + $error ||= $old->transfer($new); + } + if ( $error and $error > 0 ) { + # no reason why this should ever fail, but still... + $error = "Unable to transfer all services from supplemental package ". + $old->pkgnum; + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + push @new_supp_pkgs, $new; } #Good to go, cancel old package. Notify 'cancel' of whether to credit @@ -1465,10 +1973,12 @@ sub change { #Don't allow billing the package (preceding period packages and/or #outstanding usage) if we are keeping dates (i.e. location changing), #because the new package will be billed for the same date range. + #Supplemental packages are also canceled here. $error = $self->cancel( - quiet => 1, - unused_credit => $unused_credit, - nobill => $keep_dates + quiet => 1, + unused_credit => $unused_credit, + nobill => $keep_dates, + change_custnum => ( $self->custnum != $custnum ? $custnum : '' ), ); if ($error) { $dbh->rollback if $oldAutoCommit; @@ -1477,7 +1987,9 @@ sub change { if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) { #$self->cust_main - my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] ); + my $error = $cust_pkg->cust_main->bill( + 'pkg_list' => [ $cust_pkg, @new_supp_pkgs ] + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -1490,6 +2002,24 @@ sub change { } +=item set_quantity QUANTITY + +Change the package's quantity field. This is the one package property +that can safely be changed without canceling and reordering the package +(because it doesn't affect tax eligibility). Returns an error or an +empty string. + +=cut + +sub set_quantity { + my $self = shift; + $self = $self->replace_old; # just to make sure + my $qty = shift; + ($qty =~ /^\d+$/ and $qty > 0) or return "bad package quantity $qty"; + $self->set('quantity' => $qty); + $self->replace; +} + use Storable 'thaw'; use MIME::Base64; sub process_bulk_cust_pkg { @@ -1620,6 +2150,18 @@ sub old_cust_pkg { qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } ); } +=item change_cust_main + +Returns the customter this package was detached to, if any. + +=cut + +sub change_cust_main { + my $self = shift; + return '' unless $self->change_custnum; + qsearchs('cust_main', { 'custnum' => $self->change_custnum } ); +} + =item calc_setup Calls the I of the FS::part_pkg object associated with this billing @@ -1829,7 +2371,7 @@ sub cust_svc { } if ( $opt{'svcdb'} ) { $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) '; - $search{hashref}->{svcdb} = $opt{'svcdb'}; + $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} ); } cluck "cust_pkg->cust_svc called" if $DEBUG > 2; @@ -1963,11 +2505,14 @@ field, I, which specifies the number of available services. sub available_part_svc { my $self = shift; + + my $pkg_quantity = $self->quantity || 1; + grep { $_->num_avail > 0 } map { my $part_svc = $_->part_svc; $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking - $_->quantity - $self->num_cust_svc($_->svcpart); + $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart); # more evil encapsulation breakage if($part_svc->{'Hash'}{'num_avail'} > 0) { @@ -2009,6 +2554,8 @@ sub part_svc { my $self = shift; my %opt = @_; + my $pkg_quantity = $self->quantity || 1; + #XXX some sort of sort order besides numeric by svcpart... my @part_svc = sort { $a->svcpart <=> $b->svcpart } map { my $pkg_svc = $_; @@ -2016,7 +2563,7 @@ sub part_svc { my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart); $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil $part_svc->{'Hash'}{'num_avail'} = - max( 0, $pkg_svc->quantity - $num_cust_svc ); + max( 0, $pkg_quantity * $pkg_svc->quantity - $num_cust_svc ); $part_svc->{'Hash'}{'cust_pkg_svc'} = $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [] unless exists($opt{summarize_size}) && $opt{summarize_size} > 0 @@ -2175,7 +2722,7 @@ sub statuscolor { =item pkg_label Returns a label for this package. (Currently "pkgnum: pkg - comment" or -"pkg-comment" depending on user preference). +"pkg - comment" depending on user preference). =cut @@ -2202,6 +2749,17 @@ sub pkg_label_long { $label; } +=item pkg_locale + +Returns a customer-localized label for this package. + +=cut + +sub pkg_locale { + my $self = shift; + $self->part_pkg->pkg_locale( $self->cust_main->locale ); +} + =item primary_cust_svc Returns a primary service (as FS::cust_svc object) if one can be identified. @@ -2356,6 +2914,18 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +=item balance + +Returns the balance for this specific package, when using +experimental package balance. + +=cut + +sub balance { + my $self = shift; + $self->cust_main->balance_pkgnum( $self->pkgnum ); +} + #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin =item cust_location @@ -2375,6 +2945,39 @@ Returns the label of the location object (see L). #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin +=item tax_locationnum + +Returns the foreign key to a L object for calculating +tax on this package, as determined by the C and +C configuration flags. + +=cut + +sub tax_locationnum { + my $self = shift; + my $conf = FS::Conf->new; + if ( $conf->exists('tax-pkg_address') ) { + return $self->locationnum; + } + elsif ( $conf->exists('tax-ship_address') ) { + return $self->cust_main->ship_locationnum; + } + else { + return $self->cust_main->bill_locationnum; + } +} + +=item tax_location + +Returns the L object for tax_locationnum. + +=cut + +sub tax_location { + my $self = shift; + FS::cust_location->by_key( $self->tax_locationnum ) +} + =item seconds_since TIMESTAMP Returns the number of seconds all accounts (see L) in this @@ -2421,7 +3024,7 @@ sub seconds_since_sqlradacct { grep { my $part_svc = $_->part_svc; $part_svc->svcdb eq 'svc_acct' - && scalar($part_svc->part_export('sqlradius')); + && scalar($part_svc->part_export_usage); } $self->cust_svc ) { $seconds += $cust_svc->seconds_since_sqlradacct($start, $end); @@ -2453,7 +3056,7 @@ sub attribute_since_sqlradacct { grep { my $part_svc = $_->part_svc; $part_svc->svcdb eq 'svc_acct' - && scalar($part_svc->part_export('sqlradius')); + && scalar($part_svc->part_export_usage); } $self->cust_svc ) { $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib); @@ -2550,7 +3153,8 @@ sub transfer { } foreach my $cust_svc ($self->cust_svc) { - if($target{$cust_svc->svcpart} > 0) { + if($target{$cust_svc->svcpart} > 0 + or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option $target{$cust_svc->svcpart}--; my $new = new FS::cust_svc { $cust_svc->hash }; $new->pkgnum($dest_pkgnum); @@ -2797,6 +3401,207 @@ sub cust_pkg_discount_active { grep { $_->status eq 'active' } $self->cust_pkg_discount; } +=item cust_pkg_usage + +Returns a list of all voice usage counters attached to this package. + +=cut + +sub cust_pkg_usage { + my $self = shift; + qsearch('cust_pkg_usage', { pkgnum => $self->pkgnum }); +} + +=item apply_usage OPTIONS + +Takes the following options: +- cdr: a call detail record (L) +- rate_detail: the rate determined for this call (L) +- minutes: the maximum number of minutes to be charged + +Finds available usage minutes for a call of this class, and subtracts +up to that many minutes from the usage pool. If the usage pool is empty, +and the C global config option is set, minutes may +be taken from other calls as well. Either way, an allocation record will +be created (L) and this method will return the +number of minutes of usage applied to the call. + +=cut + +sub apply_usage { + my ($self, %opt) = @_; + my $cdr = $opt{cdr}; + my $rate_detail = $opt{rate_detail}; + my $minutes = $opt{minutes}; + my $classnum = $rate_detail->classnum; + my $pkgnum = $self->pkgnum; + my $custnum = $self->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; + my $order = FS::Conf->new->config('cdr-minutes_priority'); + + my $is_classnum; + if ( $classnum ) { + $is_classnum = ' part_pkg_usage_class.classnum = '.$classnum; + } else { + $is_classnum = ' part_pkg_usage_class.classnum IS NULL'; + } + my @usage_recs = qsearch({ + 'table' => 'cust_pkg_usage', + 'addl_from' => ' JOIN part_pkg_usage USING (pkgusagepart)'. + ' JOIN cust_pkg USING (pkgnum)'. + ' JOIN part_pkg_usage_class USING (pkgusagepart)', + 'select' => 'cust_pkg_usage.*', + 'extra_sql' => " WHERE ( cust_pkg.pkgnum = $pkgnum OR ". + " ( cust_pkg.custnum = $custnum AND ". + " part_pkg_usage.shared IS NOT NULL ) ) AND ". + $is_classnum . ' AND '. + " cust_pkg_usage.minutes > 0", + 'order_by' => " ORDER BY priority ASC", + }); + + my $orig_minutes = $minutes; + my $error; + while (!$error and $minutes > 0 and @usage_recs) { + my $cust_pkg_usage = shift @usage_recs; + $cust_pkg_usage->select_for_update; + my $cdr_cust_pkg_usage = FS::cdr_cust_pkg_usage->new({ + pkgusagenum => $cust_pkg_usage->pkgusagenum, + acctid => $cdr->acctid, + minutes => min($cust_pkg_usage->minutes, $minutes), + }); + $cust_pkg_usage->set('minutes', + sprintf('%.0f', $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes) + ); + $error = $cust_pkg_usage->replace || $cdr_cust_pkg_usage->insert; + $minutes -= $cdr_cust_pkg_usage->minutes; + } + if ( $order and $minutes > 0 and !$error ) { + # then try to steal minutes from another call + my %search = ( + 'table' => 'cdr_cust_pkg_usage', + 'addl_from' => ' JOIN cust_pkg_usage USING (pkgusagenum)'. + ' JOIN part_pkg_usage USING (pkgusagepart)'. + ' JOIN cust_pkg USING (pkgnum)'. + ' JOIN part_pkg_usage_class USING (pkgusagepart)'. + ' JOIN cdr USING (acctid)', + 'select' => 'cdr_cust_pkg_usage.*', + 'extra_sql' => " WHERE cdr.freesidestatus = 'rated' AND ". + " ( cust_pkg.pkgnum = $pkgnum OR ". + " ( cust_pkg.custnum = $custnum AND ". + " part_pkg_usage.shared IS NOT NULL ) ) AND ". + " part_pkg_usage_class.classnum = $classnum", + 'order_by' => ' ORDER BY part_pkg_usage.priority ASC', + ); + if ( $order eq 'time' ) { + # find CDRs that are using minutes, but have a later startdate + # than this call + my $startdate = $cdr->startdate; + if ($startdate !~ /^\d+$/) { + die "bad cdr startdate '$startdate'"; + } + $search{'extra_sql'} .= " AND cdr.startdate > $startdate"; + # minimize needless reshuffling + $search{'order_by'} .= ', cdr.startdate DESC'; + } else { + # XXX may not work correctly with rate_time schedules. Could + # fix this by storing ratedetailnum in cdr_cust_pkg_usage, I + # think... + $search{'addl_from'} .= + ' JOIN rate_detail'. + ' ON (cdr.rated_ratedetailnum = rate_detail.ratedetailnum)'; + if ( $order eq 'rate_high' ) { + $search{'extra_sql'} .= ' AND rate_detail.min_charge < '. + $rate_detail->min_charge; + $search{'order_by'} .= ', rate_detail.min_charge ASC'; + } elsif ( $order eq 'rate_low' ) { + $search{'extra_sql'} .= ' AND rate_detail.min_charge > '. + $rate_detail->min_charge; + $search{'order_by'} .= ', rate_detail.min_charge DESC'; + } else { + # this should really never happen + die "invalid cdr-minutes_priority value '$order'\n"; + } + } + my @cdr_usage_recs = qsearch(\%search); + my %reproc_cdrs; + while (!$error and @cdr_usage_recs and $minutes > 0) { + my $cdr_cust_pkg_usage = shift @cdr_usage_recs; + my $cust_pkg_usage = $cdr_cust_pkg_usage->cust_pkg_usage; + my $old_cdr = $cdr_cust_pkg_usage->cdr; + $reproc_cdrs{$old_cdr->acctid} = $old_cdr; + $cdr_cust_pkg_usage->select_for_update; + $old_cdr->select_for_update; + $cust_pkg_usage->select_for_update; + # in case someone else stole the usage from this CDR + # while waiting for the lock... + next if $old_cdr->acctid != $cdr_cust_pkg_usage->acctid; + # steal the usage allocation and flag the old CDR for reprocessing + $cdr_cust_pkg_usage->set('acctid', $cdr->acctid); + # if the allocation is more minutes than we need, adjust it... + my $delta = $cdr_cust_pkg_usage->minutes - $minutes; + if ( $delta > 0 ) { + $cdr_cust_pkg_usage->set('minutes', $minutes); + $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $delta); + $error = $cust_pkg_usage->replace; + } + #warn 'CDR '.$cdr->acctid . ' stealing allocation '.$cdr_cust_pkg_usage->cdrusagenum.' from CDR '.$old_cdr->acctid."\n"; + $error ||= $cdr_cust_pkg_usage->replace; + # deduct the stolen minutes + $minutes -= $cdr_cust_pkg_usage->minutes; + } + # after all minute-stealing is done, reset the affected CDRs + foreach (values %reproc_cdrs) { + $error ||= $_->set_status(''); + # XXX or should we just call $cdr->rate right here? + # it's not like we can create a loop this way, since the min_charge + # or call time has to go monotonically in one direction. + # we COULD get some very deep recursions going, though... + } + } # if $order and $minutes + if ( $error ) { + $dbh->rollback; + die "error applying included minutes\npkgnum ".$self->pkgnum.", class $classnum, acctid ".$cdr->acctid."\n$error\n" + } else { + $dbh->commit if $oldAutoCommit; + return $orig_minutes - $minutes; + } +} + +=item supplemental_pkgs + +Returns a list of all packages supplemental to this one. + +=cut + +sub supplemental_pkgs { + my $self = shift; + qsearch('cust_pkg', { 'main_pkgnum' => $self->pkgnum }); +} + +=item main_pkg + +Returns the package that this one is supplemental to, if any. + +=cut + +sub main_pkg { + my $self = shift; + if ( $self->main_pkgnum ) { + return FS::cust_pkg->by_key($self->main_pkgnum); + } + return; +} + =back =head1 CLASS METHODS @@ -2991,7 +3796,12 @@ specifies the user for agent virtualization =item fcc_line - boolean selects packages containing fcc form 477 telco lines +boolean; if true, returns only packages with more than 0 FCC phone lines. + +=item state, country + +Limit to packages with a service location in the specified state and country. +For FCC 477 reporting, mostly. =back @@ -3094,7 +3904,6 @@ sub search { } elsif ( @c_where ) { push @where, ' ( '. join(' OR ', @c_where). ' ) '; } - warn $where[-1]; } @@ -3166,8 +3975,8 @@ sub search { if ( exists($params->{'censustract'}) ) { $params->{'censustract'} =~ /^([.\d]*)$/; - my $censustract = "cust_main.censustract = '$1'"; - $censustract .= ' OR cust_main.censustract is NULL' unless $1; + my $censustract = "cust_location.censustract = '$1'"; + $censustract .= ' OR cust_location.censustract is NULL' unless $1; push @where, "( $censustract )"; } @@ -3179,10 +3988,22 @@ sub search { ) { if ($1) { - push @where, "cust_main.censustract LIKE '$1%'"; + push @where, "cust_location.censustract LIKE '$1%'"; } else { push @where, - "( cust_main.censustract = '' OR cust_main.censustract IS NULL )"; + "( cust_location.censustract = '' OR cust_location.censustract IS NULL )"; + } + } + + ### + # parse country/state + ### + for (qw(state country)) { # parsing rules are the same for these + if ( exists($params->{$_}) + && uc($params->{$_}) =~ /^([A-Z]{2})$/ ) + { + # XXX post-2.3 only--before that, state/country may be in cust_main + push @where, "cust_location.$_ = '$1'"; } } @@ -3235,7 +4056,7 @@ sub search { "NOT (".FS::cust_pkg->onetime_sql . ")"; } else { - foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) { + foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) { next unless exists($params->{$field}); @@ -3308,24 +4129,38 @@ sub search { my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : ''; - my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '. - 'LEFT JOIN part_pkg USING ( pkgpart ) '. - 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '; + my $addl_from = 'LEFT JOIN part_pkg USING ( pkgpart ) '. + 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '. + 'LEFT JOIN cust_location USING ( locationnum ) '. + FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'); - my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql"; + my $select; + my $count_query; + if ( $params->{'select_zip5'} ) { + my $zip = 'cust_location.zip'; + + $select = "DISTINCT substr($zip,1,5) as zip"; + $orderby = "ORDER BY substr($zip,1,5)"; + $count_query = "SELECT COUNT( DISTINCT substr($zip,1,5) )"; + } else { + $select = join(', ', + 'cust_pkg.*', + ( map "part_pkg.$_", qw( pkg freq ) ), + 'pkg_class.classname', + 'cust_main.custnum AS cust_main_custnum', + FS::UI::Web::cust_sql_fields( + $params->{'cust_fields'} + ), + ); + $count_query = 'SELECT COUNT(*)'; + } + + $count_query .= " FROM cust_pkg $addl_from $extra_sql"; my $sql_query = { 'table' => 'cust_pkg', 'hashref' => {}, - 'select' => join(', ', - 'cust_pkg.*', - ( map "part_pkg.$_", qw( pkg freq ) ), - 'pkg_class.classname', - 'cust_main.custnum AS cust_main_custnum', - FS::UI::Web::cust_sql_fields( - $params->{'cust_fields'} - ), - ), + 'select' => $select, 'extra_sql' => $extra_sql, 'order_by' => $orderby, 'addl_from' => $addl_from, @@ -3362,6 +4197,25 @@ sub fcc_477_count { } +=item tax_locationnum_sql + +Returns an SQL expression for the tax location for a package, based +on the settings of 'tax-pkg_address' and 'tax-ship_address'. + +=cut + +sub tax_locationnum_sql { + my $conf = FS::Conf->new; + if ( $conf->exists('tax-pkg_address') ) { + 'cust_pkg.locationnum'; + } + elsif ( $conf->exists('tax-ship_address') ) { + 'cust_main.ship_locationnum'; + } + else { + 'cust_main.bill_locationnum'; + } +} =item location_sql @@ -3380,7 +4234,13 @@ sub location_sql { # '?' placeholders in _location_sql_where my $x = $ornull ? 3 : 2; - my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' ); + my @bill_param = ( + ('district')x3, + ('city')x3, + ('county')x$x, + ('state')x$x, + 'country' + ); my $main_where; my @main_param; @@ -3439,16 +4299,19 @@ sub _location_sql_where { $ornull = $ornull ? ' OR ? IS NULL ' : ''; - my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) "; - my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) "; - my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) "; + my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL )"; + my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL )"; + my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL )"; + + my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text'; # ( $table.${prefix}city = ? $or_empty_city $ornull ) " - ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL ) - AND ( $table.${prefix}county = ? $or_empty_county $ornull ) - AND ( $table.${prefix}state = ? $or_empty_state $ornull ) - AND $table.${prefix}country = ? + ( $table.district = ? OR ? = '' OR CAST(? AS $text) IS NULL ) + AND ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS $text) IS NULL ) + AND ( $table.${prefix}county = ? $or_empty_county $ornull ) + AND ( $table.${prefix}state = ? $or_empty_state $ornull ) + AND $table.${prefix}country = ? "; } @@ -3553,11 +4416,25 @@ sub order { %hash, }; $error = $cust_pkg->insert( 'change' => $change ); + push @$return_cust_pkg, $cust_pkg; + + foreach my $link ($cust_pkg->part_pkg->supp_part_pkg_link) { + my $supp_pkg = FS::cust_pkg->new({ + custnum => $custnum, + pkgpart => $link->dst_pkgpart, + refnum => $refnum, + main_pkgnum => $cust_pkg->pkgnum, + %hash, + }); + $error ||= $supp_pkg->insert( 'change' => $change ); + push @$return_cust_pkg, $supp_pkg; + } + if ($error) { $dbh->rollback if $oldAutoCommit; return $error; } - push @$return_cust_pkg, $cust_pkg; + } # $return_cust_pkg now contains refs to all of the newly # created packages.