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 Time::Local qw( timelocal_nocheck );
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;
-@ISA = qw( FS::Record ); # FS::option_Common ); # this can use option_Common
+@ISA = qw( FS::m2m_Common FS::Record ); # FS::option_Common ); # this can use option_Common
# when all the plandata bs is
# gone
=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.
+
=back
=head1 METHODS
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;
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,
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->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_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 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 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)',
- '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+)([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 ) {
}
}
+=item add_freq TIMESTAMP
+
+Adds the frequency of this package to the provided timestamp and returns
+the resulting timestamp, or -1 if the frequency of this package could not be
+parsed (shouldn't happen).
+
+=cut
+
+sub add_freq {
+ my( $self, $date ) = @_;
+ my $freq = $self->freq;
+
+ #change this bit to use Date::Manip? CAREFUL with timezones (see
+ # mailing list archive)
+ my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
+
+ if ( $self->freq =~ /^\d+$/ ) {
+ $mon += $self->freq;
+ until ( $mon < 12 ) { $mon -= 12; $year++; }
+ } elsif ( $self->freq =~ /^(\d+)w$/ ) {
+ my $weeks = $1;
+ $mday += $weeks * 7;
+ } elsif ( $self->freq =~ /^(\d+)d$/ ) {
+ my $days = $1;
+ $mday += $days;
+ } elsif ( $self->freq =~ /^(\d+)h$/ ) {
+ my $hours = $1;
+ $hour += $hours;
+ } else {
+ return -1;
+ }
+
+ timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
+}
+
=item plandata
For backwards compatibility, returns the plandata field as well as all options
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;
'';
}
=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;
}
+#fallback for everything except bulk.pm
+sub hide_svc_detail { 0; }
+
+=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
projects / freeside.git / blobdiff