X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=acc73dfda74606a804f8764a867e6956895d1836;hb=8a0204b4a129a3c26dcca18ba401b2de26d22d2b;hp=4e57fbf2d9a7c49e94054295c9c298479f96d279;hpb=d1014a727cefa5d9813153594541f62ec15fc8b9;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 4e57fbf2d..acc73dfda 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,7 +1,7 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA $disable_agentcheck $DEBUG); +use vars qw(@ISA $disable_agentcheck $DEBUG $me); use Carp qw(cluck); use Scalar::Util qw( blessed ); use List::Util qw(max); @@ -25,6 +25,8 @@ use FS::reg_code; use FS::part_svc; use FS::cust_pkg_reason; use FS::reason; +use FS::cust_pkg_discount; +use FS::discount; use FS::UI::Web; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, @@ -41,6 +43,7 @@ use FS::Conf; @ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record ); $DEBUG = 0; +$me = '[FS::cust_pkg]'; $disable_agentcheck = 0; @@ -273,6 +276,14 @@ sub insert { 'params' => $self->refnum, ); + if ( $self->discountnum ) { + my $error = $self->insert_discount(); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + #if ( $self->reg_code ) { # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } ); # $error = $reg_code->delete; @@ -603,8 +614,9 @@ sub cancel { #resolved by performing a change package instead (which unprovisions) and #later cancelling if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) { + my $copy = $self->new({$self->hash}); my $error = - $self->cust_main->bill( pkg_list => [ $self ], cancel => 1 ); + $copy->cust_main->bill( pkg_list => [ $copy ], cancel => 1 ); warn "Error billing during cancel, custnum ". #$self->cust_main->custnum. ": $error" ": $error" @@ -1206,11 +1218,21 @@ sub change { #Good to go, cancel old package. $error = $self->cancel( quiet=>1 ); if ($error) { - $dbh->rollback; + $dbh->rollback if $oldAutoCommit; return $error; } + if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) { + #$self->cust_main + my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + $cust_pkg; } @@ -1523,8 +1545,11 @@ sub h_cust_svc { sub _sort_cust_svc { my( $self, $arrayref ) = @_; + my $sort = + sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }; + map { $_->[0] } - sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] } + sort $sort map { my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart, 'svcpart' => $_->svcpart } ); @@ -1880,7 +1905,18 @@ sub _labels_short { if ( $num > $max_same_services ) { push @labels, "$label ($num)"; } else { - push @labels, map { "$label: $_" } @values; + if ( $conf->exists('cust_bill-consolidate_services') ) { + # push @labels, "$label: ". join(', ', @values); + while ( @values ) { + my $detail = "$label: "; + $detail .= shift(@values). ', ' + while @values && length($detail.$values[0]) < 78; + $detail =~ s/, $//; + push @labels, $detail; + } + } else { + push @labels, map { "$label: $_" } @values; + } } } @@ -1923,6 +1959,18 @@ sub cust_location_or_main { $self->cust_location || $self->cust_main; } +=item location_label [ OPTION => VALUE ... ] + +Returns the label of the location object (see L). + +=cut + +sub location_label { + my $self = shift; + my $object = $self->cust_location_or_main; + $object->location_label(@_); +} + =item seconds_since TIMESTAMP Returns the number of seconds all accounts (see L) in this @@ -2173,6 +2221,179 @@ sub reexport { } +=item insert_reason + +Associates this package with a (suspension or cancellation) reason (see +L, possibly inserting a new reason on the fly (see +L). + +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_otaker + +the access_user (see L) providing the reason + +=item date + +a unix timestamp + +=item action + +the action (cancel, susp, adjourn, expire) associated with the reason + +=back + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_reason { + my ($self, %options) = @_; + + my $otaker = $options{reason_otaker} || + $FS::CurrentUser::CurrentUser->username; + + my $reasonnum; + if ( $options{'reason'} =~ /^(\d+)$/ ) { + + $reasonnum = $1; + + } elsif ( ref($options{'reason'}) ) { + + return 'Enter a new reason (or select an existing one)' + unless $options{'reason'}->{'reason'} !~ /^\s*$/; + + my $reason = new FS::reason({ + 'reason_type' => $options{'reason'}->{'typenum'}, + 'reason' => $options{'reason'}->{'reason'}, + }); + my $error = $reason->insert; + return $error if $error; + + $reasonnum = $reason->reasonnum; + + } else { + return "Unparsable reason: ". $options{'reason'}; + } + + my $cust_pkg_reason = + new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum, + 'reasonnum' => $reasonnum, + 'otaker' => $otaker, + 'action' => substr(uc($options{'action'}),0,1), + 'date' => $options{'date'} + ? $options{'date'} + : time, + }); + + $cust_pkg_reason->insert; +} + +=item insert_discount + +Associates this package with a discount (see L, possibly +inserting a new discount on the fly (see L). + +Available options are: + +=over 4 + +=item discountnum + +=back + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_discount { + #my ($self, %options) = @_; + my $self = shift; + + my $cust_pkg_discount = new FS::cust_pkg_discount { + 'pkgnum' => $self->pkgnum, + 'discountnum' => $self->discountnum, + 'months_used' => 0, + 'end_date' => '', #XXX + 'otaker' => $self->otaker, + #for the create a new discount case + '_type' => $self->discountnum__type, + 'amount' => $self->discountnum_amount, + 'percent' => $self->discountnum_percent, + 'months' => $self->discountnum_months, + #'disabled' => $self->discountnum_disabled, + }; + + $cust_pkg_discount->insert; +} + +=item set_usage USAGE_VALUE_HASHREF + +USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts +to which they should be set (see L). Currently seconds, +upbytes, downbytes, and totalbytes are appropriate keys. + +All svc_accts which are part of this package have their values reset. + +=cut + +sub set_usage { + my ($self, $valueref, %opt) = @_; + + foreach my $cust_svc ($self->cust_svc){ + my $svc_x = $cust_svc->svc_x; + $svc_x->set_usage($valueref, %opt) + if $svc_x->can("set_usage"); + } +} + +=item recharge USAGE_VALUE_HASHREF + +USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts +to which they should be set (see L). Currently seconds, +upbytes, downbytes, and totalbytes are appropriate keys. + +All svc_accts which are part of this package have their values incremented. + +=cut + +sub recharge { + my ($self, $valueref) = @_; + + foreach my $cust_svc ($self->cust_svc){ + my $svc_x = $cust_svc->svc_x; + $svc_x->recharge($valueref) + if $svc_x->can("recharge"); + } +} + +=item cust_pkg_discount + +=cut + +sub cust_pkg_discount { + my $self = shift; + qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } ); +} + +=item cust_pkg_discount_active + +=cut + +sub cust_pkg_discount_active { + my $self = shift; + grep { my $d = $_->discount; + ! $d->months || $_->months_used < $d->months; # XXX also end date + } + $self->cust_pkg_discount; +} + =back =head1 CLASS METHODS @@ -2209,6 +2430,7 @@ Returns an SQL expression identifying active packages. sub active_sql { " ". $_[0]->recurring_sql(). " + AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) "; } @@ -2268,7 +2490,7 @@ sub cancel_sql { "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"; } -=item search_sql HASHREF +=item search HASHREF (Class method) @@ -2341,7 +2563,7 @@ specifies the user for agent virtualization =cut -sub search_sql { +sub search { my ($class, $params) = @_; my @where = (); @@ -2355,6 +2577,15 @@ sub search_sql { } ## + # parse custnum + ## + + if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) { + push @where, + "cust_pkg.custnum = $1"; + } + + ## # parse status ## @@ -2363,8 +2594,8 @@ sub search_sql { push @where, FS::cust_pkg->active_sql(); - } elsif ( $params->{'magic'} eq 'not yet billed' - || $params->{'status'} eq 'not yet billed' ) { + } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/ + || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) { push @where, FS::cust_pkg->not_yet_billed_sql(); @@ -2398,7 +2629,7 @@ sub search_sql { { $classnum = $1; if ( $classnum ) { #a specific class - push @where, "classnum = $classnum"; + push @where, "part_pkg.classnum = $classnum"; #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) ); #die "classnum $classnum not found!" unless $pkg_class[0]; @@ -2406,7 +2637,7 @@ sub search_sql { } elsif ( $classnum eq '' ) { #the empty class - push @where, "classnum IS NULL"; + push @where, "part_pkg.classnum IS NULL"; #$title .= 'Empty class '; #@pkg_class = ( '(empty class)' ); } elsif ( $classnum eq '0' ) { @@ -2476,7 +2707,7 @@ sub search_sql { @pkgpart = grep /^(\d+)$/, @pkgpart; - push @where, 'pkgpart IN ('. join(',', @pkgpart). ')'; + push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart); } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) { push @where, "pkgpart = $1"; @@ -2561,10 +2792,10 @@ sub search_sql { if ($access_user) { push @where, $access_user->agentnums_sql('table'=>'cust_main'); - }else{ + } else { push @where, "1=0"; } - }else{ + } else { push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main'); } @@ -2572,7 +2803,7 @@ sub search_sql { my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '. 'LEFT JOIN part_pkg USING ( pkgpart ) '. - 'LEFT JOIN pkg_class USING ( classnum ) '; + 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '; my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql"; @@ -2583,7 +2814,7 @@ sub search_sql { 'cust_pkg.*', ( map "part_pkg.$_", qw( pkg freq ) ), 'pkg_class.classname', - 'cust_main.custnum as cust_main_custnum', + 'cust_main.custnum AS cust_main_custnum', FS::UI::Web::cust_sql_fields( $params->{'cust_fields'} ), @@ -2611,13 +2842,8 @@ sub location_sql { my $conf = new FS::Conf; # '?' placeholders in _location_sql_where - my @bill_param; - if ( $ornull ) { - @bill_param = qw( county county state state state country ); - } else { - @bill_param = qw( county state state country ); - } - unshift @bill_param, 'county'; # unless $nec; + my $x = $ornull ? 3 : 2; + my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' ); my $main_where; my @main_param; @@ -2676,11 +2902,14 @@ 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 ) "; +# ( $table.${prefix}city = ? $or_empty_city $ornull ) " - ( $table.${prefix}county = ? $or_empty_county $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 = ? "; @@ -2736,6 +2965,9 @@ sub order { # my $cust_main = qsearchs('cust_main', { custnum => $custnum }); # return "Customer not found: $custnum" unless $cust_main; + warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n" + if $DEBUG; + my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) } @$remove_pkgnum; @@ -2744,6 +2976,10 @@ sub order { my %hash = (); if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) { + warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum. + " to pkgpart ". $pkgparts->[0]. "\n" + if $DEBUG; + my $err_or_cust_pkg = $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0], 'refnum' => $refnum, @@ -2755,12 +2991,16 @@ sub order { } push @$return_cust_pkg, $err_or_cust_pkg; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; return ''; } # Create the new packages. foreach my $pkgpart (@$pkgparts) { + + warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG; + my $cust_pkg = new FS::cust_pkg { custnum => $custnum, pkgpart => $pkgpart, refnum => $refnum, @@ -2779,6 +3019,9 @@ sub order { # Transfer services and cancel old packages. foreach my $old_pkg (@old_cust_pkg) { + warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n" + if $DEBUG; + foreach my $new_pkg (@$return_cust_pkg) { $error = $old_pkg->transfer($new_pkg); if ($error and $error == 0) { @@ -2877,120 +3120,6 @@ sub bulk_change { ''; } -=item insert_reason - -Associates this package with a (suspension or cancellation) reason (see -L, possibly inserting a new reason on the fly (see -L). - -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_otaker - -the access_user (see L) providing the reason - -=item date - -a unix timestamp - -=item action - -the action (cancel, susp, adjourn, expire) associated with the reason - -=back - -If there is an error, returns the error, otherwise returns false. - -=cut - -sub insert_reason { - my ($self, %options) = @_; - - my $otaker = $options{reason_otaker} || - $FS::CurrentUser::CurrentUser->username; - - my $reasonnum; - if ( $options{'reason'} =~ /^(\d+)$/ ) { - - $reasonnum = $1; - - } elsif ( ref($options{'reason'}) ) { - - return 'Enter a new reason (or select an existing one)' - unless $options{'reason'}->{'reason'} !~ /^\s*$/; - - my $reason = new FS::reason({ - 'reason_type' => $options{'reason'}->{'typenum'}, - 'reason' => $options{'reason'}->{'reason'}, - }); - my $error = $reason->insert; - return $error if $error; - - $reasonnum = $reason->reasonnum; - - } else { - return "Unparsable reason: ". $options{'reason'}; - } - - my $cust_pkg_reason = - new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum, - 'reasonnum' => $reasonnum, - 'otaker' => $otaker, - 'action' => substr(uc($options{'action'}),0,1), - 'date' => $options{'date'} - ? $options{'date'} - : time, - }); - - $cust_pkg_reason->insert; -} - -=item set_usage USAGE_VALUE_HASHREF - -USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts -to which they should be set (see L). Currently seconds, -upbytes, downbytes, and totalbytes are appropriate keys. - -All svc_accts which are part of this package have their values reset. - -=cut - -sub set_usage { - my ($self, $valueref, %opt) = @_; - - foreach my $cust_svc ($self->cust_svc){ - my $svc_x = $cust_svc->svc_x; - $svc_x->set_usage($valueref, %opt) - if $svc_x->can("set_usage"); - } -} - -=item recharge USAGE_VALUE_HASHREF - -USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts -to which they should be set (see L). Currently seconds, -upbytes, downbytes, and totalbytes are appropriate keys. - -All svc_accts which are part of this package have their values incremented. - -=cut - -sub recharge { - my ($self, $valueref) = @_; - - foreach my $cust_svc ($self->cust_svc){ - my $svc_x = $cust_svc->svc_x; - $svc_x->recharge($valueref) - if $svc_x->can("recharge"); - } -} - =back =head1 BUGS