RT# 80624 Selfservice workaround for Bug on Win10 Edge Browser
[freeside.git] / 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