include FS::svc_forward in kludgy preload

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

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 9705827..633b322 100644 (file)
--- 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_acct_sm;
 use FS::svc_domain;
 use FS::svc_www;

+use FS::svc_forward;

 
 @ISA = qw( FS::Record );
 
 
 @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
 =head1 NAME
 
 FS::cust_pkg - Object methods for cust_pkg objects


@@ -77,6 +99,9 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
 
 
 =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;
 =back
 
 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;


@@ -100,17 +125,19 @@ 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.
 
 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
 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');
 
   my $error = $self->ut_number('custnum');

-  return $error if $error
+  return $error if $error;

 
 

-  return "Unknown customer"
-    unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+  return "Unknown customer ". $self->custnum unless $self->cust_main;

 
   $self->SUPER::insert;
 
 
   $self->SUPER::insert;
 


@@ -118,15 +145,16 @@ sub insert {
 
 =item delete
 
 
 =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
 
 
 =cut
 

-sub delete {
-  return "Can't delete cust_pkg records!";
-}
+#sub delete {
+#  return "Can't delete cust_pkg records!";
+#}

 
 =item replace OLD_RECORD
 
 
 =item replace OLD_RECORD
 


@@ -152,9 +180,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 (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);
   #some logic for bill, susp, cancel?
 
   $new->SUPER::replace($old);


@@ -183,8 +214,7 @@ sub check {
   return $error if $error;
 
   if ( $self->custnum ) { 
   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"


@@ -194,6 +224,11 @@ sub check {
   $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
   $self->otaker($1);
 
   $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
 }
 
   ''; #no error
 }
 


@@ -407,7 +442,26 @@ L<FS::part_pkg>).
 
 sub part_pkg {
   my $self = shift;
 
 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
 }
 
 =item labels


@@ -419,7 +473,18 @@ Returns a list of lists, calling the label method for all services
 
 sub labels {
   my $self = shift;
 
 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 } );

 }
 
 =back
 }
 
 =back


@@ -428,7 +493,7 @@ sub labels {
 
 =over 4
 
 
 =over 4
 

-=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
+=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]

 
 CUSTNUM is a customer (see L<FS::cust_main>)
 
 
 CUSTNUM is a customer (see L<FS::cust_main>)
 


@@ -439,12 +504,17 @@ permitted.
 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
 new billing items.  An error is returned if this is not possible (see
 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
 new billing items.  An error is returned if this is not possible (see

-L<FS::pkg_svc>).
+L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
+parameter.
+
+RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
+newly-created cust_pkg objects.

 
 =cut
 
 sub order {
 
 =cut
 
 sub order {

-  my($custnum,$pkgparts,$remove_pkgnums)=@_;
+  my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_;
+  $remove_pkgnums = [] unless defined($remove_pkgnums);

 
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
 
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;


@@ -511,7 +581,7 @@ sub order {
     my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
     unless ( $old ) {
       $dbh->rollback if $oldAutoCommit;
     my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
     unless ( $old ) {
       $dbh->rollback if $oldAutoCommit;

-      die "Package $pkgnum not found to remove!";
+      return "Package $pkgnum not found to remove!";

     }
     my(%hash) = $old->hash;
     $hash{'cancel'}=time;   
     }
     my(%hash) = $old->hash;
     $hash{'cancel'}=time;   


@@ -519,7 +589,7 @@ sub order {
     my($error)=$new->replace($old);
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
     my($error)=$new->replace($old);
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;

-      die "Couldn't update package $pkgnum: $error";
+      return "Couldn't update package $pkgnum: $error";

     }
   }
 
     }
   }
 


@@ -527,26 +597,26 @@ sub order {
 #  my($pkgpart);
   while ($pkgpart=shift @{$pkgparts} ) {
  
 #  my($pkgpart);
   while ($pkgpart=shift @{$pkgparts} ) {
  

-    my($new) = new FS::cust_pkg ( {
-                                       'custnum' => $custnum,
-                                       'pkgpart' => $pkgpart,
-                                    } );
-    my($error) = $new->insert;
-   if ( $error ) {
+    my $new = new FS::cust_pkg {
+                                 'custnum' => $custnum,
+                                 'pkgpart' => $pkgpart,
+                               };
+    my $error = $new->insert;
+    if ( $error ) {

       $dbh->rollback if $oldAutoCommit;
       $dbh->rollback if $oldAutoCommit;

-      die "Couldn't insert new cust_pkg record: $error";
+      return "Couldn't insert new cust_pkg record: $error";

     }
     }

-    my($pkgnum)=$new->getfield('pkgnum');
+    push @{$return_cust_pkg}, $new if $return_cust_pkg;
+    my $pkgnum = $new->pkgnum;

  
  

-    my($cust_svc);
-    foreach $cust_svc ( @{ shift @cust_svc } ) {
+    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(%hash) = $cust_svc->hash;
       $hash{'pkgnum'}=$pkgnum;
       my($new) = new FS::cust_svc ( \%hash );
       my($error)=$new->replace($cust_svc);

-     if ( $error ) {
+      if ( $error ) {

         $dbh->rollback if $oldAutoCommit;
         $dbh->rollback if $oldAutoCommit;

-        die "Couldn't link old service to new package: $error";
+        return "Couldn't link old service to new package: $error";

       }
     }
   }  
       }
     }
   }  


@@ -560,7 +630,7 @@ sub order {
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-$Id: cust_pkg.pm,v 1.5 2001-04-09 23:05:15 ivan Exp $
+$Id: cust_pkg.pm,v 1.15 2002-01-21 11:30:17 ivan Exp $

 
 =head1 BUGS
 
 
 =head1 BUGS
 


@@ -577,10 +647,13 @@ cancel } because they use %FS::UID::callback to load configuration values.
 Probably need a subroutine which decides what to do based on whether or not
 we've fetched the user yet, rather than a hash.  See FS::UID and the TODO.
 
 Probably need a subroutine which decides what to do based on whether or not
 we've fetched the user yet, rather than a hash.  See FS::UID and the TODO.
 

+Now that things are transactional should the check in the insert method be
+moved to check ?
+

 =head1 SEE ALSO
 
 =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
 
 
 =cut