package FS::part_pkg;
use strict;
-use vars qw( @ISA %freq %plans $DEBUG );
+use vars qw( @ISA %plans $DEBUG );
use Carp qw(carp cluck confess);
+use Scalar::Util qw( blessed );
use Tie::IxHash;
use FS::Conf;
use FS::Record qw( qsearch qsearchs dbh dbdef );
use FS::agent_type;
use FS::type_pkgs;
use FS::part_pkg_option;
+use FS::pkg_class;
+use FS::agent;
+use FS::part_pkg_taxoverride;
+use FS::part_pkg_taxproduct;
+use FS::part_pkg_link;
-@ISA = qw( FS::Record ); # FS::option_Common ); # this can use option_Common
- # when all the plandata bs is
- # gone
-
+@ISA = qw( FS::m2m_Common FS::option_Common );
$DEBUG = 0;
=head1 NAME
=item comment - Text name of this package definition (non-customer-viewable)
+=item classnum - Optional package class (see L<FS::pkg_class>)
+
=item promo_code - Promotional code
=item setup - Setup fee expression (deprecated)
=item disabled - Disabled flag, empty or `Y'
+=item pay_weight - Weight (relative to credit_weight and other package definitions) that controls payment application to specific line items.
+
+=item credit_weight - Weight (relative to other package definitions) that controls credit application to specific line items.
+
+=item agentnum - Optional agentnum (see L<FS::agent>)
+
=back
=head1 METHODS
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- warn " saving legacy plandata" if $DEBUG;
- my $plandata = $self->get('plandata');
- $self->set('plandata', '');
-
warn " inserting part_pkg record" if $DEBUG;
- my $error = $self->SUPER::insert;
+ my $error = $self->SUPER::insert( $options{options} );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
- if ( $plandata ) {
-
- warn " inserting part_pkg_option records for plandata" if $DEBUG;
- foreach my $part_pkg_option (
- map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
- return "illegal plandata: $plandata";
- };
- new FS::part_pkg_option {
- 'pkgpart' => $self->pkgpart,
- 'optionname' => $1,
- 'optionvalue' => $2,
- };
- }
- split("\n", $plandata)
- ) {
- my $error = $part_pkg_option->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- } elsif ( $options{'options'} ) {
-
- warn " inserting part_pkg_option records for options hashref" if $DEBUG;
- foreach my $optionname ( keys %{$options{'options'}} ) {
-
- my $part_pkg_option =
- new FS::part_pkg_option {
- 'pkgpart' => $self->pkgpart,
- 'optionname' => $optionname,
- 'optionvalue' => $options{'options'}->{$optionname},
- };
-
- my $error = $part_pkg_option->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- }
-
- }
-
my $conf = new FS::Conf;
if ( $conf->exists('agent_defaultpkg') ) {
warn " agent_defaultpkg set; allowing all agents to purchase package"
Replaces OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
-Currently available options are: I<pkg_svc> and I<primary_svc>
+Currently available options are: I<pkg_svc>, I<primary_svc> and I<options>
If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
-values, the appropriate FS::pkg_svc records will be replace.
+values, the appropriate FS::pkg_svc records will be replaced.
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.
+
=cut
sub replace {
- my( $new, $old ) = ( shift, shift );
- my %options = @_;
- warn "FS::part_pkg::replace called on $new to replace $old ".
- "with options %options"
+ my $new = shift;
+
+ my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
+ ? shift
+ : $new->replace_old;
+
+ my $options =
+ ( ref($_[0]) eq 'HASH' )
+ ? shift
+ : { @_ };
+
+ $options->{options} = {} unless defined($options->{options});
+
+ warn "FS::part_pkg::replace called on $new to replace $old with options".
+ join(', ', map "$_ => ". $options->{$_}, keys %$options)
if $DEBUG;
local $SIG{HUP} = 'IGNORE';
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
+ #plandata shit stays in replace for upgrades until after 2.0 (or edit
+ #_upgrade_data)
warn " saving legacy plandata" if $DEBUG;
my $plandata = $new->get('plandata');
$new->set('plandata', '');
}
warn " replacing part_pkg record" if $DEBUG;
- my $error = $new->SUPER::replace($old);
+ my $error = $new->SUPER::replace($old, $options->{options} );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
- warn " inserting part_pkg_option records for plandata" if $DEBUG;
+ warn " inserting part_pkg_option records for plandata: $plandata|" if $DEBUG;
foreach my $part_pkg_option (
map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
return "illegal plandata: $plandata";
}
warn " replacing pkg_svc records" if $DEBUG;
- my $pkg_svc = $options{'pkg_svc'} || {};
+ my $pkg_svc = $options->{'pkg_svc'} || {};
foreach my $part_svc ( qsearch('part_svc', {} ) ) {
my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
- my $primary_svc = $options{'primary_svc'} == $part_svc->svcpart ? 'Y' : '';
+ my $primary_svc = $options->{'primary_svc'} == $part_svc->svcpart ? 'Y' : '';
my $old_pkg_svc = qsearchs('pkg_svc', {
'pkgpart' => $old->pkgpart,
for (qw(setup recur plandata)) {
#$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
- return "Use of $_ field is deprecated; set a plan and options"
+ return "Use of $_ field is deprecated; set a plan and options: ".
+ $self->get($_)
if length($self->get($_));
$self->set($_, '');
}
|| $self->ut_enum('recurtax', [ '', 'Y' ] )
|| $self->ut_textn('taxclass')
|| $self->ut_enum('disabled', [ '', 'Y' ] )
+ || $self->ut_floatn('pay_weight')
+ || $self->ut_floatn('credit_weight')
+ || $self->ut_numbern('taxproductnum')
+ || $self->ut_foreign_keyn('taxproductnum',
+ 'part_pkg_taxproduct',
+ 'taxproductnum'
+ )
+ || $self->ut_agentnum_acl('agentnum', 'Edit global package definitions')
|| $self->SUPER::check
;
return $error if $error;
'';
}
-=item pkg_svc
+=item pkg_comment
+
+Returns an (internal) string representing this package. Currently,
+"pkgpart: pkg - comment", is returned. "pkg - comment" may be returned in the
+future, omitting pkgpart.
+
+=cut
+
+sub pkg_comment {
+ my $self = shift;
+
+ #$self->pkg. ' - '. $self->comment;
+ #$self->pkg. ' ('. $self->comment. ')';
+ $self->pkgpart. ': '. $self->pkg. ' - '. $self->comment;
+}
+
+=item pkg_class
+
+Returns the package class, as an FS::pkg_class object, or the empty string
+if there is no package class.
+
+=cut
+
+sub pkg_class {
+ my $self = shift;
+ if ( $self->classnum ) {
+ qsearchs('pkg_class', { 'classnum' => $self->classnum } );
+ } else {
+ return '';
+ }
+}
+
+=item categoryname
+
+Returns the package category name, or the empty string if there is no package
+category.
+
+=cut
+
+sub categoryname {
+ my $self = shift;
+ my $pkg_class = $self->pkg_class;
+ $pkg_class
+ ? $pkg_class->categoryname
+ : '';
+}
+
+=item classname
+
+Returns the package class name, or the empty string if there is no package
+class.
+
+=cut
+
+sub classname {
+ my $self = shift;
+ my $pkg_class = $self->pkg_class;
+ $pkg_class
+ ? $pkg_class->classname
+ : '';
+}
+
+=item agent
+
+Returns the associated agent for this event, if any, as an FS::agent object.
+
+=cut
+
+sub agent {
+ my $self = shift;
+ qsearchs('agent', { 'agentnum' => $self->agentnum } );
+}
+
+=item pkg_svc [ HASHREF | OPTION => VALUE ]
Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
definition (with non-zero quantity).
+One option is available, I<disable_linked>. If set true it will return the
+services for this package definition alone, omitting services from any add-on
+packages.
+
=cut
sub pkg_svc {
my $self = shift;
- #sort { $b->primary cmp $a->primary }
- grep { $_->quantity }
- qsearch( 'pkg_svc', { 'pkgpart' => $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 } );
+
+ 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 } );
+ foreach my $pkg_svc ( @pkg_svc ) {
+ if ( $pkg_svc{$pkg_svc->svcpart} ) {
+ my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
+ $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
+ } else {
+ $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
+ }
+ }
+ }
+ }
+
+ values(%pkg_svc);
+
}
=item svcpart [ SVCDB ]
}
}
+
+sub freqs_href {
+ #method, class method or sub? #my $self = shift;
+
+ tie my %freq, 'Tie::IxHash',
+ '0' => '(no recurring fee)',
+ '1h' => 'hourly',
+ '1d' => 'daily',
+ '2d' => 'every two days',
+ '3d' => 'every three days',
+ '1w' => 'weekly',
+ '2w' => 'biweekly (every 2 weeks)',
+ '1' => 'monthly',
+ '45d' => 'every 45 days',
+ '2' => 'bimonthly (every 2 months)',
+ '3' => 'quarterly (every 3 months)',
+ '4' => 'every 4 months',
+ '137d' => 'every 4 1/2 months (137 days)',
+ '6' => 'semiannually (every 6 months)',
+ '12' => 'annually',
+ '13' => 'every 13 months (annually +1 month)',
+ '24' => 'biannually (every 2 years)',
+ '36' => 'triannually (every 3 years)',
+ '48' => '(every 4 years)',
+ '60' => '(every 5 years)',
+ '120' => '(every 10 years)',
+ ;
+
+ \%freq;
+
+}
+
=item freq_pretty
Returns an english representation of the I<freq> field, such as "monthly",
=cut
-tie %freq, 'Tie::IxHash',
- '0' => '(no recurring fee)',
- '1h' => 'hourly',
- '1d' => 'daily',
- '1w' => 'weekly',
- '2w' => 'biweekly (every 2 weeks)',
- '1' => 'monthly',
- '2' => 'bimonthly (every 2 months)',
- '3' => 'quarterly (every 3 months)',
- '6' => 'semiannually (every 6 months)',
- '12' => 'annually',
- '24' => 'biannually (every 2 years)',
- '36' => 'triannually (every 3 years)',
- '48' => '(every 4 years)',
- '60' => '(every 5 years)',
- '120' => '(every 10 years)',
-;
-
sub freq_pretty {
my $self = shift;
my $freq = $self->freq;
- if ( exists($freq{$freq}) ) {
- $freq{$freq};
+
+ #my $freqs_href = $self->freqs_href;
+ my $freqs_href = freqs_href();
+
+ if ( exists($freqs_href->{$freq}) ) {
+ $freqs_href->{$freq};
} else {
my $interval = 'month';
if ( $freq =~ /^(\d+)([hdw])$/ ) {
my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
split("\n", $self->get('plandata') );
return $plandata{$opt} if exists $plandata{$opt};
- cluck "Package definition option $opt not found in options or plandata!\n"
+ cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
+ "not found in options or plandata!\n"
unless $ornull;
'';
}
+=item bill_part_pkg_link
+
+Returns the associated part_pkg_link records (see L<FS::part_pkg_link).
+
+=cut
+
+sub bill_part_pkg_link {
+ shift->_part_pkg_link('bill', @_);
+}
+
+=item svc_part_pkg_link
+
+=cut
+
+sub svc_part_pkg_link {
+ shift->_part_pkg_link('svc', @_);
+}
+
+sub _part_pkg_link {
+ my( $self, $type ) = @_;
+ qsearch('part_pkg_link', { 'src_pkgpart' => $self->pkgpart,
+ 'link_type' => $type,
+ }
+ );
+}
+
+sub self_and_bill_linked {
+ shift->_self_and_linked('bill', @_);
+}
+
+sub _self_and_linked {
+ my( $self, $type ) = @_;
+
+ ( $self,
+ map { $_->dst_pkg->_self_and_linked($type) }
+ $self->_part_pkg_link($type)
+ );
+}
+
+=item part_pkg_taxoverride
+
+Returns all associated FS::part_pkg_taxoverride objects (see
+L<FS::part_pkg_taxoverride>).
+
+=cut
+
+sub part_pkg_taxoverride {
+ my $self = shift;
+ qsearch('part_pkg_taxoverride', { 'pkgpart' => $self->pkgpart } );
+}
+
+=item taxproduct_description
+
+Returns the description of the associated tax product for this package
+definition (see L<FS::part_pkg_taxproduct>).
+
+=cut
+
+sub taxproduct_description {
+ my $self = shift;
+ my $part_pkg_taxproduct =
+ qsearchs( 'part_pkg_taxproduct',
+ { 'taxproductnum' => $self->taxproductnum }
+ );
+ $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
+}
+
+=item part_pkg_taxrate DATA_PROVIDER, GEOCODE
+
+Returns the package to taxrate m2m records for this package in the location
+specified by GEOCODE (see L<FS::part_pkg_taxrate> and ).
+
+=cut
+
+sub _expand_cch_taxproductnum {
+ my $self = shift;
+ my $part_pkg_taxproduct =
+ qsearchs( 'part_pkg_taxproduct',
+ { 'taxproductnum' => $self->taxproductnum }
+ );
+ my ($a,$b,$c,$d) = ( $part_pkg_taxproduct
+ ? ( split ':', $part_pkg_taxproduct->taxproduct )
+ : ()
+ );
+ my $extra_sql = "AND ( taxproduct = '$a:$b:$c:$d'
+ OR taxproduct = '$a:$b:$c:'
+ OR taxproduct = '$a:$b:".":$d'
+ OR taxproduct = '$a:$b:".":' )";
+ map { $_->taxproductnum } qsearch( { 'table' => 'part_pkg_taxproduct',
+ 'hashref' => { 'data_vendor'=>'cch' },
+ 'extra_sql' => $extra_sql,
+ } );
+
+}
+
+sub part_pkg_taxrate {
+ my $self = shift;
+ my ($data_vendor, $geocode) = @_;
+
+ my $dbh = dbh;
+ my $extra_sql = 'WHERE part_pkg_taxproduct.data_vendor = '.
+ dbh->quote($data_vendor);
+
+ # CCH oddness in m2m
+ $extra_sql .= ' AND ('.
+ join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
+ qw(10 5 2)
+ ).
+ ')';
+ # much more CCH oddness in m2m -- this is kludgy
+ $extra_sql .= ' AND ('.
+ join(' OR ', map{ "taxproductnum = $_" } $self->_expand_cch_taxproductnum).
+ ')';
+
+ my $addl_from = 'LEFT JOIN part_pkg_taxproduct USING ( taxproductnum )';
+ my $order_by = 'ORDER BY taxclassnum, length(geocode) desc, length(taxproduct) desc';
+ my $select = 'DISTINCT ON(taxclassnum) *, taxproduct';
+
+ # should qsearch preface columns with the table to facilitate joins?
+ qsearch( { 'table' => 'part_pkg_taxrate',
+ 'select' => $select,
+ 'hashref' => { # 'data_vendor' => $data_vendor,
+ # 'taxproductnum' => $self->taxproductnum,
+ },
+ 'addl_from' => $addl_from,
+ 'extra_sql' => $extra_sql,
+ 'order_by' => $order_by,
+ } );
+}
+
=item _rebless
Reblesses the object into the FS::part_pkg::PLAN class (if available), where
my $self = shift;
my $plan = $self->plan;
unless ( $plan ) {
- confess "no price plan found for pkgpart ". $self->pkgpart. "\n"
+ cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
if $DEBUG;
return $self;
}
sub calc_remain { 0; }
sub calc_cancel { 0; }
+sub calc_units { 0; }
=back
+=cut
+
+# _upgrade_data
+#
+# Used by FS::Upgrade to migrate to a new database.
+
+sub _upgrade_data { # class method
+ my($class, %opts) = @_;
+
+ warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
+
+ my @part_pkg = qsearch({
+ 'table' => 'part_pkg',
+ 'extra_sql' => "WHERE ". join(' OR ',
+ ( map "($_ IS NOT NULL AND $_ != '' )",
+ qw( plandata setup recur ) ),
+ 'plan IS NULL', "plan = '' ",
+ ),
+ });
+
+ foreach my $part_pkg (@part_pkg) {
+
+ unless ( $part_pkg->plan ) {
+
+ $part_pkg->plan('flat');
+
+ if ( $part_pkg->setup =~ /^\s*([\d\.]+)\s*$/ ) {
+
+ my $opt = new FS::part_pkg_option {
+ 'pkgpart' => $part_pkg->pkgpart,
+ 'optionname' => 'setup_fee',
+ 'optionvalue' => $1,
+ };
+ my $error = $opt->insert;
+ die $error if $error;
+
+ $part_pkg->setup('');
+
+ } else {
+ die "Can't parse part_pkg.setup for fee; convert pkgnum ".
+ $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n";
+ }
+
+ if ( $part_pkg->recur =~ /^\s*([\d\.]+)\s*$/ ) {
+
+ my $opt = new FS::part_pkg_option {
+ 'pkgpart' => $part_pkg->pkgpart,
+ 'optionname' => 'recur_fee',
+ 'optionvalue' => $1,
+ };
+ my $error = $opt->insert;
+ die $error if $error;
+
+ $part_pkg->recur('');
+
+ } else {
+ die "Can't parse part_pkg.setup for fee; convert pkgnum ".
+ $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n";
+ }
+
+ }
+
+ $part_pkg->replace; #this should take care of plandata, right?
+
+ }
+
+}
+
=head1 SUBROUTINES
=over 4
\%plans;
}
+=item format OPTION DATA
+
+Returns data formatted according to the function 'format' described
+in the plan info. Returns DATA if no such function exists.
+
+=cut
+
+sub format {
+ my ($self, $option, $data) = (shift, shift, shift);
+ if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
+ &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
+ }else{
+ $data;
+ }
+}
+
+=item parse OPTION DATA
+
+Returns data parsed according to the function 'parse' described
+in the plan info. Returns DATA if no such function exists.
+
+=cut
+
+sub parse {
+ my ($self, $option, $data) = (shift, shift, shift);
+ if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
+ &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
+ }else{
+ $data;
+ }
+}
+
+
=back
=head1 NEW PLAN CLASSES
plandata should go
+part_pkg_taxrate is Pg specific
+
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
projects / freeside.git / blobdiff