X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=8b65ac4bd9162f598ca02ff987a12e7053a5a058;hb=1126f78d0ff7708ade671422d3e6ceae3411241e;hp=d2d74190df1aafd28428c5d4e20e54eb9ce1360a;hpb=058ad19b1b6e139df3a3cfbdbd02263099883907;p=freeside.git

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index d2d74190d..8b65ac4bd 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -17,9 +17,31 @@ use FS::svc_acct;
 use FS::svc_acct_sm;
 use FS::svc_domain;
 use FS::svc_www;
+use FS::svc_forward;
 
 @ISA = qw( FS::Record );
 
+sub _cache {
+  my $self = shift;
+  my ( $hashref, $cache ) = @_;
+  #if ( $hashref->{'pkgpart'} ) {
+  if ( $hashref->{'pkg'} ) {
+    # #@{ $self->{'_pkgnum'} } = ();
+    # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
+    # $self->{'_pkgpart'} = $subcache;
+    # #push @{ $self->{'_pkgnum'} },
+    #   FS::part_pkg->new_or_cached($hashref, $subcache);
+    $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
+  }
+  if ( exists $hashref->{'svcnum'} ) {
+    #@{ $self->{'_pkgnum'} } = ();
+    my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
+    $self->{'_svcnum'} = $subcache;
+    #push @{ $self->{'_pkgnum'} },
+    FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
+  }
+}
+
 =head1 NAME
 
 FS::cust_pkg - Object methods for cust_pkg objects
@@ -49,6 +71,8 @@ FS::cust_pkg - Object methods for cust_pkg objects
 
   @labels = $record->labels;
 
+  $seconds = $record->seconds_since($timestamp);
+
   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
 
@@ -77,6 +101,9 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
 
+=item manual_flag - If this field is set to 1, disables the automatic
+unsuspension of this package when using the B<unsuspendauto> config file.
+
 =back
 
 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
@@ -112,8 +139,13 @@ sub insert {
   my $error = $self->ut_number('custnum');
   return $error if $error;
 
-  return "Unknown customer ". $self->custnum
-    unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+  my $cust_main = $self->cust_main;
+  return "Unknown customer ". $self->custnum unless $cust_main;
+
+  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;
 
@@ -121,15 +153,16 @@ sub insert {
 
 =item delete
 
-Currently unimplemented.  You don't want to delete billing items, because there
-would then be no record the customer ever purchased the item.  Instead, see
-the cancel method.
+This method now works but you probably shouldn't use it.
+
+You don't want to delete billing items, because there would then be no record
+the customer ever purchased the item.  Instead, see the cancel method.
 
 =cut
 
-sub delete {
-  return "Can't delete cust_pkg records!";
-}
+#sub delete {
+#  return "Can't delete cust_pkg records!";
+#}
 
 =item replace OLD_RECORD
 
@@ -155,9 +188,12 @@ sub replace {
 
   #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
   return "Can't change otaker!" if $old->otaker ne $new->otaker;
-  return "Can't change setup once it exists!"
-    if $old->getfield('setup') &&
-       $old->getfield('setup') != $new->getfield('setup');
+
+  #allow this *sigh*
+  #return "Can't change setup once it exists!"
+  #  if $old->getfield('setup') &&
+  #     $old->getfield('setup') != $new->getfield('setup');
+
   #some logic for bill, susp, cancel?
 
   $new->SUPER::replace($old);
@@ -186,17 +222,21 @@ sub check {
   return $error if $error;
 
   if ( $self->custnum ) { 
-    return "Unknown customer"
-      unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+    return "Unknown customer ". $self->custnum unless $self->cust_main;
   }
 
-  return "Unknown pkgpart"
+  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";
   $self->otaker($1);
 
+  if ( $self->dbdef_table->column('manual_flag') ) {
+    $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag";
+    $self->manual_flag($1);
+  }
+
   ''; #no error
 }
 
@@ -228,33 +268,11 @@ sub cancel {
   foreach my $cust_svc (
     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
   ) {
-    my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
-
-    $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
-      $dbh->rollback if $oldAutoCommit;
-      return "Illegal svcdb value in part_svc!";
-    };
-    my $svcdb = $1;
-    require "FS/$svcdb.pm";
+    my $error = $cust_svc->cancel;
 
-    my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
-    if ($svc) {
-      $error = $svc->cancel;
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return "Error cancelling service: $error" 
-      }
-      $error = $svc->delete;
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return "Error deleting service: $error";
-      }
-    }
-
-    $error = $cust_svc->delete;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
-      return "Error deleting cust_svc: $error";
+      return "Error cancelling cust_svc: $error";
     }
 
   }
@@ -410,7 +428,26 @@ L<FS::part_pkg>).
 
 sub part_pkg {
   my $self = shift;
-  qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+  #exists( $self->{'_pkgpart'} )
+  $self->{'_pkgpart'}
+    ? $self->{'_pkgpart'}
+    : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+}
+
+=item cust_svc
+
+Returns the services for this package, as FS::cust_svc objects (see
+L<FS::cust_svc>)
+
+=cut
+
+sub cust_svc {
+  my $self = shift;
+  if ( $self->{'_svcnum'} ) {
+    values %{ $self->{'_svcnum'}->cache };
+  } else {
+    qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+  }
 }
 
 =item labels
