3 # $Id: fs-migrate-svc_acct_sm,v 1.4 2002-06-21 09:13:16 ivan Exp $
5 # jeff@cmh.net 01-Jul-20
7 #to delay loading dbdef until we're ready
8 #BEGIN { $FS::Record::setup_hack = 1; }
11 use Term::Query qw(query);
14 #use DBIx::DBSchema::Table;
15 #use DBIx::DBSchema::Column;
16 #use DBIx::DBSchema::ColGroup::Unique;
17 #use DBIx::DBSchema::ColGroup::Index;
19 use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets);
20 use FS::Record qw(qsearch qsearchs);
23 use vars qw( $conf $old_default_domain %part_domain_svc %part_acct_svc %part_forward_svc $svc_acct $svc_acct_sm $error);
25 die "Not running uid freeside!" unless checkeuid();
27 my $user = shift or die &usage;
31 $old_default_domain = $conf->config('domain');
33 #needs to match FS::Record
34 #my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
37 # This section would be the appropriate place to manipulate
38 # the schema & tables.
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
51 my($dbh)=adminsuidsetup $user;
55 $FS::svc_Common::noexport_hack = 1;
56 $FS::svc_domain::whois_hack = 1;
58 %part_domain_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
59 %part_acct_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
60 %part_forward_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_forward'});
62 die "No services with svcdb svc_domain!\n" unless %part_domain_svc;
63 die "No services with svcdb svc_acct!\n" unless %part_acct_svc;
64 die "No services with svcdb svc_forward!\n" unless %part_forward_svc;
66 my($svc_domain) = qsearchs('svc_domain', { 'domain' => $old_default_domain });
67 if (! $svc_domain || $svc_domain->domain != $old_default_domain) {
70 Your database currently does not contain a svc_domain record for the
71 domain $old_default_domain. Would you like me to add one for you?
74 my($response)=scalar(<STDIN>);
76 if ($response =~ /^[yY]/) {
77 print "\n\n", &menu_domain_svc, "\n", <<END;
78 I need to create new domain accounts. Which service shall I use for that?
80 my($domain_svcpart)=&getdomainpart;
82 $svc_domain = new FS::svc_domain {
83 'domain' => $old_default_domain,
84 'svcpart' => $domain_svcpart,
87 # $error=$svc_domain->insert && die "Error adding domain $old_default_domain: $error";
88 $error=$svc_domain->insert;
89 die "Error adding domain $old_default_domain: $error" if $error;
93 This program cannot function properly until a svc_domain record matching
94 your conf_dir/domain file exists.
101 print "\n\n", &menu_acct_svc, "\n", <<END;
102 I may need to create some new pop accounts and set up forwarding to them
103 for some users. Which service shall I use for that?
105 my($pop_svcpart)=&getacctpart;
107 print "\n\n", &menu_forward_svc, "\n", <<END;
108 I may need to create some new forwarding for some users. Which service
109 shall I use for that?
111 my($forward_svcpart)=&getforwardpart;
113 sub menu_domain_svc {
114 ( join "\n", map "$_: ".$part_domain_svc{$_}->svc, sort keys %part_domain_svc ). "\n";
117 ( join "\n", map "$_: ".$part_acct_svc{$_}->svc, sort keys %part_acct_svc ). "\n";
119 sub menu_forward_svc {
120 ( join "\n", map "$_: ".$part_forward_svc{$_}->svc, sort keys %part_forward_svc ). "\n";
123 $^W=0; # Term::Query isn't -w-safe
124 my $return = query "Enter part number:", 'irk', [ keys %part_domain_svc ];
129 $^W=0; # Term::Query isn't -w-safe
130 my $return = query "Enter part number:", 'irk', [ keys %part_acct_svc ];
135 $^W=0; # Term::Query isn't -w-safe
136 my $return = query "Enter part number:", 'irk', [ keys %part_forward_svc ];
144 my(@svc_accts) = qsearch('svc_acct', {});
145 foreach $svc_acct (@svc_accts) {
146 my(@svc_acct_sms) = qsearch('svc_acct_sm', {
147 domuid => $svc_acct->getfield('uid'),
151 # Ok.. we've got the svc_acct record, and an array of svc_acct_sm's
152 # What do we do from here?
155 # plop the svc_acct into the 'default domain'
156 # and then represent the svc_acct_sm's with svc_forwards
157 # they can be gussied up manually, later
160 # when no svc_acct_sm exists, place svc_acct in 'default domain'
161 # when one svc_acct_sm exists, place svc_acct in corresponding
162 # domain & possibly create a svc_forward in 'default domain'
163 # when multiple svc_acct_sm's exists (in different domains) we'd
164 # better use the 'intuitive' approach.
167 # as 'perhaps better,' but we may be able to guess which domain
168 # is correct by comparing the svcnum of domains to the username
174 my $def_acct = new FS::svc_acct ( { $svc_acct->hash } );
175 $def_acct->setfield('domsvc' => $svc_domain->getfield('svcnum'));
176 $error = $def_acct->replace($svc_acct);
177 die "Error replacing svc_acct for " . $def_acct->username . " : $error" if $error;
179 foreach $svc_acct_sm (@svc_acct_sms) {
181 my($domrec)=qsearchs('svc_domain', {
182 svcnum => $svc_acct_sm->getfield('domsvc'),
183 }) || die "svc_acct_sm references invalid domsvc $svc_acct_sm->getfield('domsvc')\n";
185 if ($svc_acct_sm->getfield('domuser') =~ /^\*$/) {
187 my($newdom) = new FS::svc_domain ( { $domrec->hash } );
188 $newdom->setfield('catchall', $svc_acct->svcnum);
189 $newdom->setfield('action', "M");
190 $error = $newdom->replace($domrec);
191 die "Error replacing svc_domain for (anything)@" . $domrec->domain . " : $error" if $error;
195 my($newacct) = new FS::svc_acct {
196 'svcpart' => $pop_svcpart,
197 'username' => $svc_acct_sm->getfield('domuser'),
198 'domsvc' => $svc_acct_sm->getfield('domsvc'),
199 'dir' => '/dev/null',
201 $error = $newacct->insert;
202 die "Error adding svc_acct for " . $newacct->username . " : $error" if $error;
204 my($newforward) = new FS::svc_forward {
205 'svcpart' => $forward_svcpart,
206 'srcsvc' => $newacct->getfield('svcnum'),
207 'dstsvc' => $def_acct->getfield('svcnum'),
209 $error = $newforward->insert;
210 die "Error adding svc_forward for " . $newacct->username ." : $error" if $error;
213 $error = $svc_acct_sm->delete;
214 die "Error deleting svc_acct_sm for " . $svc_acct_sm->domuser ." : $error" if $error;
221 $dbh->commit or die $dbh->errstr;
222 $dbh->disconnect or die $dbh->errstr;
224 print "svc_acct_sm records sucessfully migrated\n";
227 die "Usage:\n fs-migrate-svc_acct_sm user\n";