X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_pkg.pm;h=5f7c831bc067b1d0086d89c35f31b71bba1863d5;hb=9795489fc19bf7be914d95a0c8dba71361ea327e;hp=07dacfb29f81eca2eb75bccf0ed48463238b98e8;hpb=83ae7beac0d7dd6130c47327908afc33f31e725a;p=freeside.git diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 07dacfb29..5f7c831bc 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -355,11 +355,11 @@ can be set to a hashref of svcparts and flag values ('Y' or '') to set the to a hashref of svcparts and flag values ('Y' or '') to set the field in those records. -If I is set to the svcpart of the primary service, the appropriate -FS::pkg_svc record will be updated. +If I is set to the svcpart of the primary service, the +appropriate FS::pkg_svc record will be updated. -If I is set to a hashref, the appropriate FS::part_pkg_option records -will be replaced. +If I is set to a hashref, the appropriate FS::part_pkg_option +records will be replaced. =cut @@ -669,6 +669,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 supersede OLD [, OPTION => VALUE ... ] Inserts this package as a successor to the package OLD. All options are as @@ -978,14 +1012,11 @@ sub pkg_svc { # 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; @@ -1005,6 +1036,17 @@ sub 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) @@ -1283,9 +1325,8 @@ 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; my $part_pkg_option = @@ -1684,6 +1725,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 @@ -1932,6 +1985,55 @@ sub queueable_upgrade { FS::upgrade_journal->set_done($upgrade); } + # remove custom flag from one-time charge packages that were accidentally + # flagged as custom + $search = FS::Cursor->new({ + 'table' => 'part_pkg', + 'hashref' => { 'freq' => '0', + 'custom' => 'Y', + 'family_pkgpart' => { op => '!=', value => '' }, + }, + 'addl_from' => ' JOIN + (select pkgpart from cust_pkg group by pkgpart having count(*) = 1) + AS singular_pkg USING (pkgpart)', + }); + my @fields = grep { $_ ne 'pkgpart' + and $_ ne 'custom' + and $_ ne 'disabled' } FS::part_pkg->fields; + PKGPART: while (my $part_pkg = $search->fetch) { + # can't merge the package back into its parent (too late for that) + # but we can remove the custom flag if it's not actually customized, + # i.e. nothing has been changed. + + my $family_pkgpart = $part_pkg->family_pkgpart; + next PKGPART if $family_pkgpart == $part_pkg->pkgpart; + my $parent_pkg = FS::part_pkg->by_key($family_pkgpart); + foreach my $field (@fields) { + if ($part_pkg->get($field) ne $parent_pkg->get($field)) { + next PKGPART; + } + } + # options have to be identical too + # but links, FCC options, discount plans, and usage packages can't be + # changed through the "modify charge" UI, so skip them + my %newopt = $part_pkg->options; + my %oldopt = $parent_pkg->options; + OPTION: foreach my $option (keys %newopt) { + if (delete $newopt{$option} ne delete $oldopt{$option}) { + next PKGPART; + } + } + if (keys(%newopt) or keys(%oldopt)) { + next PKGPART; + } + # okay, now replace it + warn "Removing custom flag from part_pkg#".$part_pkg->pkgpart."\n"; + $part_pkg->set('custom', ''); + my $error = $part_pkg->replace; + die $error if $error; + } # $search->fetch + + return; } =item curuser_pkgs_sql