X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=20e3d449d18a46863fa33042866aa3d201dc7796;hb=b55fb5df35587a35be4c347073364c132970a533;hp=bec0cf1199f0748f2f9232df322dccb9178771f3;hpb=3d60ed3b43a33b67311c5ec9840312fc7871a6d2;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index bec0cf119..20e3d449d 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -8,7 +8,7 @@ use Carp qw(cluck); use Scalar::Util qw( blessed ); use List::Util qw(max); use Tie::IxHash; -use Time::Local qw( timelocal_nocheck ); +use Time::Local qw( timelocal timelocal_nocheck ); use MIME::Entity; use FS::UID qw( getotaker dbh ); use FS::Misc qw( send_email ); @@ -30,6 +30,7 @@ use FS::reason; use FS::cust_pkg_discount; use FS::discount; use FS::UI::Web; +use Data::Dumper; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, # setup } @@ -194,6 +195,8 @@ Previous pkgpart Previous locationnum +=item waive_setup + =back Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date @@ -260,7 +263,12 @@ an optional queue name for ticket additions sub insert { my( $self, %options ) = @_; - if ( $self->part_pkg->option('start_1st', 1) && !$self->start_date ) { + my $error = $self->check_pkgpart; + return $error if $error; + + my $part_pkg = $self->part_pkg; + + if ( $part_pkg->option('start_1st', 1) && !$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++; } @@ -268,13 +276,21 @@ sub insert { } foreach my $action ( qw(expire adjourn contract_end) ) { - my $months = $self->part_pkg->option("${action}_months",1); + my $months = $part_pkg->option("${action}_months",1); if($months and !$self->$action) { my $start = $self->start_date || $self->setup || time; - $self->$action( $self->part_pkg->add_freq($start, $months) ); + $self->$action( $part_pkg->add_freq($start, $months) ); } } + my $free_days = $part_pkg->option('free_days'); + if ( $free_days && $part_pkg->option('delay_setup',1) ) { #&& !$self->start_date + my ($mday,$mon,$year) = (localtime(time) )[3,4,5]; + #my $start_date = ($self->start_date || timelocal(0,0,0,$mday,$mon,$year)) + 86400 * $free_days; + my $start_date = timelocal(0,0,0,$mday,$mon,$year) + 86400 * $free_days; + $self->start_date($start_date); + } + $self->order_date(time); local $SIG{HUP} = 'IGNORE'; @@ -288,7 +304,7 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ()); + $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ()); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -581,6 +597,7 @@ sub check { $self->ut_numbern('pkgnum') || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') || $self->ut_numbern('pkgpart') + || $self->check_pkgpart || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum') || $self->ut_numbern('start_date') || $self->ut_numbern('setup') @@ -589,10 +606,40 @@ sub check { || $self->ut_numbern('cancel') || $self->ut_numbern('adjourn') || $self->ut_numbern('expire') + || $self->ut_numbern('dundate') || $self->ut_enum('no_auto', [ '', 'Y' ]) + || $self->ut_enum('waive_setup', [ '', 'Y' ]) + || $self->ut_numbern('agent_pkgid') + || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ]) + || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ]) ; 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; + + $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum; + + if ( $self->dbdef_table->column('manual_flag') ) { + $self->manual_flag('') if $self->manual_flag eq ' '; + $self->manual_flag =~ /^([01]?)$/ + or return "Illegal manual_flag ". $self->manual_flag; + $self->manual_flag($1); + } + + $self->SUPER::check; +} + +=item check_pkgpart + +=cut + +sub check_pkgpart { + my $self = shift; + + my $error = $self->ut_numbern('pkgpart'); + return $error if $error; + if ( $self->reg_code ) { unless ( grep { $self->pkgpart == $_->pkgpart } @@ -628,16 +675,8 @@ sub check { } - $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum; - - if ( $self->dbdef_table->column('manual_flag') ) { - $self->manual_flag('') if $self->manual_flag eq ' '; - $self->manual_flag =~ /^([01]?)$/ - or return "Illegal manual_flag ". $self->manual_flag; - $self->manual_flag($1); - } + ''; - $self->SUPER::check; } =item cancel [ OPTION => VALUE ... ] @@ -730,72 +769,59 @@ sub cancel { } } - my %svc; - if ( $date ) { -# copied from below - foreach my $cust_svc ( - #schwartz - map { $_->[0] } - sort { $a->[1] <=> $b->[1] } - map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; } - qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) - ) { - my $error = $cust_svc->cancel( ('date' => $date) ); + my %svc_cancel_opt = (); + $svc_cancel_opt{'date'} = $date if $date; + foreach my $cust_svc ( + #schwartz + map { $_->[0] } + sort { $a->[1] <=> $b->[1] } + map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; } + qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) + ) { + my $part_svc = $cust_svc->part_svc; + next if ( defined($part_svc) and $part_svc->preserve ); + my $error = $cust_svc->cancel( %svc_cancel_opt ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error expiring cust_svc: $error"; - } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return 'Error '. ($svc_cancel_opt{'date'} ? 'expiring' : 'canceling' ). + " cust_svc: $error"; } - } else { #!date - foreach my $cust_svc ( - #schwartz - map { $_->[0] } - sort { $a->[1] <=> $b->[1] } - map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; } - qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) - ) { - my $error = $cust_svc->cancel; + } - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error cancelling cust_svc: $error"; - } + unless ($date) { + + # Add a credit for remaining service + my $last_bill = $self->getfield('last_bill') || 0; + my $next_bill = $self->getfield('bill') || 0; + my $do_credit; + if ( exists($options{'unused_credit'}) ) { + $do_credit = $options{'unused_credit'}; + } + else { + $do_credit = $self->part_pkg->option('unused_credit_cancel', 1); } - } #if $date + if ( $do_credit + and $last_bill > 0 # the package has been billed + and $next_bill > 0 # the package has a next bill date + and $next_bill >= $cancel_time # which is in the future + ) { + my $remaining_value = $self->calc_remain('time' => $cancel_time); + if ( $remaining_value > 0 ) { + my $error = $self->cust_main->credit( + $remaining_value, + 'Credit for unused time on '. $self->part_pkg->pkg, + 'reason_type' => $conf->config('cancel_credit_type'), + ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return "Error crediting customer \$$remaining_value for unused time". + " on ". $self->part_pkg->pkg. ": $error"; + } + } #if $remaining_value + } #if $do_credit - # Add a credit for remaining service - my $last_bill = $self->getfield('last_bill') || 0; - my $next_bill = $self->getfield('bill') || 0; - my $do_credit; - if ( exists($options{'unused_credit'}) ) { - $do_credit = $options{'unused_credit'}; - } - else { - $do_credit = $self->part_pkg->option('unused_credit_cancel', 1); - } - if ( $do_credit - and $last_bill > 0 # the package has been billed - and $next_bill > 0 # the package has a next bill date - and $next_bill >= $cancel_time # which is in the future - ) { - my $remaining_value = $self->calc_remain('time' => $cancel_time); - if ( $remaining_value > 0 ) { - # && !$options{'no_credit'} ) { - # Undocumented, unused option. - # part_pkg configuration should decide this anyway. - my $error = $self->cust_main->credit( - $remaining_value, - 'Credit for unused time on '. $self->part_pkg->pkg, - 'reason_type' => $conf->config('cancel_credit_type'), - ); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return "Error crediting customer \$$remaining_value for unused time on". - $self->part_pkg->pkg. ": $error"; - } - } #if $remaining_value - } #if $do_credit + } #unless $date my %hash = $self->hash; $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time); @@ -1404,7 +1430,6 @@ sub change { } -use Data::Dumper; use Storable 'thaw'; use MIME::Base64; sub process_bulk_cust_pkg { @@ -1766,6 +1791,9 @@ I flag will be omitted. sub h_cust_svc { my $self = shift; + warn "$me _h_cust_svc called on $self\n" + if $DEBUG; + my ($end, $start, $mode) = @_; my @cust_svc = $self->_sort_cust_svc( [ qsearch( 'h_cust_svc', @@ -1773,11 +1801,10 @@ sub h_cust_svc { FS::h_cust_svc->sql_h_search(@_), ) ] ); - if ( $mode eq 'I' ) { + if ( defined($mode) && $mode eq 'I' ) { my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc; return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc; - } - else { + } else { return @cust_svc; } } @@ -1920,7 +1947,7 @@ sub extra_part_svc { my $self = shift; my $pkgnum = $self->pkgnum; - my $pkgpart = $self->pkgpart; + #my $pkgpart = $self->pkgpart; # qsearch( { # 'table' => 'part_svc', @@ -1939,23 +1966,27 @@ sub extra_part_svc { # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ], # } ); -#seems to benchmark slightly faster... +#seems to benchmark slightly faster... (or did?) + + my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked; + my $pkgparts = join(',', @pkgparts); + qsearch( { #'select' => 'DISTINCT ON (svcpart) part_svc.*', #MySQL doesn't grok DISINCT ON 'select' => 'DISTINCT part_svc.*', 'table' => 'part_svc', 'addl_from' => - 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart - AND pkg_svc.pkgpart = ? + "LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart + AND pkg_svc.pkgpart IN ($pkgparts) AND quantity > 0 ) LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart ) LEFT JOIN cust_pkg USING ( pkgnum ) - ', + ", 'hashref' => {}, 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ", - 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ], + 'extra_param' => [ [$self->pkgnum=>'int'] ], } ); } @@ -2119,6 +2150,8 @@ Returns a list of lists, calling the label method for all (historical) services sub h_labels { my $self = shift; + warn "$me _h_labels called on $self\n" + if $DEBUG; map { [ $_->label(@_) ] } $self->h_cust_svc(@_); } @@ -2151,31 +2184,53 @@ sub h_labels_short { sub _labels_short { my( $self, $method ) = ( shift, shift ); + warn "$me _labels_short called on $self with $method method\n" + if $DEBUG; + my $conf = new FS::Conf; my $max_same_services = $conf->config('cust_bill-max_same_services') || 5; + warn "$me _labels_short populating \%labels\n" + if $DEBUG; + my %labels; #tie %labels, 'Tie::IxHash'; push @{ $labels{$_->[0]} }, $_->[1] foreach $self->$method(@_); + + warn "$me _labels_short populating \@labels\n" + if $DEBUG; + my @labels; foreach my $label ( keys %labels ) { my %seen = (); my @values = grep { ! $seen{$_}++ } @{ $labels{$label} }; my $num = scalar(@values); + warn "$me _labels_short $num items for $label\n" + if $DEBUG; + if ( $num > $max_same_services ) { + warn "$me _labels_short more than $max_same_services, so summarizing\n" + if $DEBUG; push @labels, "$label ($num)"; } else { if ( $conf->exists('cust_bill-consolidate_services') ) { + warn "$me _labels_short consolidating services\n" + if $DEBUG; # push @labels, "$label: ". join(', ', @values); while ( @values ) { my $detail = "$label: "; $detail .= shift(@values). ', ' - while @values && length($detail.$values[0]) < 78; + while @values + && ( length($detail.$values[0]) < 78 || $detail eq "$label: " ); $detail =~ s/, $//; push @labels, $detail; } + warn "$me _labels_short done consolidating services\n" + if $DEBUG; } else { + warn "$me _labels_short adding service data\n" + if $DEBUG; push @labels, map { "$label: $_" } @values; } } @@ -2570,6 +2625,7 @@ sub insert_discount { 'amount' => $self->discountnum_amount, 'percent' => $self->discountnum_percent, 'months' => $self->discountnum_months, + 'setup' => $self->discountnum_setup, #'disabled' => $self->discountnum_disabled, }; @@ -2900,45 +2956,56 @@ sub search { # parse package class ### - #false lazinessish w/graph/cust_bill_pkg.cgi - my $classnum = 0; - my @pkg_class = (); - if ( exists($params->{'classnum'}) - && $params->{'classnum'} =~ /^(\d*)$/ - ) - { - $classnum = $1; - if ( $classnum ) { #a specific class - push @where, "part_pkg.classnum = $classnum"; - - #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) ); - #die "classnum $classnum not found!" unless $pkg_class[0]; - #$title .= $pkg_class[0]->classname.' '; - - } elsif ( $classnum eq '' ) { #the empty class - - push @where, "part_pkg.classnum IS NULL"; - #$title .= 'Empty class '; - #@pkg_class = ( '(empty class)' ); - } elsif ( $classnum eq '0' ) { - #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } ); - #push @pkg_class, '(empty class)'; - } else { - die "illegal classnum"; + if ( exists($params->{'classnum'}) ) { + + my @classnum = (); + if ( ref($params->{'classnum'}) ) { + + if ( ref($params->{'classnum'}) eq 'HASH' ) { + @classnum = grep $params->{'classnum'}{$_}, keys %{ $params->{'classnum'} }; + } elsif ( ref($params->{'classnum'}) eq 'ARRAY' ) { + @classnum = @{ $params->{'classnum'} }; + } else { + die 'unhandled classnum ref '. $params->{'classnum'}; + } + + + } elsif ( $params->{'classnum'} =~ /^(\d*)$/ && $1 ne '0' ) { + @classnum = ( $1 ); } + + if ( @classnum ) { + + my @c_where = (); + my @nums = grep $_, @classnum; + push @c_where, 'part_pkg.classnum IN ('. join(',',@nums). ')' if @nums; + my $null = scalar( grep { $_ eq '' } @classnum ); + push @c_where, 'part_pkg.classnum IS NULL' if $null; + + if ( scalar(@c_where) == 1 ) { + push @where, @c_where; + } elsif ( @c_where ) { + push @where, ' ( '. join(' OR ', @c_where). ' ) '; + } + warn $where[-1]; + + } + + } - #eslaf ### # parse package report options ### my @report_option = (); - if ( exists($params->{'report_option'}) - && $params->{'report_option'} =~ /^([,\d]*)$/ - ) - { - @report_option = split(',', $1); + if ( exists($params->{'report_option'}) ) { + if ( ref($params->{'report_option'}) eq 'ARRAY' ) { + @report_option = @{ $params->{'report_option'} }; + } elsif ( $params->{'report_option'} =~ /^([,\d]*)$/ ) { + @report_option = split(',', $1); + } + } if (@report_option) { @@ -2951,7 +3018,26 @@ sub search { } @report_option; } - #eslaf + my @report_option_any = (); + if ( exists($params->{'report_option_any'}) ) { + if ( ref($params->{'report_option_any'}) eq 'ARRAY' ) { + @report_option_any = @{ $params->{'report_option_any'} }; + } elsif ( $params->{'report_option_any'} =~ /^([,\d]*)$/ ) { + @report_option_any = split(',', $1); + } + + } + + if (@report_option_any) { + # this will result in the empty set for the dangling comma case as it should + push @where, ' ( '. join(' OR ', + map{ "0 < ( SELECT count(*) FROM part_pkg_option + WHERE part_pkg_option.pkgpart = part_pkg.pkgpart + AND optionname = 'report_option_$_' + AND optionvalue = '1' )" + } @report_option_any + ). ' ) '; + } ### # parse custom @@ -2963,7 +3049,8 @@ sub search { # parse fcc_line ### - push @where, "part_pkg.fcc_ds0s > 0" if $params->{fcc_line}; + push @where, "(part_pkg.fcc_ds0s > 0 OR pkg_class.fcc_ds0s > 0)" + if $params->{fcc_line}; ### # parse censustract @@ -2977,6 +3064,21 @@ sub search { } ### + # parse censustract2 + ### + if ( exists($params->{'censustract2'}) + && $params->{'censustract2'} =~ /^(\d*)$/ + ) + { + if ($1) { + push @where, "cust_main.censustract LIKE '$1%'"; + } else { + push @where, + "( cust_main.censustract = '' OR cust_main.censustract IS NULL )"; + } + } + + ### # parse part_pkg ### @@ -3241,6 +3343,15 @@ sub _location_sql_where { "; } +sub _X_show_zero { + my( $self, $what ) = @_; + + my $what_show_zero = $what. '_show_zero'; + length($self->$what_show_zero()) + ? ($self->$what_show_zero() eq 'Y') + : $self->part_pkg->$what_show_zero(); +} + =head1 SUBROUTINES =over 4