X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=dbce6cbf52190035249ae7fc098fa5a4b97e9085;hb=4bd9d3d9dc5325f0d7bd498e457140b15d01866c;hp=e839eb93eee8b4c81eaa11a901dea3224b3bac60;hpb=1425c9ef765b7fe350dafd5534bc70d20a6ff0ee;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index e839eb93e..dbce6cbf5 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,17 +1,19 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA $disable_agentcheck $DEBUG); +use base qw( FS::cust_main_Mixin FS::location_Mixin + FS::m2m_Common FS::option_Common FS::Record + ); +use vars qw(@ISA $disable_agentcheck $DEBUG $me); use Carp qw(cluck); use Scalar::Util qw( blessed ); use List::Util qw(max); use Tie::IxHash; +use Time::Local qw( timelocal_nocheck ); use MIME::Entity; use FS::UID qw( getotaker dbh ); use FS::Misc qw( send_email ); use FS::Record qw( qsearch qsearchs ); -use FS::m2m_Common; -use FS::cust_main_Mixin; use FS::cust_svc; use FS::part_pkg; use FS::cust_main; @@ -38,9 +40,8 @@ use FS::svc_forward; # for sending cancel emails in sub cancel 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; @@ -249,6 +250,26 @@ an optional queue name for ticket additions sub insert { my( $self, %options ) = @_; + if ( $self->part_pkg->option('start_1st') && !$self->start_date ) { + my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5]; + $mon += 1 unless $mday == 1; + until ( $mon < 12 ) { $mon -= 12; $year++; } + $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) ); + } + + my $expire_months = $self->part_pkg->option('expire_months'); + if ( $expire_months && !$self->expire ) { + my $start = $self->start_date || $self->setup || time; + + #false laziness w/part_pkg::add_freq + my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($start) )[0,1,2,3,4,5]; + $mon += $expire_months; + until ( $mon < 12 ) { $mon -= 12; $year++; } + + #$self->expire( timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year) ); + $self->expire( timelocal_nocheck(0,0,0,$mday,$mon,$year) ); + } + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -1207,11 +1228,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; } @@ -1524,8 +1555,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 } ); @@ -1881,7 +1915,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; + } } } @@ -1900,29 +1945,24 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +#these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin + =item cust_location Returns the location object, if any (see L). -=cut - -sub cust_location { - my $self = shift; - return '' unless $self->locationnum; - qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } ); -} - =item cust_location_or_main If this package is associated with a location, returns the locaiton (see L), otherwise returns the customer (see L). +=item location_label [ OPTION => VALUE ... ] + +Returns the label of the location object (see L). + =cut -sub cust_location_or_main { - my $self = shift; - $self->cust_location || $self->cust_main; -} +#end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin =item seconds_since TIMESTAMP @@ -2210,6 +2250,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 ) "; } @@ -2269,7 +2310,7 @@ sub cancel_sql { "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"; } -=item search_sql HASHREF +=item search HASHREF (Class method) @@ -2342,7 +2383,7 @@ specifies the user for agent virtualization =cut -sub search_sql { +sub search { my ($class, $params) = @_; my @where = (); @@ -2356,6 +2397,15 @@ sub search_sql { } ## + # parse custnum + ## + + if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) { + push @where, + "cust_pkg.custnum = $1"; + } + + ## # parse status ## @@ -2364,8 +2414,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(); @@ -2399,7 +2449,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]; @@ -2407,7 +2457,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' ) { @@ -2562,18 +2612,18 @@ 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'); } 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 USING ( classnum ) '; + my $addl_from = 'LEFT JOIN part_pkg USING ( pkgpart ) '. + 'LEFT JOIN pkg_class USING ( classnum ) '. + 'LEFT JOIN cust_main USING ( custnum ) '; my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql"; @@ -2737,6 +2787,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; @@ -2745,6 +2798,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, @@ -2756,12 +2813,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, @@ -2780,6 +2841,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) {