FS/FS/part_pkg_link.pm

   1 package FS::part_pkg_link;
   2
   3 use strict;
   4 use vars qw( @ISA );
   5 use FS::Record qw( qsearchs qsearch dbh );
   6 use FS::part_pkg;
   7 use FS::cust_pkg;
   8 use FS::reason;
   9 use FS::reason_type;
  10
  11 @ISA = qw(FS::Record);
  12
  13 =head1 NAME
  14
  15 FS::part_pkg_link - Object methods for part_pkg_link records
  16
  17 =head1 SYNOPSIS
  18
  19   use FS::part_pkg_link;
  20
  21   $record = new FS::part_pkg_link \%hash;
  22   $record = new FS::part_pkg_link { 'column' => 'value' };
  23
  24   $error = $record->insert;
  25
  26   $error = $new_record->replace($old_record);
  27
  28   $error = $record->delete;
  29
  30   $error = $record->check;
  31
  32 =head1 DESCRIPTION
  33
  34 An FS::part_pkg_link object represents an link from one package definition to
  35 another.  FS::part_pkg_link inherits from FS::Record.  The following fields are
  36 currently supported:
  37
  38 =over 4
  39
  40 =item pkglinknum
  41
  42 primary key
  43
  44 =item src_pkgpart
  45
  46 Source package (see L<FS::part_pkg>)
  47
  48 =item dst_pkgpart
  49
  50 Destination package (see L<FS::part_pkg>)
  51
  52 =item link_type
  53
  54 Link type - currently, "bill" (source package bills a line item from target
  55 package), or "svc" (source package includes services from target package),
  56 or "supp" (ordering source package creates a target package).
  57
  58 =item hidden
  59
  60 Flag indicating that this subpackage should be felt, but not seen as an invoice
  61 line item when set to 'Y'.  Not allowed for "supp" links.
  62
  63 =back
  64
  65 =head1 METHODS
  66
  67 =over 4
  68
  69 =item new HASHREF
  70
  71 Creates a new link.  To add the link to the database, see L<"insert">.
  72
  73 Note that this stores the hash reference, not a distinct copy of the hash it
  74 points to.  You can ask the object for a copy with the I<hash> method.
  75
  76 =cut
  77
  78 # the new method can be inherited from FS::Record, if a table method is defined
  79
  80 sub table { 'part_pkg_link'; }
  81
  82 =item insert
  83
  84 Adds this record to the database.  If there is an error, returns the error,
  85 otherwise returns false.
  86
  87 If this is a supplemental package link, inserting it will order the
  88 supplemental packages for any main packages that already exist.
  89
  90 =cut
  91
  92 sub insert {
  93   my $oldAutoCommit = $FS::UID::AutoCommit;
  94   local $FS::UID::AutoCommit = 0;
  95   my $dbh = dbh;
  96
  97   my $self = shift;
  98   my $error = $self->SUPER::insert(@_);
  99   if ( $error ) {
 100     $dbh->rollback if $oldAutoCommit;
 101     return $error if $error;
 102   }
 103
 104   if ( $self->link_type eq 'supp' ) {
 105     # queue this?
 106     my @main_pkgs = qsearch('cust_pkg', {
 107         pkgpart => $self->src_pkgpart,
 108         cancel  => '',
 109     });
 110     foreach my $main_pkg (@main_pkgs) {
 111       # duplicates code in FS::cust_pkg::uncancel, sort of
 112       my $supp_pkg = FS::cust_pkg->new({
 113           'pkgpart'     => $self->dst_pkgpart,
 114           'pkglinknum'  => $self->pkglinknum,
 115           'main_pkgnum' => $main_pkg->pkgnum,
 116           'order_date'  => time,
 117           map { $_ => $main_pkg->get($_) }
 118           qw( custnum locationnum pkgbatch
 119               start_date setup expire adjourn contract_end bill susp
 120               refnum discountnum waive_setup quantity
 121               recur_show_zero setup_show_zero )
 122       });
 123       $error = $supp_pkg->insert;
 124       if ( $error ) {
 125         $dbh->rollback if $oldAutoCommit;
 126         return "$error (ordering new supplemental package to pkg#".$main_pkg->pkgnum.")" if $error;
 127       }
 128     }
 129
 130     return $error if $error;
 131   }
 132
 133   $dbh->commit if $oldAutoCommit;
 134   return;
 135 }
 136
 137 =item delete
 138
 139 Delete this record from the database.
 140
 141 If this is a supplemental package link, deleting it will set pkglinknum = null
 142 for any related packages, and set those packages to expire on their next bill
 143 date.
 144
 145 =cut
 146
 147 my $cancel_reason_text = 'Supplemental package removed';
 148 my $cancel_reason_type = 'Cancel Reason';
 149
 150 sub delete {
 151   my $oldAutoCommit = $FS::UID::AutoCommit;
 152   local $FS::UID::AutoCommit = 0;
 153   my $dbh = dbh;
 154
 155   my $self = shift;
 156
 157   if ( $self->link_type eq 'supp' ) {
 158     my $error = $self->remove_linked;
 159     if ( $error ) {
 160       $dbh->rollback if $oldAutoCommit;
 161       return $error;
 162     }
 163   }
 164
 165   my $error = $self->SUPER::delete(@_);
 166   if ( $error ) {
 167     $dbh->rollback if $oldAutoCommit;
 168     return $error;
 169   }
 170   $dbh->commit if $oldAutoCommit;
 171   return;
 172 }
 173
 174 =item remove_linked
 175
 176 Removes any supplemental packages that were created by this link, by canceling
 177 them and setting their pkglinknum to null. This should be done in preparation
 178 for removing the link itself.
 179
 180 =cut
 181
 182 sub remove_linked {
 183   my $self = shift;
 184   my $pkglinknum = $self->pkglinknum;
 185   my $error;
 186
 187   # find linked packages
 188   my @pkgs = qsearch('cust_pkg', { pkglinknum => $pkglinknum });
 189   warn "expiring ".scalar(@pkgs).
 190        " linked packages from part_pkg_link #$pkglinknum\n";
 191
 192   my $reason = FS::reason->new_or_existing(
 193     class => 'C',
 194     type => $cancel_reason_type,
 195     reason => $cancel_reason_text
 196   );
 197
 198   foreach my $pkg (@pkgs) {
 199     $pkg->set('pkglinknum' => '');
 200     if ( $pkg->get('cancel') ) {
 201       # then just replace it to unlink the package from this object
 202       $error = $pkg->replace;
 203     } else {
 204       $error = $pkg->cancel(
 205         'date'    => $pkg->get('bill'), # cancel on next bill, or else now
 206         'reason'  => $reason->reasonnum,
 207       );
 208     }
 209     if ( $error ) {
 210       return "$error (scheduling package #".$pkg->pkgnum." for expiration)";
 211     }
 212   }
 213 }
 214
 215 =item replace OLD_RECORD
 216
 217 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 218 returns the error, otherwise returns false.
 219
 220 =cut
 221
 222 # the replace method can be inherited from FS::Record
 223
 224 =item check
 225
 226 Checks all fields to make sure this is a valid link.  If there is
 227 an error, returns the error, otherwise returns false.  Called by the insert
 228 and replace methods.
 229
 230 =cut
 231
 232 # the check method should currently be supplied - FS::Record contains some
 233 # data checking routines
 234
 235 sub check {
 236   my $self = shift;
 237
 238   my $error =
 239     $self->ut_numbern('pkglinknum')
 240     || $self->ut_foreign_key('src_pkgpart', 'part_pkg', 'pkgpart')
 241     || $self->ut_foreign_key('dst_pkgpart', 'part_pkg', 'pkgpart')
 242     || $self->ut_enum('link_type', [ 'bill', 'svc', 'supp' ] )
 243     || $self->ut_enum('hidden', [ '', 'Y' ] )
 244   ;
 245   return $error if $error;
 246
 247   if ( $self->link_type eq 'supp' ) {
 248     # some sanity checking
 249     my $src_pkg = $self->src_pkg;
 250     my $dst_pkg = $self->dst_pkg;
 251     if ( $src_pkg->freq eq '0' and $dst_pkg->freq ne '0' ) {
 252       return "One-time charges can't have supplemental packages."
 253     } elsif ( $dst_pkg->freq == 0 ) {
 254       return "The billing period of a supplemental package must be a whole number of months.";
 255     } elsif ( $src_pkg->freq == 0 ) {
 256       return "To have supplemental packages, the billing period of a package must be a whole number of months.";
 257     }
 258   }
 259
 260   $self->SUPER::check;
 261 }
 262
 263 =item src_pkg
 264
 265 Returns the source part_pkg object (see L<FS::part_pkg>).
 266
 267 =cut
 268
 269 sub src_pkg {
 270   my $self = shift;
 271   qsearchs('part_pkg', { 'pkgpart' => $self->src_pkgpart } );
 272 }
 273
 274 =item dst_pkg
 275
 276 Returns the source part_pkg object (see L<FS::part_pkg>).
 277
 278 =cut
 279
 280 sub dst_pkg {
 281   my $self = shift;
 282   qsearchs('part_pkg', { 'pkgpart' => $self->dst_pkgpart } );
 283 }
 284
 285 =back
 286
 287 =head1 BUGS
 288
 289 =head1 SEE ALSO
 290
 291 L<FS::Record>, schema.html from the base documentation.
 292
 293 =cut
 294
 295 1;
 296