move part_pkg transactional stuff from web interface to part_pkg.pm, bumps Bug#18...

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

diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index f290420..b6f7912 100644 (file)
--- a/FS/FS/part_pkg.pm
+++ b/FS/FS/part_pkg.pm
@@ -2,8 +2,10 @@ package FS::part_pkg;
 
 use strict;
 use vars qw( @ISA );
 
 use strict;
 use vars qw( @ISA );

-use FS::Record qw( qsearch dbh );
+use FS::Record qw( qsearch dbh dbdef );

 use FS::pkg_svc;
 use FS::pkg_svc;

+use FS::part_svc;
+use FS::cust_pkg;

 use FS::agent_type;
 use FS::type_pkgs;
 use FS::Conf;
 use FS::agent_type;
 use FS::type_pkgs;
 use FS::Conf;


@@ -105,16 +107,33 @@ sub clone {
   new $class ( \%hash ); # ?
 }
 
   new $class ( \%hash ); # ?
 }
 

-=item insert
+=item insert [ , OPTION => VALUE ... ]

 
 Adds this billing item definition to the database.  If there is an error,
 returns the error, otherwise returns false.
 
 
 Adds this billing item 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;
 =cut
 
 sub insert {
   my $self = shift;

-
+  my %options = @_;
+  warn "FS::part_pkg::insert called on $self with options %options" if $DEBUG;
+  

   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE';
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE';


@@ -148,6 +167,45 @@ 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;
 
   '';
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';


@@ -164,11 +222,83 @@ sub delete {
 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
 }
 
 # 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.
 
 
 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';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  warn "  replacing part_pkg record" if $DEBUG;
+  my $error = $new->SUPER::replace($old);
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  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;
+  '';
+}
+

 =item check
 
 Checks all fields to make sure this is a valid billing item definition.  If
 =item check
 
 Checks all fields to make sure this is a valid billing item definition.  If


@@ -180,6 +310,8 @@ insert and replace methods.
 sub check {
   my $self = shift;
 
 sub check {
   my $self = shift;
 

+  for (qw(setup recur)) { $self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
+

   my $conf = new FS::Conf;
   if ( $conf->exists('safe-part_pkg') ) {
 
   my $conf = new FS::Conf;
   if ( $conf->exists('safe-part_pkg') ) {
 


@@ -227,11 +359,19 @@ sub check {
 
   }
 
 
   }
 

+  if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
+    my $error = $self->ut_number('freq');
+    return $error if $error;
+  } else {
+    $self->freq =~ /^(\d+[dw]?)$/
+      or return "Illegal or empty freq: ". $self->freq;
+    $self->freq($1);
+  }
+

     $self->ut_numbern('pkgpart')
       || $self->ut_text('pkg')
       || $self->ut_text('comment')
       || $self->ut_anything('setup')
     $self->ut_numbern('pkgpart')
       || $self->ut_text('pkg')
       || $self->ut_text('comment')
       || $self->ut_anything('setup')

-      || $self->ut_number('freq')

       || $self->ut_anything('recur')
       || $self->ut_alphan('plan')
       || $self->ut_anything('plandata')
       || $self->ut_anything('recur')
       || $self->ut_alphan('plan')
       || $self->ut_anything('plandata')


@@ -256,20 +396,25 @@ sub pkg_svc {
 
 =item svcpart [ SVCDB ]
 
 
 =item svcpart [ SVCDB ]
 

-Returns the svcpart of a single service definition (see L<FS::part_svc>)
+Returns the svcpart of the primary service definition (see L<FS::part_svc>)

 associated with this billing item definition (see L<FS::pkg_svc>).  Returns
 associated with this billing item definition (see L<FS::pkg_svc>).  Returns

-false if there not exactly one service definition with quantity 1, or if 
-SVCDB is specified and does not match the svcdb of the service definition, 
+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, 

 
 =cut
 
 sub svcpart {
   my $self = shift;
 
 =cut
 
 sub svcpart {
   my $self = shift;

-  my $svcdb = shift;
-  my @pkg_svc = $self->pkg_svc;
-  return '' if scalar(@pkg_svc) != 1
-               || $pkg_svc[0]->quantity != 1
-               || ( $svcdb && $pkg_svc[0]->part_svc->svcdb ne $svcdb );
+  my $svcdb = scalar(@_) ? shift : '';
+  my @svcdb_pkg_svc =
+    grep { ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) } $self->pkg_svc;
+  my @pkg_svc = ();
+  @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc
+    if dbdef->table('pkg_svc')->column('primary_svc');
+  @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
+    unless @pkg_svc;
+  return '' if scalar(@pkg_svc) != 1;

   $pkg_svc[0]->svcpart;
 }
 
   $pkg_svc[0]->svcpart;
 }
 


@@ -282,6 +427,8 @@ following logic instead;
 If the package has B<0> setup and B<0> recur, the single item B<BILL> is
 returned, otherwise, the single item B<CARD> is returned.
 
 If the package has B<0> setup and B<0> recur, 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 {
 =cut
 
 sub payby {