+sub pkg_comment {
+ my $self = shift;
+ my %opt = @_;
+
+ #$self->pkg. ' - '. $self->comment;
+ #$self->pkg. ' ('. $self->comment. ')';
+ my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
+ my $custom_comment = $self->custom_comment(%opt);
+ $pre. $self->pkg. ( $custom_comment ? " - $custom_comment" : '' );
+}
+
+#without price info (so without hitting the DB again)
+sub pkg_comment_only {
+ my $self = shift;
+ my %opt = @_;
+
+ my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
+ my $comment = $self->comment;
+ $pre. $self->pkg. ( $comment ? " - $comment" : '' );
+}
+
+sub price_info { # safety, in case a part_pkg hasn't defined price_info
+ '';
+}
+
+sub custom_comment {
+ my $self = shift;
+ my $price_info = $self->price_info(@_);
+ ( $self->custom ? '(CUSTOM) ' : '' ).
+ $self->comment.
+ ( ($self->custom || $self->comment) ? ' - ' : '' ).
+ ($price_info || 'No charge');
+}
+
+sub pkg_price_info {
+ my $self = shift;
+ $self->pkg. ' - '. ($self->price_info || 'No charge');
+}
+
+=item pkg_class
+
+Returns the package class, as an FS::pkg_class object, or the empty string
+if there is no package class.
+
+=item addon_pkg_class
+
+Returns the add-on package class, as an FS::pkg_class object, or the empty
+string if there is no add-on package class.
+
+=cut
+
+sub addon_pkg_class {
+ my $self = shift;
+ if ( $self->addon_classnum ) {
+ qsearchs('pkg_class', { 'classnum' => $self->addon_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 addon_classname
+
+Returns the add-on package class name, or the empty string if there is no
+add-on package class.
+
+=cut
+
+sub addon_classname {
+ my $self = shift;
+ my $pkg_class = $self->addon_pkg_class;
+ $pkg_class
+ ? $pkg_class->classname
+ : '';
+}
+
+=item agent
+
+Returns the associated agent for this event, if any, as an FS::agent object.
+
+=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
+
+=item type_pkgs
+
+Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
+definition.
+
+=cut
+
+sub pkg_svc {
+ my $self = shift;
+
+ return @{ $cache_pkg_svc{$self->pkgpart} }
+ if $cache_enabled && $cache_pkg_svc{$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 => $_ } $self->_pkg_svc;
+
+ unless ( $opt->{disable_linked} ) {
+ foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
+ my @pkg_svc = $dst_pkg->_pkg_svc;
+ 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;
+ }
+ }
+ }
+ }
+
+ my @pkg_svc = values(%pkg_svc);
+
+ $cache_pkg_svc{$self->pkgpart} = \@pkg_svc if $cache_enabled;
+
+ @pkg_svc;
+
+}
+
+sub _pkg_svc {
+ my $self = shift;
+ grep { $_->quantity }
+ qsearch({
+ 'select' => 'pkg_svc.*, part_svc.*',
+ 'table' => 'pkg_svc',
+ 'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
+ 'hashref' => { 'pkgpart' => $self->pkgpart },
+ });
+}
+
+=item svcpart [ SVCDB ]
+
+Returns the svcpart of the primary service definition (see L<FS::part_svc>)
+associated with this package definition (see L<FS::pkg_svc>). Returns
+false if there not a primary service definition or exactly one service
+definition with quantity 1, or if SVCDB is specified and does not match the
+svcdb of the service definition. SVCDB can be specified as a scalar table
+name, such as 'svc_acct', or as an arrayref of possible table names.
+
+=cut
+
+sub svcpart {
+ my $pkg_svc = shift->_primary_pkg_svc(@_);
+ $pkg_svc ? $pkg_svc->svcpart : '';
+}
+
+=item part_svc [ SVCDB ]
+
+Like the B<svcpart> method, but returns the FS::part_svc object (see
+L<FS::part_svc>).
+
+=cut
+
+sub part_svc {
+ my $pkg_svc = shift->_primary_pkg_svc(@_);
+ $pkg_svc ? $pkg_svc->part_svc : '';
+}
+
+sub _primary_pkg_svc {
+ my $self = shift;
+
+ my $svcdb = scalar(@_) ? shift : [];
+ $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
+ my %svcdb = map { $_=>1 } @$svcdb;
+
+ my @svcdb_pkg_svc =
+ grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
+ $self->pkg_svc;
+
+ my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
+ @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
+ unless @pkg_svc;
+ return '' if scalar(@pkg_svc) != 1;
+ $pkg_svc[0];
+}
+
+=item svcpart_unique_svcdb SVCDB
+
+Returns the svcpart of a service definition (see L<FS::part_svc>) matching
+SVCDB associated with this package definition (see L<FS::pkg_svc>). Returns
+false if there not a primary service definition for SVCDB or there are multiple
+service definitions for SVCDB.
+
+=cut
+
+sub svcpart_unique_svcdb {
+ my( $self, $svcdb ) = @_;
+ my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
+ return '' if scalar(@svcdb_pkg_svc) != 1;
+ $svcdb_pkg_svc[0]->svcpart;
+}
+
+=item payby
+
+Returns a list of the acceptable payment types for this package. Eventually
+this should come out of a database table and be editable, but currently has the
+following logic instead:
+
+If the package is free, the single item B<BILL> is
+returned, otherwise, the single item B<CARD> is returned.
+
+(CHEK? LEC? Probably shouldn't accept those by default, prone to abuse)
+
+=cut
+
+sub payby {
+ my $self = shift;
+ if ( $self->is_free ) {
+ ( 'BILL' );
+ } else {
+ ( 'CARD' );
+ }
+}
+
+=item is_free
+
+Returns true if this package is free.
+
+=cut
+
+sub is_free {
+ my $self = shift;
+ if ( $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;
+ }
+}
+
+# whether the plan allows discounts to be applied to this package
+sub can_discount { 0; }
+
+# whether the plan allows changing the start date
+sub can_start_date {
+ my $self = shift;
+ $self->start_on_hold ? 0 : 1;
+}
+
+# whether the plan supports part_pkg_usageprice add-ons (a specific kind of
+# pre-selectable usage pricing, there's others this doesn't refer to)
+sub can_usageprice { 0; }
+
+# the delay start date if present
+sub delay_start_date {
+ my $self = shift;
+
+ my $delay = $self->delay_start or return '';
+
+ # avoid timelocal silliness
+ my $dt = DateTime->today(time_zone => 'local');
+ $dt->add(days => $delay);
+ $dt->epoch;
+}
+
+sub can_currency_exchange { 0; }
+
+sub freqs_href {
+ # moved to FS::Misc to make this accessible to other packages
+ # at initialization
+ FS::Misc::pkg_freqs();
+}
+
+=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 add_freq TIMESTAMP [ FREQ ]
+
+Adds a billing period of some frequency to the provided timestamp and
+returns the resulting timestamp, or -1 if the frequency could not be
+parsed (shouldn't happen). By default, the frequency of this package
+will be used; to override this, pass a different frequency as a second
+argument.
+
+=cut
+
+sub add_freq {
+ my( $self, $date, $freq ) = @_;
+ $freq = $self->freq unless $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 ( $freq =~ /^\d+$/ ) {
+ $mon += $freq;
+ until ( $mon < 12 ) { $mon -= 12; $year++; }
+
+ $mday = 28 if $mday > 28 && FS::Conf->new->exists('anniversary-rollback');
+
+ } elsif ( $freq =~ /^(\d+)w$/ ) {
+ my $weeks = $1;
+ $mday += $weeks * 7;
+ } elsif ( $freq =~ /^(\d+)d$/ ) {
+ my $days = $1;
+ $mday += $days;
+ } elsif ( $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
+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_vendor
+
+Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
+L<FS::part_pkg_vendor>).
+
+=item vendor_pkg_ids
+
+Returns a list of vendor/external package ids by exportnum
+
+=cut
+
+sub vendor_pkg_ids {
+ my $self = shift;
+ map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
+}
+
+=item part_pkg_option
+
+Returns all options as FS::part_pkg_option objects (see
+L<FS::part_pkg_option>).
+
+=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 [ QUIET ]
+
+Returns the option value for the given name, or the empty string. If a true
+value is passed as the second argument, warnings about missing the option
+will be suppressed.
+
+=cut
+
+sub option {
+ my( $self, $opt, $ornull ) = @_;
+
+ #cache: was pulled up in the original part_pkg query
+ return $self->hashref->{"_opt_$opt"}
+ if exists $self->hashref->{"_opt_$opt"};
+
+ cluck "$self -> option: searching for $opt" if $DEBUG;
+ my $part_pkg_option =