fix quotations, RT#21103
[freeside.git] / bin / fs-migrate-supplemental
1 #!/usr/bin/perl
2
3 use strict;
4 use FS::UID qw(adminsuidsetup);
5 use FS::Record qw(qsearch qsearchs);
6 use FS::cust_pkg;
7 use FS::part_pkg;
8
9 my $user = shift or die &usage;
10 my @pkgparts = @ARGV or die &usage;
11 my $dbh = adminsuidsetup $user;
12
13 $FS::UID::AutoCommit = 0;
14
15 my %stats = (
16   mainpkgs  => 0,
17   created   => 0,
18   linked    => 0,
19   errors    => 0,
20 );
21
22 my %pkg_freq; # cache
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 (
30     qsearch('cust_pkg', {
31         'pkgpart' => $pkgpart,
32         'cancel'  => '',
33     })
34   ) {
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
41       foreach (@existing) {
42         if ($_->pkglinknum == $link->pkglinknum) {
43           next LINK;
44         }
45       }
46       # no? then is there one with this pkgpart?
47       my $i = 0;
48       foreach (@active) {
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
52           next LINK;
53         }
54       }
55       # no? then create one
56       create_linked($cust_pkg, $link);
57     } #foreach $link
58     $stats{mainpkgs}++;
59   } #foreach $cust_pkg
60 } #foreach $pkgpart
61
62 print "
63 Main packages:                 $stats{mainpkgs}
64 Supplemental packages linked:  $stats{linked}
65 Supplemental packages ordered: $stats{created}
66 Errors:                        $stats{errors}
67 ";
68
69 $dbh->commit or die $dbh->errstr;
70
71 sub set_link {
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');
81   if ( $new_bill ) {
82     my $old_bill = $supp_pkg->get('bill');
83     my $diff = $new_bill - $old_bill;
84     my $main_freq = $pkg_freq{$main_pkg->pkgpart};
85     my $prev_bill = 0;
86     while ($diff < 0) {
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;
93     }
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);
98     } else {
99       $supp_pkg->set('bill', $new_bill);
100     }
101   } else {
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";
106   }
107   my $error = $supp_pkg->replace;
108   if ( $error ) {
109     warn "$task:\n    $error\n";
110     $stats{errors}++;
111   } else {
112     $stats{linked}++;
113   }
114   return;
115 }
116
117 sub create_linked {
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,
137   });
138   my $error = $supp_pkg->insert;
139   if ( $error ) {
140     warn "$task:\n    $error\n";
141     $stats{errors}++;
142   } else {
143     $stats{created}++;
144   }
145   return;
146 }
147
148 sub usage {
149   die "Usage:\n  fs-migrate-supplemental user main_pkgpart\n"; 
150 }
151