*** empty log message ***
[freeside.git] / bin / fs-migrate-svc_acct_sm
1 #!/usr/bin/perl -Tw
2 #
3 # $Id: fs-migrate-svc_acct_sm,v 1.3 2001-08-21 02:43:18 ivan Exp $
4 #
5 # jeff@cmh.net 01-Jul-20
6
7 #to delay loading dbdef until we're ready
8 #BEGIN { $FS::Record::setup_hack = 1; }
9
10 use strict;
11 use Term::Query qw(query);
12 #use DBI;
13 #use DBIx::DBSchema;
14 #use DBIx::DBSchema::Table;
15 #use DBIx::DBSchema::Column;
16 #use DBIx::DBSchema::ColGroup::Unique;
17 #use DBIx::DBSchema::ColGroup::Index;
18 use FS::Conf;
19 use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets);
20 use FS::Record qw(qsearch qsearchs);
21 use FS::svc_domain;
22 use FS::svc_forward;
23 use vars qw( $conf $old_default_domain %part_domain_svc %part_acct_svc %part_forward_svc $svc_acct $svc_acct_sm $error);
24
25 die "Not running uid freeside!" unless checkeuid();
26
27 my $user = shift or die &usage;
28 getsecrets($user);
29
30 $conf = new FS::Conf;
31 $old_default_domain = $conf->config('domain');
32
33 #needs to match FS::Record
34 #my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
35
36 ###
37 # This section would be the appropriate place to manipulate
38 # the schema & tables.
39 ###
40
41 ##  we need to add the domsvc to svc_acct
42 ##  we must add a svc_forward record....
43 ##  I am thinking that the fields  svcnum (int), destsvc (int), and
44 ##  dest (varchar (80))  are appropriate, with destsvc/dest an either/or
45 ##  much in the spirit of cust_main_invoice
46
47 ###
48 # massage the data
49 ###
50
51 my($dbh)=adminsuidsetup $user;
52
53 $|=1;
54
55 $FS::svc_acct::nossh_hack = 1;
56 $FS::svc_forward::nossh_hack = 1;
57 $FS::svc_domain::whois_hack = 1;
58
59 %part_domain_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
60 %part_acct_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
61 %part_forward_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_forward'});
62
63 die "No services with svcdb svc_domain!\n" unless %part_domain_svc;
64 die "No services with svcdb svc_acct!\n" unless %part_acct_svc;
65 die "No services with svcdb svc_forward!\n" unless %part_forward_svc;
66
67 my($svc_domain) = qsearchs('svc_domain', { 'domain' => $old_default_domain });
68 if (! $svc_domain || $svc_domain->domain != $old_default_domain) {
69    print <<EOF;
70
71 Your database currently does not contain a svc_domain record for the
72 domain $old_default_domain.  Would you like me to add one for you?
73 EOF
74
75    my($response)=scalar(<STDIN>);
76    chop $response;
77    if ($response =~ /^[yY]/) {
78       print "\n\n", &menu_domain_svc, "\n", <<END;
79 I need to create new domain accounts.  Which service shall I use for that?
80 END
81       my($domain_svcpart)=&getdomainpart;
82
83       $svc_domain = new FS::svc_domain {
84         'domain' => $old_default_domain,
85         'svcpart' => $domain_svcpart,
86         'action' => 'M',
87        };
88 #      $error=$svc_domain->insert && die "Error adding domain $old_default_domain: $error";
89       $error=$svc_domain->insert;
90       die "Error adding domain $old_default_domain: $error" if $error;
91    }else{
92       print <<EOF;
93
94   This program cannot function properly until a svc_domain record matching
95 your conf_dir/domain file exists.
96 EOF
97
98       exit 1;
99    }
100 }
101
102 print "\n\n", &menu_acct_svc, "\n", <<END;
103 I may need to create some new pop accounts and set up forwarding to them
104 for some users.  Which service shall I use for that?
105 END
106 my($pop_svcpart)=&getacctpart;
107
108 print "\n\n", &menu_forward_svc, "\n", <<END;
109 I may need to create some new forwarding for some users.  Which service
110 shall I use for that?
111 END
112 my($forward_svcpart)=&getforwardpart;
113
114 sub menu_domain_svc {
115   ( join "\n", map "$_: ".$part_domain_svc{$_}->svc, sort keys %part_domain_svc ). "\n";
116 }
117 sub menu_acct_svc {
118   ( join "\n", map "$_: ".$part_acct_svc{$_}->svc, sort keys %part_acct_svc ). "\n";
119 }
120 sub menu_forward_svc {
121   ( join "\n", map "$_: ".$part_forward_svc{$_}->svc, sort keys %part_forward_svc ). "\n";
122 }
123 sub getdomainpart {
124   $^W=0; # Term::Query isn't -w-safe
125   my $return = query "Enter part number:", 'irk', [ keys %part_domain_svc ];
126   $^W=1;
127   $return;
128 }
129 sub getacctpart {
130   $^W=0; # Term::Query isn't -w-safe
131   my $return = query "Enter part number:", 'irk', [ keys %part_acct_svc ];
132   $^W=1;
133   $return;
134 }
135 sub getforwardpart {
136   $^W=0; # Term::Query isn't -w-safe
137   my $return = query "Enter part number:", 'irk', [ keys %part_forward_svc ];
138   $^W=1;
139   $return;
140 }
141
142
143 #migrate data
144
145 my(@svc_accts) = qsearch('svc_acct', {});
146 foreach $svc_acct (@svc_accts) {
147   my(@svc_acct_sms) = qsearch('svc_acct_sm', {
148       domuid => $svc_acct->getfield('uid'),
149       }
150     );
151
152   #  Ok.. we've got the svc_acct record, and an array of svc_acct_sm's
153   #  What do we do from here?
154
155   #  The intuitive:
156   #    plop the svc_acct into the 'default domain'
157   #    and then represent the svc_acct_sm's with svc_forwards
158   #    they can be gussied up manually, later
159   #
160   #  Perhaps better:
161   #    when no svc_acct_sm exists, place svc_acct in 'default domain'
162   #    when one svc_acct_sm exists, place svc_acct in corresponding
163   #      domain & possibly create a svc_forward in 'default domain'
164   #    when multiple svc_acct_sm's exists (in different domains) we'd
165   #    better use the 'intuitive' approach.
166   #
167   #  Specific way:
168   #    as 'perhaps better,' but we may be able to guess which domain
169   #    is correct by comparing the svcnum of domains to the username
170   #    of the svc_acct
171   #
172
173   # The intuitive way:
174
175   my $def_acct = new FS::svc_acct ( { $svc_acct->hash } );
176   $def_acct->setfield('domsvc' => $svc_domain->getfield('svcnum'));
177   $error = $def_acct->replace($svc_acct);
178   die "Error replacing svc_acct for " . $def_acct->username . " : $error" if $error;
179
180   foreach $svc_acct_sm (@svc_acct_sms) {
181
182     my($domrec)=qsearchs('svc_domain', {
183       svcnum => $svc_acct_sm->getfield('domsvc'),
184     }) || die  "svc_acct_sm references invalid domsvc $svc_acct_sm->getfield('domsvc')\n";
185
186     if ($svc_acct_sm->getfield('domuser') =~ /^\*$/) {
187       
188       my($newdom) = new FS::svc_domain ( { $domrec->hash } );
189       $newdom->setfield('catchall', $svc_acct->svcnum);
190       $newdom->setfield('action', "M");
191       $error = $newdom->replace($domrec);
192       die "Error replacing svc_domain for (anything)@" . $domrec->domain . " : $error" if $error;
193
194     } else {
195
196       my($newacct) = new FS::svc_acct {
197         'svcpart'  => $pop_svcpart,
198         'username' => $svc_acct_sm->getfield('domuser'),
199         'domsvc'   => $svc_acct_sm->getfield('domsvc'),
200         'dir'      => '/dev/null',
201       };
202       $error = $newacct->insert;
203       die "Error adding svc_acct for " . $newacct->username . " : $error" if $error;
204      
205       my($newforward) = new FS::svc_forward {
206         'svcpart'  => $forward_svcpart, 
207         'srcsvc'   => $newacct->getfield('svcnum'),
208         'dstsvc'   => $def_acct->getfield('svcnum'),
209       };
210       $error = $newforward->insert;
211       die "Error adding svc_forward for " . $newacct->username ." : $error" if $error;
212     }
213      
214     $error = $svc_acct_sm->delete;
215     die "Error deleting svc_acct_sm for " . $svc_acct_sm->domuser ." : $error" if $error;
216
217   };
218
219 };
220
221
222 $dbh->commit or die $dbh->errstr;
223 $dbh->disconnect or die $dbh->errstr;
224
225 print "svc_acct_sm records sucessfully migrated\n";
226
227 sub usage {
228   die "Usage:\n  fs-migrate-svc_acct_sm user\n"; 
229 }
230