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