+=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;
+ 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;
+ }
+}
+
+=item freq_pretty
+
+Returns an english representation of the I<freq> field, such as "monthly",
+"weekly", "semi-annually", etc.
+
+=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};
+ } else {
+ my $interval = 'month';
+ if ( $freq =~ /^(\d+)([dw])$/ ) {
+ my %interval = ( '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 "Package definition option $opt not found in options or plandata!\n"
+ unless $ornull;
+ '';
+}
+
+=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;
+ my $class = ref($self). "::$plan";
+ 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;
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item plan_info
+
+=cut
+
+my %info;
+foreach my $INC ( @INC ) {
+ 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"
+ unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck
+ 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;
+}
+
projects / freeside.git / blobdiff