package FS::part_pkg;
use strict;
-use vars qw( @ISA %freq %plans $DEBUG );
-use Carp qw(carp cluck);
+use vars qw( @ISA %plans $DEBUG );
+use Carp qw(carp cluck confess);
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;
-@ISA = qw( FS::Record );
+@ISA = qw( FS::m2m_Common FS::Record ); # FS::option_Common ); # this can use option_Common
+ # when all the plandata bs is
+ # gone
$DEBUG = 0;
=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
Adds this package definition to the database. If there is an error,
returns the error, otherwise returns false.
-Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg> and
-I<custnum_ref>.
+Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>,
+I<custnum_ref> and I<options>.
If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
values, appropriate FS::pkg_svc records will be inserted.
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<options> is set to a hashref of options, appropriate FS::part_pkg_option
+records will be inserted.
+
=cut
sub insert {
my $self = shift;
my %options = @_;
- warn "FS::part_pkg::insert called on $self with options %options" if $DEBUG;
+ warn "FS::part_pkg::insert called on $self with options ".
+ join(', ', map "$_=>$options{$_}", keys %options)
+ if $DEBUG;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
}
if ( $plandata ) {
- warn " inserting part_pkg_option records for plandata" if $DEBUG;
+
+ 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";
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;
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'} && $options{'primary_svc'}==$part_svc->svcpart )
+ ? 'Y'
+ : '';
my $pkg_svc = new FS::pkg_svc( {
'pkgpart' => $self->pkgpart,
sub replace {
my( $new, $old ) = ( shift, shift );
my %options = @_;
+
+ # We absolutely have to have an old vs. new record to make this work.
+ if (!defined($old)) {
+ $old = qsearchs( 'part_pkg', { 'pkgpart' => $new->pkgpart } );
+ }
+
warn "FS::part_pkg::replace called on $new to replace $old ".
"with options %options"
if $DEBUG;
next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc;
my $new_pkg_svc = new FS::pkg_svc( {
+ 'pkgsvcnum' => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
'pkgpart' => $new->pkgpart,
'svcpart' => $part_svc->svcpart,
'quantity' => $quantity,
my $error = $self->ut_number('freq');
return $error if $error;
} else {
- $self->freq =~ /^(\d+[dw]?)$/
+ $self->freq =~ /^(\d+[hdw]?)$/
or return "Illegal or empty freq: ". $self->freq;
$self->freq($1);
}
|| $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_agentnum_acl('agentnum', 'Edit global package definitions')
|| $self->SUPER::check
;
return $error if $error;
+ if ( $self->classnum !~ /^$/ ) {
+ my $error = $self->ut_foreign_key('classnum', 'pkg_class', 'classnum');
+ return $error if $error;
+ } else {
+ $self->classnum('');
+ }
+
return 'Unknown plan '. $self->plan
unless exists($plans{$self->plan});
+ my $conf = new FS::Conf;
+ return 'Taxclass is required'
+ if ! $self->taxclass && $conf->exists('require_taxclasses');
+
'';
}
+=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 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
Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
}
}
+
+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)',
- '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)',
-;
-
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+)([dw])$/ ) {
- my %interval = ( 'd'=>'day', 'w'=>'week' );
+ if ( $freq =~ /^(\d+)([hdw])$/ ) {
+ my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
$interval = $interval{$2};
}
if ( $1 == 1 ) {
=cut
sub option {
- my( $self, $opt ) = @_;
+ my( $self, $opt, $ornull ) = @_;
my $part_pkg_option =
qsearchs('part_pkg_option', {
pkgpart => $self->pkgpart,
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 part_pkg_taxoverride
+
+Returns all options as 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 part_pkg_taxrate {
+ my $self = shift;
+ my ($data_provider, $geocode) = @_;
+
+ my $dbh = dbh;
+ # CCH oddness in m2m
+ my $extra_sql = 'AND ('.
+ join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
+ qw(10 5 2)
+ ).
+ ')';
+ my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
+ my $select = 'DISTINCT ON(taxclassnum) *';
+
+ qsearch( { 'table' => 'part_pkg_taxrate',
+ 'select' => 'distinct on(taxclassnum) *',
+ 'hashref' => { 'data_provider' => $data_provider,
+ 'taxproductnum' => $self->taxproductnum,
+ },
+ 'extra_sql' => $extra_sql,
+ 'order_by' => $order_by,
+ } );
+}
+
=item _rebless
Reblesses the object into the FS::part_pkg::PLAN class (if available), where
sub _rebless {
my $self = shift;
my $plan = $self->plan;
+ unless ( $plan ) {
+ confess "no price plan found for pkgpart ". $self->pkgpart. "\n"
+ if $DEBUG;
+ return $self;
+ }
+ return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
my $class = ref($self). "::$plan";
+ warn "reblessing $self into $class" if $DEBUG;
eval "use $class;";
- #die $@ if $@;
+ die $@ if $@;
bless($self, $class) unless $@;
$self;
}
$value;
}
+#fallback that return 0 for old legacy packages with no plan
+
+sub calc_remain { 0; }
+sub calc_cancel { 0; }
+
=back
=head1 SUBROUTINES
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 "attempting to load plan info from $file\n" if $DEBUG;
$file =~ /\/(\w+)\.pm$/ or do {
\%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
-A module should be added in FS/FS/part_pkg/ (an example may be found in
-eg/plan_template.pm)
+A module should be added in FS/FS/part_pkg/ Eventually, an example may be
+found in eg/plan_template.pm. Until then, it is suggested that you use the
+other modules in FS/FS/part_pkg/ as a guide.
=head1 BUGS
The delete method is unimplemented.
setup and recur semantics are not yet defined (and are implemented in
-FS::cust_bill. hmm.).
+FS::cust_bill. hmm.). now they're deprecated and need to go.
+
+plandata should go
=head1 SEE ALSO
projects / freeside.git / blobdiff