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   return;
 134 }
 135
 136 =item delete
 137
 138 Delete this record from the database.
 139
 140 If this is a supplemental package link, deleting it will set pkglinknum = null
 141 for any related packages, and set those packages to expire on their next bill
 142 date.
 143
 144 =cut
 145
 146 my $cancel_reason_text = 'Supplemental package removed';
 147 my $cancel_reason_type = 'Cancel Reason';
 148
 149 sub delete {
 150   my $oldAutoCommit = $FS::UID::AutoCommit;
 151   local $FS::UID::AutoCommit = 0;
 152   my $dbh = dbh;
 153
 154   my $self = shift;
 155
 156   if ( $self->link_type eq 'supp' ) {
 157     my $error = $self->remove_linked;
 158     if ( $error ) {
 159       $dbh->rollback if $oldAutoCommit;
 160       return $error;
 161     }
 162   }
 163
 164   my $error = $self->SUPER::delete(@_);
 165   if ( $error ) {
 166     $dbh->rollback if $oldAutoCommit;
 167     return $error;
 168   }
 169   $dbh->commit;
 170   return;
 171 }
 172
 173 =item remove_linked
 174
 175 Removes any supplemental packages that were created by this link, by canceling
 176 them and setting their pkglinknum to null. This should be done in preparation
 177 for removing the link itself.
 178
 179 =cut
 180
 181 sub remove_linked {
 182   my $self = shift;
 183   my $pkglinknum = $self->pkglinknum;
 184   my $error;
 185
 186   # find linked packages
 187   my @pkgs = qsearch('cust_pkg', { pkglinknum => $pkglinknum });
 188   warn "expiring ".scalar(@pkgs).
 189        " linked packages from part_pkg_link #$pkglinknum\n";
 190
 191   my $reason = FS::reason->new_or_existing(
 192     class => 'C',
 193     type => $cancel_reason_type,
 194     reason => $cancel_reason_text
 195   );
 196
 197   foreach my $pkg (@pkgs) {
 198     $pkg->set('pkglinknum' => '');
 199     if ( $pkg->get('cancel') ) {
 200       # then just replace it to unlink the package from this object
 201       $error = $pkg->replace;
 202     } else {
 203       $error = $pkg->cancel(
 204         'date'    => $pkg->get('bill'), # cancel on next bill, or else now
 205         'reason'  => $reason->reasonnum,
 206       );
 207     }
 208     if ( $error ) {
 209       return "$error (scheduling package #".$pkg->pkgnum." for expiration)";
 210     }
 211   }
 212 }
 213
 214 =item replace OLD_RECORD
 215
 216 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 217 returns the error, otherwise returns false.
 218
 219 =cut
 220
 221 # the replace method can be inherited from FS::Record
 222
 223 =item check
 224
 225 Checks all fields to make sure this is a valid link.  If there is
 226 an error, returns the error, otherwise returns false.  Called by the insert
 227 and replace methods.
 228
 229 =cut
 230
 231 # the check method should currently be supplied - FS::Record contains some
 232 # data checking routines
 233
 234 sub check {
 235   my $self = shift;
 236
 237   my $error =
 238     $self->ut_numbern('pkglinknum')
 239     || $self->ut_foreign_key('src_pkgpart', 'part_pkg', 'pkgpart')
 240     || $self->ut_foreign_key('dst_pkgpart', 'part_pkg', 'pkgpart')
 241     || $self->ut_enum('link_type', [ 'bill', 'svc', 'supp' ] )
 242     || $self->ut_enum('hidden', [ '', 'Y' ] )
 243   ;
 244   return $error if $error;
 245
 246   if ( $self->link_type eq 'supp' ) {
 247     # some sanity checking
 248     my $src_pkg = $self->src_pkg;
 249     my $dst_pkg = $self->dst_pkg;
 250     if ( $src_pkg->freq eq '0' and $dst_pkg->freq ne '0' ) {
 251       return "One-time charges can't have supplemental packages."
 252     } elsif ( $dst_pkg->freq ne '0' ) {
 253       my $ratio = $dst_pkg->freq / $src_pkg->freq;
 254       if ($ratio != int($ratio)) {
 255         return "Supplemental package period (pkgpart ".$dst_pkg->pkgpart.
 256                ") must be an integer multiple of main package period.";
 257       }
 258     }
 259   }
 260
 261   $self->SUPER::check;
 262 }
 263
 264 =item src_pkg
 265
 266 Returns the source part_pkg object (see L<FS::part_pkg>).
 267
 268 =cut
 269
 270 sub src_pkg {
 271   my $self = shift;
 272   qsearchs('part_pkg', { 'pkgpart' => $self->src_pkgpart } );
 273 }
 274
 275 =item dst_pkg
 276
 277 Returns the source part_pkg object (see L<FS::part_pkg>).
 278
 279 =cut
 280
 281 sub dst_pkg {
 282   my $self = shift;
 283   qsearchs('part_pkg', { 'pkgpart' => $self->dst_pkgpart } );
 284 }
 285
 286 =back
 287
 288 =head1 BUGS
 289
 290 =head1 SEE ALSO
 291
 292 L<FS::Record>, schema.html from the base documentation.
 293
 294 =cut
 295
 296 1;
 297