so Search.tsf and Search.rdf work

[freeside.git] / FS / FS / part_pkg.pm

diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index f2719ce..bf040c8 100644 (file)
--- 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.
 
 Adds this package definition to the database.  If there is an error,
 returns the error, otherwise returns false.
 

-Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg> and
-I<custnum_ref>.
+Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>, 
+I<custnum_ref> and I<options>.

 
 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
 values, appropriate FS::pkg_svc records will be inserted.
 
 If I<pkg_svc> 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<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
 the scalar will be updated with the custnum value from the cust_pkg record.
 
 In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
 the scalar will be updated with the custnum value from the cust_pkg record.
 

+If I<options> is set to a hashref of options, appropriate FS::part_pkg_option
+records will be inserted.
+

 =cut
 
 sub insert {
   my $self = shift;
   my %options = @_;
 =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';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';


@@ -161,7 +166,8 @@ sub insert {
   }
 
   if ( $plandata ) {
   }
 
   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";
     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;
       }
     }
         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;
   }
 
   my $conf = new FS::Conf;


@@ -203,7 +230,10 @@ sub insert {
   my $pkg_svc = $options{'pkg_svc'} || {};
   foreach my $part_svc ( qsearch('part_svc', {} ) ) {
     my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
   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 =
+      ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart )
+        ? 'Y'
+        : '';

 
     my $pkg_svc = new FS::pkg_svc( {
       'pkgpart'     => $self->pkgpart,
 
     my $pkg_svc = new FS::pkg_svc( {
       'pkgpart'     => $self->pkgpart,


@@ -345,6 +375,7 @@ sub replace {
     next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc;
   
     my $new_pkg_svc = new FS::pkg_svc( {
     next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc;
   
     my $new_pkg_svc = new FS::pkg_svc( {

+      'pkgsvcnum'   => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),

       'pkgpart'     => $new->pkgpart,
       'svcpart'     => $part_svc->svcpart,
       'quantity'    => $quantity, 
       'pkgpart'     => $new->pkgpart,
       'svcpart'     => $part_svc->svcpart,
       'quantity'    => $quantity, 


@@ -453,9 +484,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
 
 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<BILL> is
+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)
 returned, otherwise, the single item B<CARD> is returned.
 
 (CHEK?  LEC?  Probably shouldn't accept those by default, prone to abuse)


@@ -464,15 +495,35 @@ returned, otherwise, the single item B<CARD> is returned.
 
 sub payby {
   my $self = shift;
 
 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' );
   }
 }
 
     ( '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",
 =item freq_pretty
 
 Returns an english representation of the I<freq> field, such as "monthly",


@@ -491,6 +542,10 @@ tie %freq, 'Tie::IxHash',
   '6'  => 'semiannually (every 6 months)',
   '12' => 'annually',
   '24' => 'biannually (every 2 years)',
   '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 {
 ;
 
 sub freq_pretty {


@@ -562,7 +617,7 @@ Returns the option value for the given name, or the empty string.
 =cut
 
 sub option {
 =cut
 
 sub option {

-  my( $self, $opt ) = @_;
+  my( $self, $opt, $ornull ) = @_;

   my $part_pkg_option =
     qsearchs('part_pkg_option', {
       pkgpart    => $self->pkgpart,
   my $part_pkg_option =
     qsearchs('part_pkg_option', {
       pkgpart    => $self->pkgpart,


@@ -572,7 +627,8 @@ sub option {
   my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
                      split("\n", $self->get('plandata') );
   return $plandata{$opt} if exists $plandata{$opt};
   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 +680,11 @@ sub _calc_eval {
   $value;
 }
 
   $value;
 }
 

+#fallback that return 0 for old legacy packages with no plan
+
+sub calc_remain { 0; }
+sub calc_cancel { 0; }
+

 =back
 
 =head1 SUBROUTINES
 =back
 
 =head1 SUBROUTINES