X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_pkg.pm;h=9b1652a6b14e73d7de3bdd30b71646beca0bb98f;hb=e13403cc8e687d852f6986985877eaf584bb257a;hp=07dacfb29f81eca2eb75bccf0ed48463238b98e8;hpb=83ae7beac0d7dd6130c47327908afc33f31e725a;p=freeside.git diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 07dacfb29..9b1652a6b 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 @@ -583,6 +583,25 @@ sub replace { ''; } +sub validate_number { + my ($option, $valref) = @_; + + $$valref = 0 unless $$valref; + return "Invalid $option" + unless ($$valref) = ($$valref =~ /^\s*(\d+)\s*$/); + return ''; +} + +sub validate_number_blank { + my ($option, $valref) = @_; + + if ($$valref) { + return "Invalid $option" + unless ($$valref) = ($$valref =~ /^\s*(\d+)\s*$/); + } + return ''; +} + =item check Checks all fields to make sure this is a valid package definition. If @@ -669,6 +688,46 @@ sub check { ''; } +=item check_options + +Pass an I<$options> hashref that contains the values to be +inserted or updated for any FS::part_pkg::MODULE.pm. + +For each key in I<$options>, validates the value by calling +the 'validate' subroutine defined for that option e.g. +FS::part_pkg::MODULE::plan_info()->{$KEY}->{validate}. The +option validation function is only called when the hashkey for +that option exists in I<$options>. + +Then the module validation function is called, from +FS::part_pkg::MODULE::plan_info()->{validate} + +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 +1037,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 +1061,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 +1350,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 +1750,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 +2010,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 @@ -2099,4 +2226,3 @@ schema.html from the base documentation. =cut 1; -