X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fpart_pkg.pm;h=f210a67d47fb21b1bd66d9e46257990a54e03c91;hp=67c7c964120fcbbcab3da9700f875296e96238eb;hb=55a68e4aabe10db4d9c3ab1bb8befd2f9f4b9008;hpb=6fe8172b11d0369d0b1274d6825ec0c57afe8001

diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index 67c7c9641..f210a67d4 100644
--- a/FS/FS/part_pkg.pm
+++ b/FS/FS/part_pkg.pm
@@ -2,11 +2,13 @@ package FS::part_pkg;
 
 use strict;
 use vars qw( @ISA %freq %plans $DEBUG );
-use Carp;
+use Carp qw(carp cluck);
 use Tie::IxHash;
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs dbh dbdef );
 use FS::pkg_svc;
+use FS::part_svc;
+use FS::cust_pkg;
 use FS::agent_type;
 use FS::type_pkgs;
 use FS::part_pkg_option;
@@ -54,6 +56,8 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =item comment - Text name of this package definition (non-customer-viewable)
 
+=item promo_code - Promotional code
+
 =item setup - Setup fee expression (deprecated)
 
 =item freq - Frequency of recurring fee
@@ -107,16 +111,34 @@ sub clone {
   new $class ( \%hash ); # ?
 }
 
-=item insert
+=item insert [ , OPTION => VALUE ... ]
 
 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>.
+
+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<primary_svc> is set to the svcpart of the primary service, the appropriate
+FS::pkg_svc record will be updated.
+
+If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
+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.
+
 =cut
 
 sub insert {
   my $self = shift;
-  warn "FS::part_pkg::insert called on $self" if $DEBUG;
+  my %options = @_;
+  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';
@@ -179,6 +201,44 @@ sub insert {
     }
   }
 
+  warn "  inserting pkg_svc records" if $DEBUG;
+  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 $pkg_svc = new FS::pkg_svc( {
+      'pkgpart'     => $self->pkgpart,
+      'svcpart'     => $part_svc->svcpart,
+      'quantity'    => $quantity, 
+      'primary_svc' => $primary_svc,
+    } );
+    my $error = $pkg_svc->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  if ( $options{'cust_pkg'} ) {
+    warn "  updating cust_pkg record " if $DEBUG;
+    my $old_cust_pkg =
+      ref($options{'cust_pkg'})
+        ? $options{'cust_pkg'}
+        : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } );
+    ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum
+      if $options{'custnum_ref'};
+    my %hash = $old_cust_pkg->hash;
+    $hash{'pkgpart'} = $self->pkgpart,
+    my $new_cust_pkg = new FS::cust_pkg \%hash;
+    local($FS::cust_pkg::disable_agentcheck) = 1;
+    my $error = $new_cust_pkg->replace($old_cust_pkg);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error modifying cust_pkg record: $error";
+    }
+  }
+
   warn "  commiting transaction" if $DEBUG;
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
@@ -196,15 +256,27 @@ sub delete {
 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
 }
 
-=item replace OLD_RECORD
+=item replace OLD_RECORD [ , OPTION => VALUE ... ]
 
 Replaces OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
+Currently available options are: I<pkg_svc> and I<primary_svc>
+
+If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
+values, the appropriate FS::pkg_svc records will be replace.
+
+If I<primary_svc> is set to the svcpart of the primary service, the appropriate
+FS::pkg_svc record will be updated.
+
 =cut
 
 sub replace {
   my( $new, $old ) = ( shift, shift );
+  my %options = @_;
+  warn "FS::part_pkg::replace called on $new to replace $old ".
+       "with options %options"
+    if $DEBUG;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -217,9 +289,11 @@ sub replace {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
+  warn "  saving legacy plandata" if $DEBUG;
   my $plandata = $new->get('plandata');
   $new->set('plandata', '');
 
+  warn "  deleting old part_pkg_option records" if $DEBUG;
   foreach my $part_pkg_option ( $old->part_pkg_option ) {
     my $error = $part_pkg_option->delete;
     if ( $error ) {
@@ -228,12 +302,14 @@ sub replace {
     }
   }
 
+  warn "  replacing part_pkg record" if $DEBUG;
   my $error = $new->SUPER::replace($old);
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
   }
 
+  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";
@@ -253,6 +329,39 @@ sub replace {
     }
   }
 
+  warn "  replacing pkg_svc records" if $DEBUG;
+  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 $old_pkg_svc = qsearchs('pkg_svc', {
+      'pkgpart' => $old->pkgpart,
+      'svcpart' => $part_svc->svcpart,
+    } );
+    my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0;
+    my $old_primary_svc =
+      ( $old_pkg_svc && $old_pkg_svc->dbdef_table->column('primary_svc') )
+        ? $old_pkg_svc->primary_svc
+        : '';
+    next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc;
+  
+    my $new_pkg_svc = new FS::pkg_svc( {
+      'pkgpart'     => $new->pkgpart,
+      'svcpart'     => $part_svc->svcpart,
+      'quantity'    => $quantity, 
+      'primary_svc' => $primary_svc,
+    } );
+    my $error = $old_pkg_svc
+                  ? $new_pkg_svc->replace($old_pkg_svc)
+                  : $new_pkg_svc->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  warn "  commiting transaction" if $DEBUG;
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 }
@@ -288,6 +397,7 @@ sub check {
   my $error = $self->ut_numbern('pkgpart')
     || $self->ut_text('pkg')
     || $self->ut_text('comment')
+    || $self->ut_textn('promo_code')
     || $self->ut_alphan('plan')
     || $self->ut_enum('setuptax', [ '', 'Y' ] )
     || $self->ut_enum('recurtax', [ '', 'Y' ] )
@@ -345,9 +455,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<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)
@@ -356,15 +466,35 @@ returned, otherwise, the single item B<CARD> 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<freq> field, such as "monthly",
@@ -454,13 +584,19 @@ Returns the option value for the given name, or the empty string.
 =cut
 
 sub option {
-  my $self = shift;
+  my( $self, $opt, $ornull ) = @_;
   my $part_pkg_option =
     qsearchs('part_pkg_option', {
       pkgpart    => $self->pkgpart,
-      optionname => shift,
+      optionname => $opt,
   } );
-  $part_pkg_option ? $part_pkg_option->optionvalue : '';
+  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