to a hashref of svcparts and flag values ('Y' or '') to set the field
in those records.
-If I<primary_svc> is set to the svcpart of the primary service, the appropriate
-FS::pkg_svc record will be updated.
+If I<primary_svc> is set to the svcpart of the primary service, the
+appropriate FS::pkg_svc record will be updated.
-If I<options> is set to a hashref, the appropriate FS::part_pkg_option records
-will be replaced.
+If I<options> is set to a hashref, the appropriate FS::part_pkg_option
+records will be replaced.
=cut
'';
}
+=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</insert> and L</replace> via the equivalent
+methods in L<FS::option_Common>.
+
+=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
# 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;
}
+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<FS::part_svc>)
$self->base_recur_permonth(@_) - $self->recur_cost_permonth(@_);
}
+=item intro_end PACKAGE
+
+Takes an L<FS::cust_pkg> 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
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