X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_pkg.pm;h=ad0bdb41d01b8a0d8a643b5a12771fd01fc5d1f4;hb=94bbd4b650023999262c843bca84affd71a5147d;hp=f2719ce69345f2fcf8520c293fbfeef905a1e5f2;hpb=0250c1ca0ee37edc0370b91b86848c85260a77a6;p=freeside.git diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index f2719ce69..ad0bdb41d 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -116,8 +116,8 @@ sub clone { Adds this package definition to the database. If there is an error, returns the error, otherwise returns false. -Currently available options are: I, I, I and -I. +Currently available options are: I, I, I, +I and I. If I is set to a hashref with svcparts as keys and quantities as values, appropriate FS::pkg_svc records will be inserted. @@ -131,12 +131,17 @@ record itself), the object will be updated to point to this package definition. In conjunction with I, if I is set to a scalar reference, the scalar will be updated with the custnum value from the cust_pkg record. +If I 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'; @@ -161,7 +166,8 @@ sub insert { } 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"; @@ -180,6 +186,27 @@ sub insert { 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; @@ -453,9 +480,9 @@ sub svcpart { 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; +following logic instead: -If the package has B<0> setup and B<0> recur, the single item B is +If the package is free, the single item B is returned, otherwise, the single item B is returned. (CHEK? LEC? Probably shouldn't accept those by default, prone to abuse) @@ -464,15 +491,35 @@ returned, otherwise, the single item B is returned. sub payby { my $self = shift; - #if ( $self->setup == 0 && $self->recur == 0 ) { - if ( $self->setup =~ /^\s*0+(\.0*)?\s*$/ - && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) { + 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 field, such as "monthly", @@ -491,6 +538,10 @@ tie %freq, 'Tie::IxHash', '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 { @@ -562,7 +613,7 @@ Returns the option value for the given name, or the empty string. =cut sub option { - my( $self, $opt ) = @_; + my( $self, $opt, $ornull ) = @_; my $part_pkg_option = qsearchs('part_pkg_option', { pkgpart => $self->pkgpart, @@ -572,7 +623,8 @@ sub 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"; + cluck "Package definition option $opt not found in options or plandata!\n" + unless $ornull; ''; } @@ -624,6 +676,11 @@ sub _calc_eval { $value; } +#fallback that return 0 for old legacy packages with no plan + +sub calc_remain { 0; } +sub calc_cancel { 0; } + =back =head1 SUBROUTINES