don't check that agent is allowed to purchase the package on changes
[freeside.git] / FS / FS / cust_pkg.pm
index d554d8b..630e88e 100644 (file)
@@ -145,32 +145,9 @@ sub table { 'cust_pkg'; }
 Adds this billing item to the database ("Orders" the item).  If there is an
 error, returns the error, otherwise returns false.
 
-=cut
-
-sub insert {
-  my $self = shift;
-
-  # custnum might not have have been defined in sub check (for one-shot new
-  # customers), so check it here instead
-  # (is this still necessary with transactions?)
-
-  my $error = $self->ut_number('custnum');
-  return $error if $error;
-
-  my $cust_main = $self->cust_main;
-  return "Unknown custnum: ". $self->custnum unless $cust_main;
-
-  unless ( $disable_agentcheck ) {
-    my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
-    my $pkgpart_href = $agent->pkgpart_hashref;
-    return "agent ". $agent->agentnum.
-           " can't purchase pkgpart ". $self->pkgpart
-      unless $pkgpart_href->{ $self->pkgpart };
-  }
-
-  $self->SUPER::insert;
-
-}
+If the additional field I<promo_code> is defined instead of I<pkgpart>, it
+will be used to look up the package definition and agent restrictions will be
+ignored.
 
 =item delete
 
@@ -217,6 +194,8 @@ sub replace {
 
   #some logic for bill, susp, cancel?
 
+  local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
+
   $new->SUPER::replace($old);
 }
 
@@ -233,8 +212,8 @@ sub check {
 
   my $error = 
     $self->ut_numbern('pkgnum')
-    || $self->ut_numbern('custnum')
-    || $self->ut_number('pkgpart')
+    || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
+    || $self->ut_numbern('pkgpart')
     || $self->ut_numbern('setup')
     || $self->ut_numbern('bill')
     || $self->ut_numbern('susp')
@@ -242,12 +221,31 @@ sub check {
   ;
   return $error if $error;
 
-  if ( $self->custnum ) { 
-    return "Unknown customer ". $self->custnum unless $self->cust_main;
-  }
+  if ( $self->promo_code ) {
+
+    my $promo_part_pkg =
+      qsearchs('part_pkg', {
+        'pkgpart'    => $self->pkgpart,
+        'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
+      } );
+    return 'Unknown promotional code' unless $promo_part_pkg;
+    $self->pkgpart($promo_part_pkg->pkgpart);
+
+  } else { 
+
+    unless ( $disable_agentcheck ) {
+      my $agent =
+        qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
+      my $pkgpart_href = $agent->pkgpart_hashref;
+      return "agent ". $agent->agentnum.
+             " can't purchase pkgpart ". $self->pkgpart
+        unless $pkgpart_href->{ $self->pkgpart };
+    }
+
+    $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
+    return $error if $error;
 
-  return "Unknown pkgpart: ". $self->pkgpart
-    unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+  }
 
   $self->otaker(getotaker) unless $self->otaker;
   $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker";
@@ -452,7 +450,10 @@ sub unsuspend {
 
   unless ( ! $self->getfield('susp') ) {
     my %hash = $self->hash;
+    my $inactive = time - $hash{'susp'};
     $hash{'susp'} = '';
+    $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
+      if $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);
     if ( $error ) {
@@ -499,20 +500,98 @@ sub part_pkg {
     : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
 }
 
-=item cust_svc
+=item calc_setup
+
+Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
+item.
+
+=cut
+
+sub calc_setup {
+  my $self = shift;
+  $self->part_pkg->calc_setup($self, @_);
+}
+
+=item calc_recur
+
+Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
+item.
+
+=cut
+
+sub calc_recur {
+  my $self = shift;
+  $self->part_pkg->calc_recur($self, @_);
+}
+
+=item cust_svc [ SVCPART ]
 
 Returns the services for this package, as FS::cust_svc objects (see
-L<FS::cust_svc>)
+L<FS::cust_svc>).  If a svcpart is specified, return only the matching
+services.
 
 =cut
 
 sub cust_svc {
   my $self = shift;
-  if ( $self->{'_svcnum'} ) {
-    values %{ $self->{'_svcnum'}->cache };
-  } else {
-    qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+
+  if ( @_ ) {
+    return qsearch( 'cust_svc', { 'pkgnum'  => $self->pkgnum,
+                                  'svcpart' => shift,          } );
   }
+
+  #if ( $self->{'_svcnum'} ) {
+  #  values %{ $self->{'_svcnum'}->cache };
+  #} else {
+    map  { $_->[0] }
+    sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] } 
+    map {
+          my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
+                                               'svcpart' => $_->svcpart     } );
+          [ $_,
+            $pkg_svc ? $pkg_svc->primary_svc : '',
+            $pkg_svc ? $pkg_svc->quantity : 0,
+          ];
+        }
+    qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+  #}
+
+}
+
+=item num_cust_svc [ SVCPART ]
+
+Returns the number of provisioned services for this package.  If a svcpart is
+specified, counts only the matching services.
+
+=cut
+
+sub num_cust_svc {
+  my $self = shift;
+  my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
+  $sql .= ' AND svcpart = ?' if @_;
+  my $sth = dbh->prepare($sql) or die dbh->errstr;
+  $sth->execute($self->pkgnum, @_) or die $sth->errstr;
+  $sth->fetchrow_arrayref->[0];
+}
+
+=item available_part_svc 
+
+Returns a list FS::part_svc objects representing services included in this
+package but not yet provisioned.  Each FS::part_svc object also has an extra
+field, I<num_avail>, which specifies the number of available services.
+
+=cut
+
+sub available_part_svc {
+  my $self = shift;
+  grep { $_->num_avail > 0 }
+    map {
+          my $part_svc = $_->part_svc;
+          $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
+            $_->quantity - $self->num_cust_svc($_->svcpart);
+          $part_svc;
+        }
+      $self->part_pkg->pkg_svc;
 }
 
 =item labels