@@ -422,7 +459,42 @@ Returns a list of lists, calling the label method for all services
 
 sub labels {
   my $self = shift;
-  map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+  map { [ $_->label ] } $self->cust_svc;
+}
+
+=item cust_main
+
+Returns the parent customer object (see L<FS::cust_main>).
+
+=cut
+
+sub cust_main {
+  my $self = shift;
+  qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+}
+
+=item seconds_since TIMESTAMP
+
+Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
+package have been online since TIMESTAMP.
+
+TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+sub seconds_since {
+  my($self, $since) = @_;
+  my $seconds = 0;
+
+  foreach my $cust_svc (
+    grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
+  ) {
+    $seconds += $cust_svc->seconds_since($since);
+  }
+
+  $seconds;
+
 }
 
 =back
@@ -468,23 +540,20 @@ sub order {
   my(%svcnum);
   # generate %svcnum
   # for those packages being removed:
-  #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
-  # objects (table eq 'cust_svc')
+  #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::cust_svc objects
   my($pkgnum);
   foreach $pkgnum ( @{$remove_pkgnums} ) {
-    my($cust_svc);
-    foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
+    foreach my $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
       push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
     }
   }
   
-  my(@cust_svc);
+  my @cust_svc;
   #generate @cust_svc
   # for those packages the customer is purchasing:
   # @{$pkgparts} is a list of said packages, by pkgpart
   # @cust_svc is a corresponding list of lists of FS::Record objects
-  my($pkgpart);
-  foreach $pkgpart ( @{$pkgparts} ) {
+  foreach my $pkgpart ( @{$pkgparts} ) {
     unless ( $part_pkg{$pkgpart} ) {
       $dbh->rollback if $oldAutoCommit;
       return "Customer not permitted to purchase pkgpart $pkgpart!";
@@ -492,10 +561,49 @@ sub order {
     push @cust_svc, [
       map {
         ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
-      } map { $_->svcpart } qsearch('pkg_svc', { 'pkgpart' => $pkgpart })
+      } map { $_->svcpart }
+          qsearch('pkg_svc', { pkgpart  => $pkgpart,
+                               quantity => { op=>'>', value=>'0', } } )
     ];
   }
 
+  #special-case until this can be handled better
+  # move services to new svcparts - even if the svcparts don't match (svcdb
+  # needs to...)
+  # looks like they're moved in no particular order, ewwwwwwww
+  # and looks like just one of each svcpart can be moved... o well
+
+  #start with still-leftover services
+  #foreach my $svcpart ( grep { scalar(@{ $svcnum{$_} }) } keys %svcnum ) {
+  foreach my $svcpart ( keys %svcnum ) {
+    next unless @{ $svcnum{$svcpart} };
+
+    my $svcdb = $svcnum{$svcpart}->[0]->part_svc->svcdb;
+
+    #find an empty place to put one
+    my $i = 0;
+    foreach my $pkgpart ( @{$pkgparts} ) {
+      my @pkg_svc =
+        qsearch('pkg_svc', { pkgpart  => $pkgpart,
+                             quantity => { op=>'>', value=>'0', } } );
+      #my @pkg_svc =
+      #  grep { $_->quantity > 0 } qsearch('pkg_svc', { pkgpart=>$pkgpart } );
+      if ( ! @{$cust_svc[$i]} #find an empty place to put them with 
+           && grep { $svcdb eq $_->part_svc->svcdb } #with appropriate svcdb
+                @pkg_svc
+      ) {
+        my $new_svcpart =
+          ( grep { $svcdb eq $_->part_svc->svcdb } @pkg_svc )[0]->svcpart; 
+        my $cust_svc = shift @{$svcnum{$svcpart}};
+        $cust_svc->svcpart($new_svcpart);
+        #warn "changing from $svcpart to $new_svcpart!!!\n";
+        $cust_svc[$i] = [ $cust_svc ];
+      }
+      $i++;
+    }
+
+  }
+  
   #check for leftover services
   foreach (keys %svcnum) {
     next unless @{ $svcnum{$_} };
@@ -514,8 +622,7 @@ sub order {
   local $SIG{PIPE} = 'IGNORE'; 
 
   #first cancel old packages
-#  my($pkgnum);
-  foreach $pkgnum ( @{$remove_pkgnums} ) {
+  foreach my $pkgnum ( @{$remove_pkgnums} ) {
     my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
     unless ( $old ) {
       $dbh->rollback if $oldAutoCommit;
@@ -532,7 +639,7 @@ sub order {
   }
 
   #now add new packages, changing cust_svc records if necessary
-#  my($pkgpart);
+  my $pkgpart;
   while ($pkgpart=shift @{$pkgparts} ) {
  
     my $new = new FS::cust_pkg {
@@ -550,8 +657,12 @@ sub order {
     foreach my $cust_svc ( @{ shift @cust_svc } ) {
       my(%hash) = $cust_svc->hash;
       $hash{'pkgnum'}=$pkgnum;
-      my($new) = new FS::cust_svc ( \%hash );
-      my($error)=$new->replace($cust_svc);
+      my $new = new FS::cust_svc ( \%hash );
+
+      #avoid Record diffing missing changed svcpart field from above.
+      my $old = qsearchs('cust_svc', { 'svcnum' => $cust_svc->svcnum } );
+
+      my $error = $new->replace($old);
       if ( $error ) {
         $dbh->rollback if $oldAutoCommit;
         return "Couldn't link old service to new package: $error";
@@ -568,7 +679,7 @@ sub order {
 
 =head1 VERSION
 
-$Id: cust_pkg.pm,v 1.8 2001-10-09 03:11:50 ivan Exp $
+$Id: cust_pkg.pm,v 1.22 2002-05-22 12:17:06 ivan Exp $
 
 =head1 BUGS
 
@@ -590,8 +701,8 @@ moved to check ?
 
 =head1 SEE ALSO
 
-L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
-, L<FS::pkg_svc>, schema.html from the base documentation
+L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
+L<FS::pkg_svc>, schema.html from the base documentation
 
 =cut