X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=0c39f6868e5446435196636e7073103eff7bed44;hb=c6eb405f6134173bc8306f45ddc697affa14123f;hp=1f1ae4090d77fa9bcefd26a7f55707f3edbcd572;hpb=a5a258c91c5dc78897d16627b8092385ceb4c4d2;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 1f1ae4090..0c39f6868 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -11,6 +11,7 @@ use FS::cust_main; use FS::type_pkgs; use FS::pkg_svc; use FS::cust_bill_pkg; +use FS::h_cust_svc; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, # setup } @@ -140,7 +141,7 @@ Create a new billing item. To add the item to the database, see L<"insert">. sub table { 'cust_pkg'; } -=item insert +=item insert [ OPTION => VALUE ... ] Adds this billing item to the database ("Orders" the item). If there is an error, returns the error, otherwise returns false. @@ -149,6 +150,73 @@ If the additional field I is defined instead of I, it will be used to look up the package definition and agent restrictions will be ignored. +The following options are available: I + +I, if set true, supresses any referral credit to a referring customer. + +=cut + +sub insert { + my( $self, %options ) = @_; + + 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 $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my $conf = new FS::Conf; + my $cust_main = $self->cust_main; + my $part_pkg = $self->part_pkg; + if ( $conf->exists('referral_credit') + && $cust_main->referral_custnum + && ! $options{'change'} + && $part_pkg->freq !~ /^0\D?$/ + ) + { + my $referring_cust_main = $cust_main->referring_cust_main; + if ( $referring_cust_main->status ne 'cancelled' ) { + my $error; + if ( $part_pkg->freq !~ /^\d+$/ ) { + warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum. + ' for package '. $self->pkgnum. + ' ( customer '. $self->custnum. ')'. + ' - One-time referral credits not (yet) available for '. + ' packages with '. $part_pkg->freq_pretty. ' frequency'; + } else { + + my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq ); + my $error = + $referring_cust_main->credit( $amount, + 'Referral credit for '. $cust_main->name + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error crediting customer ". $cust_main->referral_custnum. + " for referral: $error"; + } + + } + + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item delete This method now works but you probably shouldn't use it. @@ -194,6 +262,8 @@ sub replace { #some logic for bill, susp, cancel? + local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart; + $new->SUPER::replace($old); } @@ -306,6 +376,16 @@ sub cancel { } } + # Add a credit for remaining service + my $remaining_value= $self->calc_remain(); + if ($remaining_value > 0) { + my $error = $self->credit($remaining_value, 'Credit for service remaining'); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return "Error crediting customer for service remaining: $error"; + } + } + unless ( $self->getfield('cancel') ) { my %hash = $self->hash; $hash{'cancel'} = time; @@ -522,6 +602,30 @@ sub calc_recur { $self->part_pkg->calc_recur($self, @_); } +=item calc_remain + +Calls the I of the FS::part_pkg object associated with this +billing item. + +=cut + +sub calc_remain { + my $self = shift; + $self->part_pkg->calc_remain($self, @_); +} + +=item calc_cancel + +Calls the I of the FS::part_pkg object associated with this +billing item. + +=cut + +sub calc_cancel { + my $self = shift; + $self->part_pkg->calc_cancel($self, @_); +} + =item cust_svc [ SVCPART ] Returns the services for this package, as FS::cust_svc objects (see @@ -541,21 +645,50 @@ sub cust_svc { #if ( $self->{'_svcnum'} ) { # values %{ $self->{'_svcnum'}->cache }; #} else { - map { $_->[0] } - sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] } - map { - my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart, - 'svcpart' => $_->svcpart } ); - [ $_, - $pkg_svc ? $pkg_svc->primary_svc : '', - $pkg_svc ? $pkg_svc->quantity : 0, - ]; - } - qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ); + $self->_sort_cust_svc( + [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ] + ); #} } +=item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] + +Returns historical services for this package created before END TIMESTAMP and +(optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects +(see L). + +=cut + +sub h_cust_svc { + my $self = shift; + + $self->_sort_cust_svc( + [ qsearch( 'h_cust_svc', + { 'pkgnum' => $self->pkgnum, }, + FS::h_cust_svc->sql_h_search(@_), + ) + ] + ); +} + +sub _sort_cust_svc { + my( $self, $arrayref ) = @_; + + map { $_->[0] } + sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] } + map { + my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart, + 'svcpart' => $_->svcpart } ); + [ $_, + $pkg_svc ? $pkg_svc->primary_svc : '', + $pkg_svc ? $pkg_svc->quantity : 0, + ]; + } + @$arrayref; + +} + =item num_cust_svc [ SVCPART ] Returns the number of provisioned services for this package. If a svcpart is @@ -604,6 +737,52 @@ sub labels { map { [ $_->label ] } $self->cust_svc; } +=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] + +Like the labels method, but returns historical information on services that +were active as of END_TIMESTAMP and (optionally) not cancelled before +START_TIMESTAMP. + +Returns a list of lists, calling the label method for all (historical) services +(see L) of this billing item. + +=cut + +sub h_labels { + my $self = shift; + map { [ $_->label(@_) ] } $self->h_cust_svc(@_); +} + +=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ] + +Like h_labels, except returns a simple flat list, and shortens long +(currently >5) lists of identical services to one line that lists the service +label and the number of individual services rather than individual items. + +=cut + +sub h_labels_short { + my $self = shift; + + my %labels; + #tie %labels, 'Tie::IxHash'; + push @{ $labels{$_->[0]} }, $_->[1] + foreach $self->h_labels(@_); + my @labels; + foreach my $label ( keys %labels ) { + my @values = @{ $labels{$label} }; + my $num = scalar(@values); + if ( $num > 5 ) { + push @labels, "$label ($num)"; + } else { + push @labels, map { "$label: $_" } @values; + } + } + + @labels; + +} + =item cust_main Returns the parent customer object (see L). @@ -904,12 +1083,13 @@ sub order { my $cust_main = qsearchs('cust_main', { custnum => $custnum }); return "Customer not found: $custnum" unless $cust_main; + my $change = scalar(@$remove_pkgnum) != 0; + # Create the new packages. - my $cust_pkg; - foreach (@$pkgparts) { - $cust_pkg = new FS::cust_pkg { custnum => $custnum, - pkgpart => $_ }; - $error = $cust_pkg->insert; + foreach my $pkgpart (@$pkgparts) { + my $cust_pkg = new FS::cust_pkg { custnum => $custnum, + pkgpart => $pkgpart }; + $error = $cust_pkg->insert( 'change' => $change ); if ($error) { $dbh->rollback if $oldAutoCommit; return $error;