+=item is_free
+
+Returns true if this package is free.
+
+=cut
+
+sub is_free {
+ my $self = shift;
+ unless ( $self->plan ) {
+ $self->setup =~ /^\s*0+(\.0*)?\s*$/
+ && $self->recur =~ /^\s*0+(\.0*)?\s*$/;
+ } elsif ( $self->can('is_free_options') ) {
+ not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
+ map { $self->option($_) }
+ $self->is_free_options;
+ } else {
+ warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
+ "provides neither is_free_options nor is_free method; returning false";
+ 0;
+ }
+}
+
+
+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",
+"weekly", "semi-annually", etc.
+
+=cut
+
+sub freq_pretty {
+ my $self = shift;
+ my $freq = $self->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 %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
+ $interval = $interval{$2};
+ }
+ if ( $1 == 1 ) {
+ "every $interval";
+ } else {
+ "every $freq ${interval}s";
+ }
+ }
+}
+
+=item plandata
+
+For backwards compatibility, returns the plandata field as well as all options
+from FS::part_pkg_option.
+
+=cut
+
+sub plandata {
+ my $self = shift;
+ carp "plandata is deprecated";
+ if ( @_ ) {
+ $self->SUPER::plandata(@_);
+ } else {
+ my $plandata = $self->get('plandata');
+ my %options = $self->options;
+ $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
+ $plandata;
+ }
+}
+
+=item part_pkg_option
+
+Returns all options as FS::part_pkg_option objects (see
+L<FS::part_pkg_option>).
+
+=cut
+
+sub part_pkg_option {
+ my $self = shift;
+ qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } );
+}
+
+=item options
+
+Returns a list of option names and values suitable for assigning to a hash.
+
+=cut
+
+sub options {
+ my $self = shift;
+ map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
+}
+
+=item option OPTIONNAME
+
+Returns the option value for the given name, or the empty string.
+
+=cut
+
+sub option {
+ my( $self, $opt, $ornull ) = @_;
+ my $part_pkg_option =
+ qsearchs('part_pkg_option', {
+ pkgpart => $self->pkgpart,
+ 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};
+ 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
+PLAN is the object's I<plan> field. There should be better docs
+on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
+
+=cut
+
+sub _rebless {
+ my $self = shift;
+ my $plan = $self->plan;
+ unless ( $plan ) {
+ cluck "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 $@;
+ bless($self, $class) unless $@;
+ $self;
+}
+
+#fallbacks that eval the setup and recur fields, for backwards compat
+
+sub calc_setup {
+ my $self = shift;
+ warn 'no price plan class for '. $self->plan. ", eval-ing setup\n";
+ $self->_calc_eval('setup', @_);
+}
+
+sub calc_recur {
+ my $self = shift;
+ warn 'no price plan class for '. $self->plan. ", eval-ing recur\n";
+ $self->_calc_eval('recur', @_);
+}
+
+use vars qw( $sdate @details );
+sub _calc_eval {
+ #my( $self, $field, $cust_pkg ) = @_;
+ my( $self, $field, $cust_pkg, $sdateref, $detailsref ) = @_;
+ *sdate = $sdateref;
+ *details = $detailsref;
+ $self->$field() =~ /^(.*)$/
+ or die "Illegal $field (pkgpart ". $self->pkgpart. '): '.
+ $self->$field(). "\n";
+ my $prog = $1;
+ return 0 if $prog =~ /^\s*$/;
+ my $value = eval $prog;
+ die $@ if $@;
+ $value;
+}
+
+#fallback that return 0 for old legacy packages with no plan
+
+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
+
+=item plan_info
+
+=cut
+
+#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 "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";
+ next;
+ };
+ my $mod = $1;
+ my $info = eval "use FS::part_pkg::$mod; ".
+ "\\%FS::part_pkg::$mod\::info;";
+ if ( $@ ) {
+ die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
+ next;
+ }
+ unless ( keys %$info ) {
+ 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;
+ if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
+ warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
+ next;
+ }
+ $info{$mod} = $info;
+ }
+}
+
+tie %plans, 'Tie::IxHash',
+ map { $_ => $info{$_} }
+ sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
+ keys %info;
+
+sub plan_info {
+ \%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;
+ }
+}
+
+