add northern cyprus, RT#39335
[freeside.git] / 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;