package FS::part_pkg;
-use base qw( FS::m2m_Common FS::o2m_Common FS::option_Common );
+use base qw( FS::part_pkg::API
+ FS::m2m_Common FS::o2m_Common FS::option_Common
+ );
use strict;
use vars qw( %plans $DEBUG $setup_hack $skip_pkg_svc_hack );
use Tie::IxHash;
use FS::Conf;
use FS::Record qw( qsearch qsearchs dbh dbdef );
+use FS::Cursor; # for upgrade
use FS::pkg_svc;
use FS::part_svc;
use FS::cust_pkg;
use FS::agent_type;
use FS::type_pkgs;
use FS::part_pkg_option;
+use FS::part_pkg_fcc_option;
+use FS::pkg_class;
+use FS::agent;
use FS::part_pkg_msgcat;
use FS::part_pkg_taxrate;
use FS::part_pkg_taxoverride;
use FS::part_pkg_discount;
use FS::part_pkg_vendor;
use FS::part_pkg_currency;
+use FS::part_svc_link;
$DEBUG = 0;
$setup_hack = 0;
=item delay_start - Number of days to delay package start, by default
+=item start_on_hold - 'Y' to suspend this package immediately when it is
+ordered. The package will not start billing or have a setup fee charged
+until it is manually unsuspended.
+
+=item change_to_pkgpart - When this package is ordered, schedule a future
+package change. The 'expire_months' field will determine when the package
+change occurs.
+
+=item expire_months - Number of months until this package expires (or changes
+to another package).
+
+=item adjourn_months - Number of months until this package becomes suspended.
+
+=item contract_end_months - Number of months until the package's contract
+ends.
+
=back
=head1 METHODS
}
}
- my $conf = new FS::Conf;
- if ( $conf->exists('agent_defaultpkg') ) {
- warn " agent_defaultpkg set; allowing all agents to purchase package"
- if $DEBUG;
- foreach my $agent_type ( qsearch('agent_type', {} ) ) {
- my $type_pkgs = new FS::type_pkgs({
- 'typenum' => $agent_type->typenum,
- 'pkgpart' => $self->pkgpart,
- });
- my $error = $type_pkgs->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
warn " inserting part_pkg_taxoverride records" if $DEBUG;
my %overrides = %{ $options{'tax_overrides'} || {} };
foreach my $usage_class ( keys %overrides ) {
}
}
+ my $error = $self->check_pkg_svc(%options);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
}
if ( $options{'cust_pkg'} ) {
}
}
+ if ( $options{fcc_options} ) {
+ warn " updating fcc options " if $DEBUG;
+ $self->set_fcc_options( $options{fcc_options} );
+ }
+
warn " committing transaction" if $DEBUG and $oldAutoCommit;
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
my $hidden_svc = $options->{'hidden_svc'} || {};
my $bulk_skip = $options->{'bulk_skip'} || {};
if ( $pkg_svc ) { # if it wasn't passed, don't change existing pkg_svcs
+
foreach my $part_svc ( qsearch('part_svc', {} ) ) {
my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
my $hidden = $hidden_svc->{$part_svc->svcpart} || '';
return $error;
}
} #foreach $part_svc
+
+ my $error = $new->check_pkg_svc(%$options);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
} #if $options->{pkg_svc}
my @part_pkg_vendor = $old->part_pkg_vendor;
}
}
+ if ( $options->{fcc_options} ) {
+ warn " updating fcc options " if $DEBUG;
+ $new->set_fcc_options( $options->{fcc_options} );
+ }
+
warn " committing transaction" if $DEBUG and $oldAutoCommit;
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
|| $self->ut_textn('comment')
|| $self->ut_textn('promo_code')
|| $self->ut_alphan('plan')
- || $self->ut_enum('setuptax', [ '', 'Y' ] )
- || $self->ut_enum('recurtax', [ '', 'Y' ] )
+ || $self->ut_flag('setuptax')
+ || $self->ut_flag('recurtax')
|| $self->ut_textn('taxclass')
- || $self->ut_enum('disabled', [ '', 'Y' ] )
- || $self->ut_enum('custom', [ '', 'Y' ] )
- || $self->ut_enum('no_auto', [ '', 'Y' ])
- || $self->ut_enum('recur_show_zero', [ '', 'Y' ])
- || $self->ut_enum('setup_show_zero', [ '', 'Y' ])
+ || $self->ut_flag('disabled')
+ || $self->ut_flag('custom')
+ || $self->ut_flag('no_auto')
+ || $self->ut_flag('recur_show_zero')
+ || $self->ut_flag('setup_show_zero')
+ || $self->ut_flag('start_on_hold')
#|| $self->ut_moneyn('setup_cost')
#|| $self->ut_moneyn('recur_cost')
|| $self->ut_floatn('setup_cost')
|| $self->ut_numbern('delay_start')
|| $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart')
|| $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart')
+ || $self->ut_numbern('expire_months')
+ || $self->ut_numbern('adjourn_months')
+ || $self->ut_numbern('contract_end_months')
+ || $self->ut_numbern('change_to_pkgpart')
+ || $self->ut_foreign_keyn('change_to_pkgpart', 'part_pkg', 'pkgpart')
|| $self->ut_alphan('agent_pkgpartid')
|| $self->SUPER::check
;
'';
}
+=item check_pkg_svc
+
+Checks pkg_svc records as a whole (for part_svc_link dependencies).
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub check_pkg_svc {
+ my( $self, %opt ) = @_;
+
+ my $agentnum = $self->agentnum;
+
+ my %pkg_svc = map { $_->svcpart => $_ } $self->pkg_svc;
+
+ foreach my $svcpart ( keys %pkg_svc ) {
+
+ foreach my $part_svc_link ( $self->part_svc_link(
+ 'src_svcpart' => $svcpart,
+ 'link_type' => 'part_pkg_restrict',
+ )
+ ) {
+
+ return $part_svc_link->dst_svc. ' must be included with '.
+ $part_svc_link->src_svc
+ unless $pkg_svc{ $part_svc_link->dst_svcpart };
+ }
+
+ }
+
+ return '' if $opt{part_pkg_restrict_soft_override};
+
+ foreach my $svcpart ( keys %pkg_svc ) {
+
+ foreach my $part_svc_link ( $self->part_svc_link(
+ 'src_svcpart' => $svcpart,
+ 'link_type' => 'part_pkg_restrict_soft',
+ )
+ ) {
+ return $part_svc_link->dst_svc. ' is suggested with '.
+ $part_svc_link->src_svc
+ unless $pkg_svc{ $part_svc_link->dst_svcpart };
+ }
+
+ }
+
+ '';
+}
+
+=item part_svc_link OPTION => VALUE ...
+
+Returns the service dependencies (see L<FS::part_svc_link>) for the given
+search options, taking into account this package definition's agent.
+
+Available options are any field in part_svc_link. Typically used options are
+src_svcpart and link_type.
+
+=cut
+
+sub part_svc_link {
+ FS::part_svc_link->by_agentnum( shift->agentnum, @_ );
+}
+
=item supersede OLD [, OPTION => VALUE ... ]
Inserts this package as a successor to the package OLD. All options are as
join("\n", @error);
}
+=item set_fcc_options HASHREF
+
+Sets the FCC options on this package definition to the values specified
+in HASHREF.
+
+=cut
+
+sub set_fcc_options {
+ my $self = shift;
+ my $pkgpart = $self->pkgpart;
+ my $options;
+ if (ref $_[0]) {
+ $options = shift;
+ } else {
+ $options = { @_ };
+ }
+
+ my %existing_num = map { $_->fccoptionname => $_->num }
+ qsearch('part_pkg_fcc_option', { pkgpart => $pkgpart });
+
+ local $FS::Record::nowarn_identical = 1;
+ # set up params for process_o2m
+ my $i = 0;
+ my $params = {};
+ foreach my $name (keys %$options ) {
+ $params->{ "num$i" } = $existing_num{$name} || '';
+ $params->{ "num$i".'_fccoptionname' } = $name;
+ $params->{ "num$i".'_optionvalue' } = $options->{$name};
+ $i++;
+ }
+
+ $self->process_o2m(
+ table => 'part_pkg_fcc_option',
+ fields => [qw( fccoptionname optionvalue )],
+ params => $params,
+ );
+}
+
=item pkg_locale LOCALE
Returns a customer-viewable string representing this package for the given
sub can_discount { 0; }
# whether the plan allows changing the start date
-sub can_start_date { 1; }
+sub can_start_date {
+ my $self = shift;
+ $self->start_on_hold ? 0 : 1;
+}
# whether the plan supports part_pkg_usageprice add-ons (a specific kind of
# pre-selectable usage pricing, there's others this doesn't refer to)
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"};
+ }
+
cluck "$self -> option: searching for $opt"
if $DEBUG;
my $part_pkg_option =
optionname => $opt,
} );
return $part_pkg_option->optionvalue if $part_pkg_option;
+
my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
split("\n", $self->get('plandata') );
return $plandata{$opt} if exists $plandata{$opt};
+
+ # check whether the option is defined in plan info (if so, don't warn)
+ if (exists $plans{ $self->plan }->{fields}->{$opt}) {
+ return '';
+ }
cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
"not found in options or plandata!\n"
unless $ornull;
+
'';
}
$part_pkg_currency->optionvalue;
}
+=item fcc_option OPTIONNAME
+
+Returns the FCC 477 report option value for the given name, or the empty
+string.
+
+=cut
+
+sub fcc_option {
+ my ($self, $name) = @_;
+ my $part_pkg_fcc_option =
+ qsearchs('part_pkg_fcc_option', {
+ pkgpart => $self->pkgpart,
+ fccoptionname => $name,
+ });
+ $part_pkg_fcc_option ? $part_pkg_fcc_option->optionvalue : '';
+}
+
+=item fcc_options
+
+Returns all FCC 477 report options for this package, as a hash-like list.
+
+=cut
+
+sub fcc_options {
+ my $self = shift;
+ map { $_->fccoptionname => $_->optionvalue }
+ qsearch('part_pkg_fcc_option', { pkgpart => $self->pkgpart });
+}
+
=item bill_part_pkg_link
Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
sub tax_rates {
my $self = shift;
my ($vendor, $geocode, $class) = @_;
+ # if this part_pkg is overridden into a specific taxclass, get that class
my @taxclassnums = map { $_->taxclassnum }
$self->part_pkg_taxoverride($class);
+ # otherwise, get its tax product category
if (!@taxclassnums) {
my $part_pkg_taxproduct = $self->taxproduct($class);
+ # If this isn't defined, then the class has no taxproduct designation,
+ # so return no tax rates.
+ return () if !$part_pkg_taxproduct;
+
+ # convert the taxproduct to the tax classes that might apply to it in
+ # $geocode
@taxclassnums = map { $_->taxclassnum }
grep { $_->taxable eq 'Y' } # why do we need this?
$part_pkg_taxproduct->part_pkg_taxrate($geocode);
}
return unless @taxclassnums;
+ # then look up the actual tax_rate entries
warn "Found taxclassnum values of ". join(',', @taxclassnums) ."\n"
if $DEBUG;
my $extra_sql = "AND taxclassnum IN (". join(',', @taxclassnums) . ")";
my @taxes = qsearch({ 'table' => 'tax_rate',
'hashref' => { 'geocode' => $geocode,
- 'data_vendor' => $vendor },
+ 'data_vendor' => $vendor,
+ 'disabled' => '' },
'extra_sql' => $extra_sql,
});
warn "Found taxes ". join(',', map {$_->taxnum} @taxes) ."\n"
Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for
this package.
+=item change_to_pkg
+
+Returns the automatic transfer target for this package, or an empty string
+if there isn't one.
+
+=cut
+
+sub change_to_pkg {
+ my $self = shift;
+ my $pkgpart = $self->change_to_pkgpart or return '';
+ FS::part_pkg->by_key($pkgpart);
+}
+
=item _rebless
Reblesses the object into the FS::part_pkg::PLAN class (if available), where
$self;
}
+=item calc_setup CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
+
+=item calc_recur CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
+
+Calculates and returns the setup or recurring fees, respectively, for this
+package. Implementation is in the FS::part_pkg:* module specific to this price
+plan.
+
+Adds invoicing details to the passed-in DETAILS_ARRAYREF
+
+Options are passed as a hashref. Available options:
+
+=over 4
+
+=item freq_override
+
+Frequency override (for calc_recur)
+
+=item discounts
+
+This option is filled in by the method rather than controlling its operation.
+It is an arrayref. Applicable discounts will be added to the arrayref, as
+L<FS::cust_bill_pkg_discount|FS::cust_bill_pkg_discount records>.
+
+=item real_pkgpart
+
+For package add-ons, is the base L<FS::part_pkg|package definition>, otherwise
+no different than pkgpart.
+
+=item precommit_hooks
+
+This option is filled in by the method rather than controlling its operation.
+It is an arrayref. Anonymous coderefs will be added to the arrayref. They
+need to be called before completing the billing operation. For calc_recur
+only.
+
+=item increment_next_bill
+
+Increment the next bill date (boolean, for calc_recur). Typically true except
+for particular situations.
+
+=item setup_fee
+
+This option is filled in by the method rather than controlling its operation.
+It indicates a deferred setup fee that is billed at calc_recur time (see price
+plan option prorate_defer_bill).
+
+=back
+
+Note: Don't calculate prices when not actually billing the package. For that,
+see the L</base_setup|base_setup> and L</base_recur|base_recur> methods.
+
+=cut
+
#fatal fallbacks
sub calc_setup { die 'no calc_setup for '. shift->plan. "\n"; }
sub calc_recur { die 'no calc_recur for '. shift->plan. "\n"; }
-#fallback that return 0 for old legacy packages with no plan
+=item calc_remain CUST_PKG [ OPTION => VALUE ... ]
+
+Calculates and returns the remaining value to be credited upon package
+suspension, change, or cancellation, if enabled.
+
+Options are passed as a list of keys and values. Available options:
+
+=over 4
+
+=item time
+
+Override for the current time
+
+=item cust_credit_source_bill_pkg
+
+This option is filled in by the method rather than controlling its operation.
+It is an arrayref.
+L<FS::cust_credit_source_bill_pkg|FS::cust_credit_source_bill_pkg> records will
+be added to the arrayref indicating the specific line items and amounts which
+are the source of this remaining credit.
+
+=back
+
+Note: Don't calculate prices when not actually suspending or cancelling the
+package.
+
+=cut
+
+#fallback that returns 0 for old legacy packages with no plan
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
+in the package.
+
+=cut
+
+#fallback that returns 0 for old legacy packages with no plan
sub calc_units { 0; }
#fallback for everything not based on flat.pm
sub recur_temporality { 'upcoming'; }
+
+=item calc_cancel START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
+
+Runs any necessary billing on cancellation: another recurring cycle for
+recur_temporailty 'preceding' pacakges with the bill_recur_on_cancel option
+set (calc_recur), or, any outstanding usage for pacakges with the
+bill_usage_on_cancel option set (calc_usage).
+
+=cut
+
+#fallback for everything not based on flat.pm, doesn't do this yet (which is
+#okay, nothing of ours not based on flat.pm does usage-on-cancel billing
sub calc_cancel { 0; }
#fallback for everything except bulk.pm
sub recur_cost_permonth {
my($self, $cust_pkg) = @_;
return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
- sprintf('%.2f', $self->recur_cost / $self->freq );
+ sprintf('%.2f', ($self->recur_cost || 0) / $self->freq );
}
=item cust_bill_pkg_recur CUST_PKG
sub setup_margin {
my $self = shift;
- $self->unit_setup(@_) - $self->setup_cost;
+ $self->unit_setup(@_) - ($self->setup_cost || 0);
}
=item recur_margin_permonth
# Used by FS::Upgrade to migrate to a new database.
sub _upgrade_data { # class method
- my($class, %opts) = @_;
+ my($class, %opts) = @_;
warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
}
+ # Convert RADIUS accounting usage metrics from megabytes to gigabytes
+ # (FS RT#28105)
+ my $upgrade = 'part_pkg_gigabyte_usage';
+ if (!FS::upgrade_journal->is_done($upgrade)) {
+ foreach my $part_pkg (qsearch('part_pkg',
+ { plan => 'sqlradacct_hour' })
+ ){
+
+ my $pkgpart = $part_pkg->pkgpart;
+
+ foreach my $opt (qsearch('part_pkg_option',
+ { 'optionname' => { op => 'LIKE',
+ value => 'recur_included_%',
+ },
+ pkgpart => $pkgpart,
+ })){
+
+ next if $opt->optionname eq 'recur_included_hours'; # unfortunately named field
+ next if $opt->optionvalue == 0;
+
+ $opt->optionvalue($opt->optionvalue / 1024);
+
+ my $error = $opt->replace;
+ die $error if $error;
+ }
+
+ foreach my $opt (qsearch('part_pkg_option',
+ { 'optionname' => { op => 'LIKE',
+ value => 'recur_%_charge',
+ },
+ pkgpart => $pkgpart,
+ })){
+ $opt->optionvalue($opt->optionvalue * 1024);
+
+ my $error = $opt->replace;
+ die $error if $error;
+ }
+
+ }
+ FS::upgrade_journal->set_done($upgrade);
+ }
+
+ # the rest can be done asynchronously
+}
+
+sub queueable_upgrade {
# now upgrade to the explicit custom flag
- @part_pkg = qsearch({
+ my $search = FS::Cursor->new({
'table' => 'part_pkg',
'hashref' => { disabled => 'Y', custom => '' },
'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
});
+ my $dbh = dbh;
- foreach my $part_pkg (@part_pkg) {
+ while (my $part_pkg = $search->fetch) {
my $new = new FS::part_pkg { $part_pkg->hash };
$new->custom('Y');
my $comment = $part_pkg->comment;
'primary_svc' => $primary,
'options' => $options,
);
- die $error if $error;
+ if ($error) {
+ warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
+ $dbh->rollback;
+ } else {
+ $dbh->commit;
+ }
}
# set family_pkgpart on any packages that don't have it
- @part_pkg = qsearch('part_pkg', { 'family_pkgpart' => '' });
- foreach my $part_pkg (@part_pkg) {
+ $search = FS::Cursor->new('part_pkg', { 'family_pkgpart' => '' });
+ while (my $part_pkg = $search->fetch) {
$part_pkg->set('family_pkgpart' => $part_pkg->pkgpart);
my $error = $part_pkg->SUPER::replace;
- die $error if $error;
+ if ($error) {
+ warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
+ $dbh->rollback;
+ } else {
+ $dbh->commit;
+ }
}
my @part_pkg_option = qsearch('part_pkg_option',
}
} # $bad_upgrade exists
else { # do the original upgrade, but correctly this time
- @part_pkg = qsearch('part_pkg', {
+ my @part_pkg = qsearch('part_pkg', {
fcc_ds0s => { op => '>', value => 0 },
fcc_voip_class => ''
});
FS::upgrade_journal->set_done($upgrade);
}
+ # migrate adjourn_months, expire_months, and contract_end_months to
+ # real fields
+ foreach my $field (qw(adjourn_months expire_months contract_end_months)) {
+ foreach my $option (qsearch('part_pkg_option', { optionname => $field })) {
+ my $part_pkg = $option->part_pkg;
+ my $error = $option->delete;
+ if ( $option->optionvalue and $part_pkg->get($field) eq '' ) {
+ $part_pkg->set($field, $option->optionvalue);
+ $error ||= $part_pkg->replace;
+ }
+ die $error if $error;
+ }
+ }
}
=item curuser_pkgs_sql
#false laziness w/part_export & cdr
my %info;
foreach my $INC ( @INC ) {
- warn "globbing $INC/FS/part_pkg/*.pm\n" if $DEBUG;
- foreach my $file ( glob("$INC/FS/part_pkg/*.pm") ) {
+ warn "globbing $INC/FS/part_pkg/[a-z]*.pm\n" if $DEBUG;
+ foreach my $file ( glob("$INC/FS/part_pkg/[a-z]*.pm") ) {
warn "attempting to load plan info from $file\n" if $DEBUG;
$file =~ /\/(\w+)\.pm$/ or do {
warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
projects / freeside.git / blobdiff