bin/fs-migrate-svc_acct_sm

   1 #!/usr/bin/perl -Tw
   2 #
   3 # $Id: fs-migrate-svc_acct_sm,v 1.4 2002-06-21 09:13:16 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_Common::noexport_hack = 1;
  56 $FS::svc_domain::whois_hack = 1;
  57
  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'});
  61
  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;
  65
  66 my($svc_domain) = qsearchs('svc_domain', { 'domain' => $old_default_domain });
  67 if (! $svc_domain || $svc_domain->domain != $old_default_domain) {
  68    print <<EOF;
  69
  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?
  72 EOF
  73
  74    my($response)=scalar(<STDIN>);
  75    chop $response;
  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?
  79 END
  80       my($domain_svcpart)=&getdomainpart;
  81
  82       $svc_domain = new FS::svc_domain {
  83         'domain' => $old_default_domain,
  84         'svcpart' => $domain_svcpart,
  85         'action' => 'M',
  86        };
  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;
  90    }else{
  91       print <<EOF;
  92
  93   This program cannot function properly until a svc_domain record matching
  94 your conf_dir/domain file exists.
  95 EOF
  96
  97       exit 1;
  98    }
  99 }
 100
 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?
 104 END
 105 my($pop_svcpart)=&getacctpart;
 106
 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?
 110 END
 111 my($forward_svcpart)=&getforwardpart;
 112
 113 sub menu_domain_svc {
 114   ( join "\n", map "$_: ".$part_domain_svc{$_}->svc, sort keys %part_domain_svc ). "\n";
 115 }
 116 sub menu_acct_svc {
 117   ( join "\n", map "$_: ".$part_acct_svc{$_}->svc, sort keys %part_acct_svc ). "\n";
 118 }
 119 sub menu_forward_svc {
 120   ( join "\n", map "$_: ".$part_forward_svc{$_}->svc, sort keys %part_forward_svc ). "\n";
 121 }
 122 sub getdomainpart {
 123   $^W=0; # Term::Query isn't -w-safe
 124   my $return = query "Enter part number:", 'irk', [ keys %part_domain_svc ];
 125   $^W=1;
 126   $return;
 127 }
 128 sub getacctpart {
 129   $^W=0; # Term::Query isn't -w-safe
 130   my $return = query "Enter part number:", 'irk', [ keys %part_acct_svc ];
 131   $^W=1;
 132   $return;
 133 }
 134 sub getforwardpart {
 135   $^W=0; # Term::Query isn't -w-safe
 136   my $return = query "Enter part number:", 'irk', [ keys %part_forward_svc ];
 137   $^W=1;
 138   $return;
 139 }
 140
 141
 142 #migrate data
 143
 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'),
 148       }
 149     );
 150
 151   #  Ok.. we've got the svc_acct record, and an array of svc_acct_sm's
 152   #  What do we do from here?
 153
 154   #  The intuitive:
 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
 158   #
 159   #  Perhaps better:
 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.
 165   #
 166   #  Specific way:
 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
 169   #    of the svc_acct
 170   #
 171
 172   # The intuitive way:
 173
 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;
 178
 179   foreach $svc_acct_sm (@svc_acct_sms) {
 180
 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";
 184
 185     if ($svc_acct_sm->getfield('domuser') =~ /^\*$/) {
 186
 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;
 192
 193     } else {
 194
 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',
 200       };
 201       $error = $newacct->insert;
 202       die "Error adding svc_acct for " . $newacct->username . " : $error" if $error;
 203
 204       my($newforward) = new FS::svc_forward {
 205         'svcpart'  => $forward_svcpart,
 206         'srcsvc'   => $newacct->getfield('svcnum'),
 207         'dstsvc'   => $def_acct->getfield('svcnum'),
 208       };
 209       $error = $newforward->insert;
 210       die "Error adding svc_forward for " . $newacct->username ." : $error" if $error;
 211     }
 212
 213     $error = $svc_acct_sm->delete;
 214     die "Error deleting svc_acct_sm for " . $svc_acct_sm->domuser ." : $error" if $error;
 215
 216   };
 217
 218 };
 219
 220
 221 $dbh->commit or die $dbh->errstr;
 222 $dbh->disconnect or die $dbh->errstr;
 223
 224 print "svc_acct_sm records sucessfully migrated\n";
 225
 226 sub usage {
 227   die "Usage:\n  fs-migrate-svc_acct_sm user\n";
 228 }
 229