a tool for migrating package elements to services

diff --git a/bin/make-pkg-fruit b/bin/make-pkg-fruit
new file mode 100755 (executable)
index 0000000..61d707f
--- /dev/null
+++ b/bin/make-pkg-fruit
@@ -0,0 +1,172 @@
+#!/usr/bin/perl -w
+
+use strict;
+use FS::UID qw( adminsuidsetup );
+use FS::Record qw( qsearch qsearchs );
+use FS::part_export;
+use FS::export_svc;
+use FS::pkg_svc;
+use FS::part_svc;
+use FS::part_pkg;
+use FS::cust_svc;
+use FS::svc_Common;
+use FS::svc_broadband;
+use FS::part_svc_router;
+
+my $exporttype = 'prizm';
+my $pkg_property = 'pkg';
+my $svc_property = 'performance_profile';
+
+my $user = shift or die &usage;
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::cust_svc::ignore_quantity = 1;
+$FS::UID::AutoCommit = 0;
+
+my $DEBUG = 0;
+
+my $dbh = adminsuidsetup($user);
+
+my @exportnum = map { $_->exportnum }
+                  qsearch( 'part_export', { 'exporttype' => $exporttype } );
+
+die "no $exporttype exports found\n" unless scalar(@exportnum);
+
+my %pkg_svc_map = ();
+
+my @old_svcpart = ();
+push @old_svcpart, map { $_->svcpart }
+                       qsearch ( 'export_svc', { 'exportnum' => $_ } )
+                     foreach @exportnum;
+
+die "no svcparts found\n" unless scalar(@old_svcpart);
+
+foreach (@old_svcpart) { 
+  foreach my $pkg_svc ( qsearch( 'pkg_svc',
+                                 { 'svcpart'  => $_,
+                                   'quantity' => { 'op'    => '>',
+                                                   'value' => '0',
+                                                 },
+                                 }
+                               )
+                      )
+  {
+    warn "updating package ". $pkg_svc->pkgpart. "\n" if $DEBUG;
+    my $pkg_from = $pkg_svc->part_pkg->$pkg_property;
+    unless ( $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } ) {
+      my $old_part_svc = $pkg_svc->part_svc;
+      my $part_svc = new FS::part_svc( { $old_part_svc->hash } );
+      $part_svc->svcpart('');
+
+      my $svcdb = $part_svc->svcdb;
+      foreach ( $old_part_svc->all_part_svc_column ) {
+        my $formatter = FS::part_svc->svc_table_fields($svcdb)->{$_}->{format}
+                        || sub { shift };
+
+        $part_svc->setfield( $svcdb.'__'.$_->columnname.'_flag', $_->columnflag);
+        $part_svc->setfield( $svcdb.'__'.$_->columnname,
+                             &$formatter($_->columnvalue)
+                           );
+      }
+
+      my $formatter =
+        FS::part_svc->svc_table_fields($svcdb)->{$svc_property}->{format}
+        || sub { shift };
+      $part_svc->setfield( $svcdb.'__'.$svc_property.'_flag', 'F');
+      $part_svc->setfield( $svcdb.'__'.$svc_property,
+                           &$formatter($pkg_svc->part_pkg->$pkg_property)
+                         );
+      my $error = $part_svc->insert( [],
+                                     { map { $_->exportnum => 1 }
+                                           $old_part_svc->part_export
+                                     },
+                                   );
+      die "error inserting service: $error\n" if $error;
+
+      # this part is specific to svc_broadband
+      foreach (qsearch( 'part_svc_router', { 'svcpart' => $pkg_svc->svcpart } ))
+      {
+        my $part_svc_router = new FS::part_svc_router( { $_->hash } );
+        $part_svc_router->svcrouternum( '' );
+        $part_svc_router->svcpart( $part_svc->svcpart );
+        my $error = $part_svc_router->insert;
+        die "error associating service with router: $error\n" if $error;
+      }
+
+      $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } = $part_svc->svcpart;
+
+    }
+
+    my $new_pkg_svc = new FS::pkg_svc( { $pkg_svc->hash } );
+    $new_pkg_svc->svcpart( $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } );
+    my $error = $pkg_svc->delete;
+    die "error removing old service from package: $error\n" if $error;
+    $error = $new_pkg_svc->insert;
+    die "error adding new service to package: $error\n" if $error;
+
+  }
+}
+warn "done with packages\n" if $DEBUG;
+    
+foreach my $svcpart ( @old_svcpart ) {
+  foreach my $cust_svc ( qsearch( 'cust_svc', { 'svcpart' => $svcpart } ) ) {
+    my $svc_x = $cust_svc->svc_x;
+    my $cust_pkg = $cust_svc->cust_pkg;
+    die "can't handle unattached service ". $cust_svc->svcnum unless $cust_pkg;
+    my $pkg_from = $cust_pkg->part_pkg->$pkg_property;
+    $svc_x->setfield( $svc_property, $pkg_from );
+    $svc_x->setfield( 'svcpart', $pkg_svc_map{ $pkg_from }{ $svcpart } );
+    my $error = $svc_x->replace;
+    die "error replacing service ". $svc_x->svcnum. ": $error\n" if $error;
+
+    $cust_svc->svcpart( $pkg_svc_map{ $pkg_from }{ $svcpart } );
+    $error = $cust_svc->replace;
+    die "error replacing customer service ". $cust_svc->svcnum. ": $error\n"
+      if $error;
+  }
+
+  my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
+  die "can't find old part_svc!" unless $part_svc;
+
+  my $new_part_svc = new FS::part_svc( { $part_svc->hash } );
+  $new_part_svc->disabled('Y');
+  my $svcdb = $part_svc->svcdb;
+  foreach ( $part_svc->all_part_svc_column ) {
+    my $formatter = FS::part_svc->svc_table_fields($svcdb)->{$_}->{format}
+                    || sub { shift };
+
+    $part_svc->setfield( $svcdb.'__'.$_->columnname.'_flag', $_->columnflag);
+    $part_svc->setfield( $svcdb.'__'.$_->columnname,
+                         &$formatter($_->columnvalue)
+                       );
+  }
+  my $error = $new_part_svc->replace($part_svc, '1.3-COMPAT');
+  die "error disabling service: $error\n" if $error;
+}
+  
+$dbh->commit or die $dbh->errstr;
+$dbh->disconnect or die $dbh->errstr;
+
+
+sub usage { 
+  die "Usage:\n\n  make-pkg-fruit user\n";
+}
+
+=head1 NAME
+
+make-pkg-fruit - Tool to migrate package properties to services
+
+=head1 SYNOPSIS
+
+  make-pkg-fruit
+
+=head1 DESCRIPTION
+
+Multiplies out services with package properties and migrates package
+definitions and customer services to the new services.  Read the source.
+
+=head1 SEE ALSO
+
+=cut
+
+1;