use base qw( FS::m2m_Common FS::o2m_Common FS::option_Common );
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;
use FS::part_pkg_vendor;
$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
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
+
+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</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
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;
}
}
- 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<FS::part_svc>)
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,
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 {
$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
=cut
1;
-