@@ -654,7 +733,6 @@ sub transfer {
   my $remaining = 0;
   my $dest;
   my %target;
-  my $pkg_svc;
 
   if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
     $dest = $dest_pkgnum;
@@ -665,13 +743,11 @@ sub transfer {
 
   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
 
-  foreach $pkg_svc (qsearch('pkg_svc', { pkgpart => $dest->pkgpart })) {
+  foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
     $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
   }
 
-  my $cust_svc;
-
-  foreach $cust_svc ($dest->cust_svc) {
+  foreach my $cust_svc ($dest->cust_svc) {
     $target{$cust_svc->svcpart}--;
   }
 
@@ -682,9 +758,20 @@ sub transfer {
       next if exists $svcpart2svcparts{$svcpart};
       my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
       $svcpart2svcparts{$svcpart} = [
+        map  { $_->[0] }
+        sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] } 
+        map {
+              my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
+                                                   'svcpart' => $_          } );
+              [ $_,
+                $pkg_svc ? $pkg_svc->primary_svc : '',
+                $pkg_svc ? $pkg_svc->quantity : 0,
+              ];
+            }
+
         grep { $_ != $svcpart }
-          map { $_->svcpart }
-            qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
+        map  { $_->svcpart }
+        qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
       ];
       warn "alternates for svcpart $svcpart: ".
            join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
@@ -692,7 +779,7 @@ sub transfer {
     }
   }
 
-  foreach $cust_svc ($self->cust_svc) {
+  foreach my $cust_svc ($self->cust_svc) {
     if($target{$cust_svc->svcpart} > 0) {
       $target{$cust_svc->svcpart}--;
       my $new = new FS::cust_svc {
@@ -716,7 +803,7 @@ sub transfer {
                            } @{$svcpart2svcparts{$cust_svc->svcpart}};
       if ( @alternate ) {
         warn "alternate(s) found\n" if $DEBUG;
-        my $change_svcpart = $alternate[0]; #arbitrary.
+        my $change_svcpart = $alternate[0];
         $target{$change_svcpart}--;
         my $new = new FS::cust_svc {
           svcnum  => $cust_svc->svcnum,