4 use FS::UID qw(adminsuidsetup);
5 use FS::Record qw(qsearch qsearchs);
9 my $user = shift or die &usage;
10 my @pkgparts = @ARGV or die &usage;
11 my $dbh = adminsuidsetup $user;
13 $FS::UID::AutoCommit = 0;
23 foreach my $pkgpart (@pkgparts) {
24 my $part_pkg = FS::part_pkg->by_key($pkgpart)
25 or die "pkgpart $pkgpart not found.\n";
26 $pkg_freq{$pkgpart} = $part_pkg->freq;
27 my @links = $part_pkg->supp_part_pkg_link
28 or die "pkgpart $pkgpart has no supplemental packages.\n";
29 CUST_PKG: foreach my $cust_pkg (
31 'pkgpart' => $pkgpart,
35 my $cust_main = $cust_pkg->cust_main;
36 my @existing = $cust_pkg->supplemental_pkgs;
37 my @active = grep { !$_->main_pkgnum } $cust_main->ncancelled_pkgs;
38 LINK: foreach my $link (@links) {
39 # yeah, it's expensive
40 # see if there's an existing package with this link identity
42 if ($_->pkglinknum == $link->pkglinknum) {
46 # no? then is there one with this pkgpart?
49 if ( $_->pkgpart == $link->dst_pkgpart ) {
50 set_link($cust_pkg, $link, $_);
51 splice(@active, $i, 1); # delete it so we don't reuse it
56 create_linked($cust_pkg, $link);
63 Main packages: $stats{mainpkgs}
64 Supplemental packages linked: $stats{linked}
65 Supplemental packages ordered: $stats{created}
66 Errors: $stats{errors}
69 $dbh->commit or die $dbh->errstr;
72 my ($main_pkg, $part_pkg_link, $supp_pkg) = @_;
73 my $task = "linking package ".$supp_pkg->pkgnum.
74 " to package ".$main_pkg->pkgnum;
75 $supp_pkg->set('main_pkgnum', $main_pkg->pkgnum);
76 $supp_pkg->set('pkglinknum', $part_pkg_link->pkglinknum);
77 # Set the next bill date of the supplemental package to the nearest one in
78 # the future that lines up with the main package. If the main package
79 # hasn't started billing yet, use its future start date.
80 my $new_bill = $main_pkg->get('bill') || $main_pkg->get('start_date');
82 my $old_bill = $supp_pkg->get('bill');
83 my $diff = $new_bill - $old_bill;
84 my $main_freq = $pkg_freq{$main_pkg->pkgpart};
87 # this will exit once $new_bill has overtaken the existing bill date.
88 # if there is no existing bill date, then this will exit right away
89 # and set bill to the bill date of the main package, which is correct.
90 $prev_bill = $new_bill;
91 $new_bill = FS::part_pkg->add_freq($new_bill, $main_freq);
92 $diff = $new_bill - $old_bill;
94 # then, of $new_bill and $prev_bill, pick the one that's closer to $old_bill
95 if ( $prev_bill > 0 and
96 $new_bill - $old_bill > $old_bill - $prev_bill ) {
97 $supp_pkg->set('bill', $prev_bill);
99 $supp_pkg->set('bill', $new_bill);
102 # otherwise the main package hasn't been billed yet and has no
103 # start date, so we can't sync the supplemental to it yet.
104 # but we can still link them.
105 warn "$task: main package has no next bill date.\n";
107 my $error = $supp_pkg->replace;
109 warn "$task:\n $error\n";
118 my ($main_pkg, $part_pkg_link) = @_;
119 my $task = "creating pkgpart ".$part_pkg_link->dst_pkgpart.
120 " supplemental to package ".$main_pkg->pkgnum;
121 my $supp_pkg = FS::cust_pkg->new({
122 'pkgpart' => $part_pkg_link->dst_pkgpart,
123 'pkglinknum' => $part_pkg_link->pkglinknum,
124 'custnum' => $main_pkg->custnum,
125 'main_pkgnum' => $main_pkg->pkgnum,
126 'locationnum' => $main_pkg->locationnum,
127 'start_date' => $main_pkg->start_date,
128 'order_date' => $main_pkg->order_date,
129 'expire' => $main_pkg->expire,
130 'adjourn' => $main_pkg->adjourn,
131 'contract_end' => $main_pkg->contract_end,
132 'susp' => $main_pkg->susp,
133 'bill' => $main_pkg->bill,
134 'refnum' => $main_pkg->refnum,
135 'discountnum' => $main_pkg->discountnum,
136 'waive_setup' => $main_pkg->waive_setup,
138 my $error = $supp_pkg->insert;
140 warn "$task:\n $error\n";
149 die "Usage:\n fs-migrate-supplemental user main_pkgpart\n";