bin/make-pkg-fruit

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use FS::UID qw( adminsuidsetup );
   5 use FS::Record qw( qsearch qsearchs );
   6 use FS::part_export;
   7 use FS::export_svc;
   8 use FS::pkg_svc;
   9 use FS::part_svc;
  10 use FS::part_pkg;
  11 use FS::cust_svc;
  12 use FS::svc_Common;
  13 use FS::svc_broadband;
  14 use FS::part_svc_router;
  15
  16 my $exporttype = 'prizm';
  17 my $pkg_property = 'pkg';
  18 my $svc_property = 'performance_profile';
  19
  20 my $user = shift or die &usage;
  21
  22 $FS::svc_Common::noexport_hack = 1;
  23 $FS::cust_svc::ignore_quantity = 1;
  24 $FS::UID::AutoCommit = 0;
  25
  26 my $DEBUG = 0;
  27
  28 my $dbh = adminsuidsetup($user);
  29
  30 my @exportnum = map { $_->exportnum }
  31                   qsearch( 'part_export', { 'exporttype' => $exporttype } );
  32
  33 die "no $exporttype exports found\n" unless scalar(@exportnum);
  34
  35 my %pkg_svc_map = ();
  36
  37 my @old_svcpart = ();
  38 push @old_svcpart, map { $_->svcpart }
  39                        qsearch ( 'export_svc', { 'exportnum' => $_ } )
  40                      foreach @exportnum;
  41
  42 die "no svcparts found\n" unless scalar(@old_svcpart);
  43
  44 foreach (@old_svcpart) {
  45   foreach my $pkg_svc ( qsearch( 'pkg_svc',
  46                                  { 'svcpart'  => $_,
  47                                    'quantity' => { 'op'    => '>',
  48                                                    'value' => '0',
  49                                                  },
  50                                  }
  51                                )
  52                       )
  53   {
  54     warn "updating package ". $pkg_svc->pkgpart. "\n" if $DEBUG;
  55     my $pkg_from = $pkg_svc->part_pkg->$pkg_property;
  56     unless ( $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } ) {
  57       my $old_part_svc = $pkg_svc->part_svc;
  58       my $part_svc = new FS::part_svc( { $old_part_svc->hash } );
  59       $part_svc->svcpart('');
  60
  61       my $svcdb = $part_svc->svcdb;
  62       foreach ( $old_part_svc->all_part_svc_column ) {
  63         my $formatter = FS::part_svc->svc_table_fields($svcdb)->{$_}->{format}
  64                         || sub { shift };
  65
  66         $part_svc->setfield( $svcdb.'__'.$_->columnname.'_flag', $_->columnflag);
  67         $part_svc->setfield( $svcdb.'__'.$_->columnname,
  68                              &$formatter($_->columnvalue)
  69                            );
  70       }
  71
  72       my $formatter =
  73         FS::part_svc->svc_table_fields($svcdb)->{$svc_property}->{format}
  74         || sub { shift };
  75       $part_svc->setfield( $svcdb.'__'.$svc_property.'_flag', 'F');
  76       $part_svc->setfield( $svcdb.'__'.$svc_property,
  77                            &$formatter($pkg_svc->part_pkg->$pkg_property)
  78                          );
  79       my $error = $part_svc->insert( [],
  80                                      { map { $_->exportnum => 1 }
  81                                            $old_part_svc->part_export
  82                                      },
  83                                    );
  84       die "error inserting service: $error\n" if $error;
  85
  86       # this part is specific to svc_broadband
  87       foreach (qsearch( 'part_svc_router', { 'svcpart' => $pkg_svc->svcpart } ))
  88       {
  89         my $part_svc_router = new FS::part_svc_router( { $_->hash } );
  90         $part_svc_router->svcrouternum( '' );
  91         $part_svc_router->svcpart( $part_svc->svcpart );
  92         my $error = $part_svc_router->insert;
  93         die "error associating service with router: $error\n" if $error;
  94       }
  95
  96       $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } = $part_svc->svcpart;
  97
  98     }
  99
 100     my $new_pkg_svc = new FS::pkg_svc( { $pkg_svc->hash } );
 101     $new_pkg_svc->svcpart( $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } );
 102     my $error = $pkg_svc->delete;
 103     die "error removing old service from package: $error\n" if $error;
 104     $error = $new_pkg_svc->insert;
 105     die "error adding new service to package: $error\n" if $error;
 106
 107   }
 108 }
 109 warn "done with packages\n" if $DEBUG;
 110
 111 foreach my $svcpart ( @old_svcpart ) {
 112   foreach my $cust_svc ( qsearch( 'cust_svc', { 'svcpart' => $svcpart } ) ) {
 113     my $svc_x = $cust_svc->svc_x;
 114     my $cust_pkg = $cust_svc->cust_pkg;
 115     die "can't handle unattached service ". $cust_svc->svcnum unless $cust_pkg;
 116     my $pkg_from = $cust_pkg->part_pkg->$pkg_property;
 117     $svc_x->setfield( $svc_property, $pkg_from );
 118     $svc_x->setfield( 'svcpart', $pkg_svc_map{ $pkg_from }{ $svcpart } );
 119     my $error = $svc_x->replace;
 120     die "error replacing service ". $svc_x->svcnum. ": $error\n" if $error;
 121
 122     $cust_svc->svcpart( $pkg_svc_map{ $pkg_from }{ $svcpart } );
 123     $error = $cust_svc->replace;
 124     die "error replacing customer service ". $cust_svc->svcnum. ": $error\n"
 125       if $error;
 126   }
 127
 128   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
 129   die "can't find old part_svc!" unless $part_svc;
 130
 131   my $new_part_svc = new FS::part_svc( { $part_svc->hash } );
 132   $new_part_svc->disabled('Y');
 133   my $svcdb = $part_svc->svcdb;
 134   foreach ( $part_svc->all_part_svc_column ) {
 135     my $formatter = FS::part_svc->svc_table_fields($svcdb)->{$_}->{format}
 136                     || sub { shift };
 137
 138     $part_svc->setfield( $svcdb.'__'.$_->columnname.'_flag', $_->columnflag);
 139     $part_svc->setfield( $svcdb.'__'.$_->columnname,
 140                          &$formatter($_->columnvalue)
 141                        );
 142   }
 143   my $error = $new_part_svc->replace($part_svc, '1.3-COMPAT');
 144   die "error disabling service: $error\n" if $error;
 145 }
 146
 147 $dbh->commit or die $dbh->errstr;
 148 $dbh->disconnect or die $dbh->errstr;
 149
 150
 151 sub usage {
 152   die "Usage:\n\n  make-pkg-fruit user\n";
 153 }
 154
 155 =head1 NAME
 156
 157 make-pkg-fruit - Tool to migrate package properties to services
 158
 159 =head1 SYNOPSIS
 160
 161   make-pkg-fruit
 162
 163 =head1 DESCRIPTION
 164
 165 Multiplies out services with package properties and migrates package
 166 definitions and customer services to the new services.  Read the source.
 167
 168 =head1 SEE ALSO
 169
 170 =cut
 171
 172 1;