1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
#!/usr/bin/perl
use strict;
use FS::UID qw(adminsuidsetup);
use FS::Record qw(qsearch qsearchs);
use FS::cust_pkg;
use FS::part_pkg;
my $user = shift or die &usage;
my @pkgparts = @ARGV or die &usage;
my $dbh = adminsuidsetup $user;
$FS::UID::AutoCommit = 0;
my %stats = (
mainpkgs => 0,
created => 0,
linked => 0,
errors => 0,
);
my %pkg_freq; # cache
foreach my $pkgpart (@pkgparts) {
my $part_pkg = FS::part_pkg->by_key($pkgpart)
or die "pkgpart $pkgpart not found.\n";
$pkg_freq{$pkgpart} = $part_pkg->freq;
my @links = $part_pkg->supp_part_pkg_link
or die "pkgpart $pkgpart has no supplemental packages.\n";
CUST_PKG: foreach my $cust_pkg (
qsearch('cust_pkg', {
'pkgpart' => $pkgpart,
'cancel' => '',
})
) {
my $cust_main = $cust_pkg->cust_main;
my @existing = $cust_pkg->supplemental_pkgs;
my @active = grep { !$_->main_pkgnum } $cust_main->ncancelled_pkgs;
LINK: foreach my $link (@links) {
# yeah, it's expensive
# see if there's an existing package with this link identity
foreach (@existing) {
if ($_->pkglinknum == $link->pkglinknum) {
next LINK;
}
}
# no? then is there one with this pkgpart?
my $i = 0;
foreach (@active) {
if ( $_->pkgpart == $link->dst_pkgpart ) {
set_link($cust_pkg, $link, $_);
splice(@active, $i, 1); # delete it so we don't reuse it
next LINK;
}
}
# no? then create one
create_linked($cust_pkg, $link);
} #foreach $link
$stats{mainpkgs}++;
} #foreach $cust_pkg
} #foreach $pkgpart
print "
Main packages: $stats{mainpkgs}
Supplemental packages linked: $stats{linked}
Supplemental packages ordered: $stats{created}
Errors: $stats{errors}
";
$dbh->commit or die $dbh->errstr;
sub set_link {
my ($main_pkg, $part_pkg_link, $supp_pkg) = @_;
my $task = "linking package ".$supp_pkg->pkgnum.
" to package ".$main_pkg->pkgnum;
$supp_pkg->set('main_pkgnum', $main_pkg->pkgnum);
$supp_pkg->set('pkglinknum', $part_pkg_link->pkglinknum);
# Set the next bill date of the supplemental package to the nearest one in
# the future that lines up with the main package. If the main package
# hasn't started billing yet, use its future start date.
my $new_bill = $main_pkg->get('bill') || $main_pkg->get('start_date');
if ( $new_bill ) {
my $old_bill = $supp_pkg->get('bill');
my $diff = $new_bill - $old_bill;
my $main_freq = $pkg_freq{$main_pkg->pkgpart};
my $prev_bill = 0;
while ($diff < 0) {
# this will exit once $new_bill has overtaken the existing bill date.
# if there is no existing bill date, then this will exit right away
# and set bill to the bill date of the main package, which is correct.
$prev_bill = $new_bill;
$new_bill = FS::part_pkg->add_freq($new_bill, $main_freq);
$diff = $new_bill - $old_bill;
}
# then, of $new_bill and $prev_bill, pick the one that's closer to $old_bill
if ( $prev_bill > 0 and
$new_bill - $old_bill > $old_bill - $prev_bill ) {
$supp_pkg->set('bill', $prev_bill);
} else {
$supp_pkg->set('bill', $new_bill);
}
} else {
# otherwise the main package hasn't been billed yet and has no
# start date, so we can't sync the supplemental to it yet.
# but we can still link them.
warn "$task: main package has no next bill date.\n";
}
my $error = $supp_pkg->replace;
if ( $error ) {
warn "$task:\n $error\n";
$stats{errors}++;
} else {
$stats{linked}++;
}
return;
}
sub create_linked {
my ($main_pkg, $part_pkg_link) = @_;
my $task = "creating pkgpart ".$part_pkg_link->dst_pkgpart.
" supplemental to package ".$main_pkg->pkgnum;
my $supp_pkg = FS::cust_pkg->new({
'pkgpart' => $part_pkg_link->dst_pkgpart,
'pkglinknum' => $part_pkg_link->pkglinknum,
'custnum' => $main_pkg->custnum,
'main_pkgnum' => $main_pkg->pkgnum,
'locationnum' => $main_pkg->locationnum,
'start_date' => $main_pkg->start_date,
'order_date' => $main_pkg->order_date,
'expire' => $main_pkg->expire,
'adjourn' => $main_pkg->adjourn,
'contract_end' => $main_pkg->contract_end,
'susp' => $main_pkg->susp,
'bill' => $main_pkg->bill,
'refnum' => $main_pkg->refnum,
'discountnum' => $main_pkg->discountnum,
'waive_setup' => $main_pkg->waive_setup,
});
my $error = $supp_pkg->insert;
if ( $error ) {
warn "$task:\n $error\n";
$stats{errors}++;
} else {
$stats{created}++;
}
return;
}
sub usage {
die "Usage:\n fs-migrate-supplemental user main_pkgpart\n";
}
|
