4 use FS::UID qw( adminsuidsetup );
5 use FS::Record qw( qsearch qsearchs );
13 use FS::svc_broadband;
14 use FS::part_svc_router;
16 my $exporttype = 'prizm';
17 my $pkg_property = 'pkg';
18 my $svc_property = 'performance_profile';
20 my $user = shift or die &usage;
22 $FS::svc_Common::noexport_hack = 1;
23 $FS::cust_svc::ignore_quantity = 1;
24 $FS::UID::AutoCommit = 0;
28 my $dbh = adminsuidsetup($user);
30 my @exportnum = map { $_->exportnum }
31 qsearch( 'part_export', { 'exporttype' => $exporttype } );
33 die "no $exporttype exports found\n" unless scalar(@exportnum);
38 push @old_svcpart, map { $_->svcpart }
39 qsearch ( 'export_svc', { 'exportnum' => $_ } )
42 die "no svcparts found\n" unless scalar(@old_svcpart);
44 foreach (@old_svcpart) {
45 foreach my $pkg_svc ( qsearch( 'pkg_svc',
47 'quantity' => { 'op' => '>',
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('');
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}
66 $part_svc->setfield( $svcdb.'__'.$_->columnname.'_flag', $_->columnflag);
67 $part_svc->setfield( $svcdb.'__'.$_->columnname,
68 &$formatter($_->columnvalue)
73 FS::part_svc->svc_table_fields($svcdb)->{$svc_property}->{format}
75 $part_svc->setfield( $svcdb.'__'.$svc_property.'_flag', 'F');
76 $part_svc->setfield( $svcdb.'__'.$svc_property,
77 &$formatter($pkg_svc->part_pkg->$pkg_property)
79 my $error = $part_svc->insert( [],
80 { map { $_->exportnum => 1 }
81 $old_part_svc->part_export
84 die "error inserting service: $error\n" if $error;
86 # this part is specific to svc_broadband
87 foreach (qsearch( 'part_svc_router', { 'svcpart' => $pkg_svc->svcpart } ))
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;
96 $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } = $part_svc->svcpart;
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;
109 warn "done with packages\n" if $DEBUG;
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;
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"
128 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
129 die "can't find old part_svc!" unless $part_svc;
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}
138 $part_svc->setfield( $svcdb.'__'.$_->columnname.'_flag', $_->columnflag);
139 $part_svc->setfield( $svcdb.'__'.$_->columnname,
140 &$formatter($_->columnvalue)
143 my $error = $new_part_svc->replace($part_svc, '1.3-COMPAT');
144 die "error disabling service: $error\n" if $error;
147 $dbh->commit or die $dbh->errstr;
148 $dbh->disconnect or die $dbh->errstr;
152 die "Usage:\n\n make-pkg-fruit user\n";
157 make-pkg-fruit - Tool to migrate package properties to services
165 Multiplies out services with package properties and migrates package
166 definitions and customer services to the new services. Read the source.