X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fpart_pkg.pm;h=ae63487ecedaa18f7e28b3f147c04db3b2e70323;hp=97bce4537443e51517ab844e90ec923175cf2489;hb=7a33cb6e4c3e33b7399d6574cbd3ee38ddcba5e0;hpb=41aef8bd93f7cc3a39056a8fd997d3072dfcdf8a diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 97bce4537..ae63487ec 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -4,7 +4,9 @@ use base qw( FS::part_pkg::API ); use strict; -use vars qw( %plans $DEBUG $setup_hack $skip_pkg_svc_hack ); +use vars qw( %plans $DEBUG $setup_hack $skip_pkg_svc_hack + $cache_enabled %cache_link %cache_pkg_svc + ); use Carp qw(carp cluck confess); use Scalar::Util qw( blessed ); use DateTime; @@ -33,9 +35,14 @@ use FS::part_pkg_currency; use FS::part_svc_link; $DEBUG = 0; + $setup_hack = 0; $skip_pkg_svc_hack = 0; +$cache_enabled = 0; +%cache_link = (); +%cache_pkg_svc = (); + =head1 NAME FS::part_pkg - Object methods for part_pkg objects @@ -728,6 +735,7 @@ sub check { || $self->ut_floatn('pay_weight') || $self->ut_floatn('credit_weight') || $self->ut_numbern('taxproductnum') + || $self->ut_numbern('units_taxproductnum') || $self->ut_foreign_keyn('classnum', 'pkg_class', 'classnum') || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum') || $self->ut_foreign_keyn('taxproductnum', @@ -763,6 +771,40 @@ sub check { ''; } +=item check_options + +For a passed I<$options> hashref, validates any options that +have 'validate' subroutines defined in the info hash, +then validates the entire hashref if the price plan has +its own 'validate' subroutine defined in the info hash +(I<$options> values might be altered.) + +Returns error message, or empty string if valid. + +Invoked by L and L via the equivalent +methods in L. + +=cut + +sub check_options { + my ($self,$options) = @_; + foreach my $option (keys %$options) { + if (exists $plans{ $self->plan }->{fields}->{$option}) { + if (exists($plans{$self->plan}->{fields}->{$option}->{'validate'})) { + # pass option name for use in error message + # pass a reference to the $options value, so it can be cleaned up + my $error = &{$plans{$self->plan}->{fields}->{$option}->{'validate'}}($option,\($options->{$option})); + return $error if $error; + } + } # else "option does not exist" error? + } + if (exists($plans{$self->plan}->{'validate'})) { + my $error = &{$plans{$self->plan}->{'validate'}}($options); + return $error if $error; + } + return ''; +} + =item check_pkg_svc Checks pkg_svc records as a whole (for part_svc_link dependencies). @@ -1104,19 +1146,19 @@ definition. sub pkg_svc { my $self = shift; + return @{ $cache_pkg_svc{$self->pkgpart} } + if $cache_enabled && $cache_pkg_svc{$self->pkgpart}; + # #sort { $b->primary cmp $a->primary } # grep { $_->quantity } # qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } ); my $opt = ref($_[0]) ? $_[0] : { @_ }; - my %pkg_svc = map { $_->svcpart => $_ } - grep { $_->quantity } - qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } ); + my %pkg_svc = map { $_->svcpart => $_ } $self->_pkg_svc; unless ( $opt->{disable_linked} ) { foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) { - my @pkg_svc = grep { $_->quantity } - qsearch( 'pkg_svc', { pkgpart=>$dst_pkg->pkgpart } ); + my @pkg_svc = $dst_pkg->_pkg_svc; foreach my $pkg_svc ( @pkg_svc ) { if ( $pkg_svc{$pkg_svc->svcpart} ) { my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity; @@ -1128,10 +1170,25 @@ sub pkg_svc { } } - values(%pkg_svc); + my @pkg_svc = values(%pkg_svc); + + $cache_pkg_svc{$self->pkgpart} = \@pkg_svc if $cache_enabled; + + @pkg_svc; } +sub _pkg_svc { + my $self = shift; + grep { $_->quantity } + qsearch({ + 'select' => 'pkg_svc.*, part_svc.*', + 'table' => 'pkg_svc', + 'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )', + 'hashref' => { 'pkgpart' => $self->pkgpart }, + }); +} + =item svcpart [ SVCDB ] Returns the svcpart of the primary service definition (see L) @@ -1402,12 +1459,10 @@ sub option { my( $self, $opt, $ornull ) = @_; #cache: was pulled up in the original part_pkg query - if ( $opt =~ /^(setup|recur)_fee$/ && defined($self->hashref->{"_$opt"}) ) { - return $self->hashref->{"_$opt"}; - } + return $self->hashref->{"_opt_$opt"} + if exists $self->hashref->{"_opt_$opt"}; - cluck "$self -> option: searching for $opt" - if $DEBUG; + cluck "$self -> option: searching for $opt" if $DEBUG; my $part_pkg_option = qsearchs('part_pkg_option', { pkgpart => $self->pkgpart, @@ -1541,14 +1596,25 @@ sub supp_part_pkg_link { sub _part_pkg_link { my( $self, $type ) = @_; - qsearch({ table => 'part_pkg_link', - hashref => { 'src_pkgpart' => $self->pkgpart, - 'link_type' => $type, - #protection against infinite recursive links - 'dst_pkgpart' => { op=>'!=', value=> $self->pkgpart }, - }, - order_by => "ORDER BY hidden", - }); + + return @{ $cache_link{$type}->{$self->pkgpart} } + if $cache_enabled && $cache_link{$type}->{$self->pkgpart}; + + cluck $type.'_part_pkg_link called' if $DEBUG; + + my @ppl = + qsearch({ table => 'part_pkg_link', + hashref => { src_pkgpart => $self->pkgpart, + link_type => $type, + #protection against infinite recursive links + dst_pkgpart => { op=>'!=', value=> $self->pkgpart }, + }, + order_by => "ORDER BY hidden", + }); + + $cache_link{$type}->{$self->pkgpart} = \@ppl if $cache_enabled; + + return @ppl; } sub self_and_bill_linked { @@ -1666,6 +1732,19 @@ sub taxproduct_description { $part_pkg_taxproduct ? $part_pkg_taxproduct->description : ''; } +=item units_taxproduct + +Returns the L record used to report the taxable +service units (usually phone lines) on this package. + +=cut + +sub units_taxproduct { + my $self = shift; + $self->units_taxproductnum + ? FS::part_pkg_taxproduct->by_key($self->units_taxproductnum) + : ''; +} =item tax_rates DATA_PROVIDER, GEOCODE, [ CLASS ] @@ -1852,13 +1931,27 @@ sub calc_remain { 0; } =item calc_units CUST_PKG This returns the number of provisioned svc_phone records, or, of the package -count_available_phones option is set, the number available to be provisoined +count_available_phones option is set, the number available to be provisioned in the package. =cut -#fallback that returns 0 for old legacy packages with no plan -sub calc_units { 0; } +sub calc_units { + my($self, $cust_pkg ) = @_; + my $count = 0; + if ( $self->option('count_available_phones', 1)) { + foreach my $pkg_svc ($cust_pkg->part_pkg->pkg_svc) { + if ($pkg_svc->part_svc->svcdb eq 'svc_phone') { # svc_pbx? + $count += $pkg_svc->quantity || 0; + } + } + $count *= $cust_pkg->quantity; + } else { + $count = + scalar(grep { $_->part_svc->svcdb eq 'svc_phone' } $cust_pkg->cust_svc); + } + $count; +} #fallback for everything not based on flat.pm sub recur_temporality { 'upcoming'; } @@ -1950,6 +2043,18 @@ sub recur_margin_permonth { $self->base_recur_permonth(@_) - $self->recur_cost_permonth(@_); } +=item intro_end PACKAGE + +Takes an L object. If this plan has an introductory rate, +returns the expected date the intro period will end. If there is no intro +rate, returns zero. + +=cut + +sub intro_end { + 0; +} + =item format OPTION DATA Returns data formatted according to the function 'format' described @@ -2308,6 +2413,26 @@ sub _pkgs_sql { } +=item join_options_sql + +Returns an SQL fragment for JOINing the part_pkg_option records for this +package's setup_fee and recur_fee (as setup_option and recur_option, +respectively). Useful for optimization. + +=cut + +sub join_options_sql { + #my $class = shift; + " + LEFT JOIN part_pkg_option AS setup_option + ON ( part_pkg.pkgpart = setup_option.pkgpart + AND setup_option.optionname = 'setup_fee' ) + LEFT JOIN part_pkg_option AS recur_option + ON ( part_pkg.pkgpart = recur_option.pkgpart + AND recur_option.optionname = 'recur_fee' ) + "; +} + =back =head1 SUBROUTINES