use strict;
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::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::m2m_Common 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
In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
the scalar will be updated with the custnum value from the cust_pkg record.
+If I<tax_overrides> is set to a hashref with usage classes as keys and comma
+separated tax class numbers as values, appropriate FS::part_pkg_taxoverride
+records will be inserted.
+
If I<options> is set to a hashref of options, appropriate FS::part_pkg_option
records will be inserted.
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"
}
}
+ warn " inserting part_pkg_taxoverride records" if $DEBUG;
+ my %overrides = %{ $options{'tax_overrides'} || {} };
+ foreach my $usage_class ( keys %overrides ) {
+ my @overrides = (grep "$_", split (',', $overrides{$usage_class}) );
+ my $error = $self->process_m2m (
+ 'link_table' => 'part_pkg_taxoverride',
+ 'target_table' => 'tax_class',
+ 'hashref' => { 'usage_class' => $usage_class },
+ 'params' => \@overrides,
+ );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
warn " inserting pkg_svc records" if $DEBUG;
my $pkg_svc = $options{'pkg_svc'} || {};
foreach my $part_svc ( qsearch('part_svc', {} ) ) {
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 = @_;
+ my $new = shift;
- # We absolutely have to have an old vs. new record to make this work.
- if (!defined($old)) {
- $old = qsearchs( 'part_pkg', { 'pkgpart' => $new->pkgpart } );
- }
+ my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
+ ? shift
+ : $new->replace_old;
- warn "FS::part_pkg::replace called on $new to replace $old ".
- "with options %options"
+ 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 =
+ ( defined($options->{'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('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
;
'';
}
+=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
}
}
+=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
qsearchs('agent', { 'agentnum' => $self->agentnum } );
}
-=item pkg_svc
+=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 ]
'';
}
+=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
+
+Returns the associated part_pkg_link records (see L<FS::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 [ CLASS ]
+
+Returns all associated FS::part_pkg_taxoverride objects (see
+L<FS::part_pkg_taxoverride>). Limits the returned set to those
+of class CLASS if defined. Class may be one of 'setup', 'recur',
+the empty string (default), or a usage class number (see L<FS::usage_class>).
+When a class is specified, the empty string class (default) is returned
+if no more specific values exist.
+
+=cut
+
+sub part_pkg_taxoverride {
+ my $self = shift;
+ my $class = shift;
+
+ my $hashref = { 'pkgpart' => $self->pkgpart };
+ $hashref->{'usage_class'} = $class if defined($class);
+ my @overrides = qsearch('part_pkg_taxoverride', $hashref );
+
+ unless ( scalar(@overrides) || !defined($class) || !$class ){
+ $hashref->{'usage_class'} = '';
+ @overrides = qsearch('part_pkg_taxoverride', $hashref );
+ }
+
+ @overrides;
+}
+
+=item has_taxproduct
+
+Returns true if this package has any taxproduct associated with it.
+
+=cut
+
+sub has_taxproduct {
+ my $self = shift;
+
+ $self->taxproductnum ||
+ scalar(grep { $_ =~/^usage_taxproductnum_/ } keys %{ {$self->options} } )
+
+}
+
+
+=item taxproduct [ CLASS ]
+
+Returns the associated tax product for this package definition (see
+L<FS::part_pkg_taxproduct>). CLASS may be one of 'setup', 'recur' or
+the usage classnum (see L<FS::usage_class>). Returns the default
+tax product for this record if the more specific CLASS value does
+not exist.
+
+=cut
+
+sub taxproduct {
+ my $self = shift;
+ my $class = shift;
+
+ my $part_pkg_taxproduct;
+
+ my $taxproductnum = $self->taxproductnum;
+ if ($class) {
+ my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
+ $taxproductnum = $class_taxproductnum
+ if $class_taxproductnum
+ }
+
+ $part_pkg_taxproduct =
+ qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
+
+ unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
+ $taxproductnum = $self->taxproductnum;
+ $part_pkg_taxproduct =
+ qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
+ }
+
+ $part_pkg_taxproduct;
+}
+
+=item taxproduct_description [ CLASS ]
+
+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 = $self->taxproduct(@_);
+ $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
+}
+
+=item part_pkg_taxrate DATA_PROVIDER, GEOCODE, [ CLASS ]
+
+Returns the package to taxrate m2m records for this package in the location
+specified by GEOCODE (see L<FS::part_pkg_taxrate>) and usage class CLASS.
+CLASS may be one of 'setup', 'recur', or one of the usage classes numbers
+(see L<FS::usage_class>).
+
+=cut
+
+sub _expand_cch_taxproductnum {
+ my $self = shift;
+ my $class = shift;
+ my $part_pkg_taxproduct = $self->taxproduct($class);
+
+ my ($a,$b,$c,$d) = ( $part_pkg_taxproduct
+ ? ( split ':', $part_pkg_taxproduct->taxproduct )
+ : ()
+ );
+ $a = '' unless $a; $b = '' unless $b; $c = '' unless $c; $d = '' unless $d;
+ 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, $class) = @_;
+
+ 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
+ my @tpnums = $self->_expand_cch_taxproductnum($class);
+ $extra_sql .= ' AND ('.
+ join(' OR ', map{ "taxproductnum = $_" } @tpnums ).
+ ')'
+ if @tpnums;
+
+ 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
=cut
+#false laziness w/part_export & cdr
my %info;
foreach my $INC ( @INC ) {
warn "globbing $INC/FS/part_pkg/*.pm\n" if $DEBUG;
next;
}
unless ( keys %$info ) {
- warn "no %info hash found in FS::part_pkg::$mod, skipping\n"
- unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck
+ warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
next;
}
warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
}
tie %plans, 'Tie::IxHash',
- map { $_ => $info{$_} }
+ map { $_ => $info{$_} }
sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
keys %info;
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>.