home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / upgr31.pl < prev    next >
Text File  |  2009-11-06  |  30KB  |  826 lines
  1. # FILE: upgr31.pl
  2. # DESCRIPTION: Upgrade procedure from 3.10 to 4.00
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
  17.  
  18. ###
  19. ### upgrade_version_310
  20. ###
  21. ### Manager for the upgrade from Discus 3.10 to 4.00+
  22. ###
  23.  
  24. sub upgrade_version_310 {
  25.     my ($FORMref, $result, $cookie) = @_;
  26.     dreq("authpass", "filter31");
  27.     if (! defined $result || ref $result ne 'ARRAY' || scalar(@{$result}) == 0) {
  28.         $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});    
  29.     }
  30.     bad_login( { username => 1 } ) if scalar(@{ $result }) == 0;
  31.     upgrade_reserved_for_superuser() if $result->[0]->{user} ne $DCONF->{superuser};
  32.     if (! $FORMref->{upgrtf}) {
  33.         my $tempfile = join("", time, $$); $tempfile =~ s/\W//g;
  34.         upgrade_version_310_A();
  35.         upgrade_version_310_gauge($tempfile, $result, { descr => 402, posi => 2 }, $cookie);
  36.     }
  37.     my $tempfile = $FORMref->{upgrtf}; $tempfile =~ s/\W//g;
  38.     upgrade_version_310_B($tempfile, $FORMref, $result) if $FORMref->{posi} <= 2;
  39.     upgrade_version_310_C($tempfile, $FORMref, $result) if $FORMref->{posi} <= 3;
  40.     upgrade_version_310_D($tempfile, $FORMref, $result) if $FORMref->{posi} <= 4;
  41.     upgrade_version_310_E($tempfile, $FORMref, $result) if $FORMref->{posi} <= 5;
  42.     upgrade_version_310_F($tempfile, $FORMref, $result) if $FORMref->{posi} <= 6;
  43.     upgrade_version_310_G($tempfile, $FORMref, $result) if $FORMref->{posi} <= 7;
  44.     upgrade_version_310_H($tempfile, $FORMref, $result) if $FORMref->{posi} <= 8;
  45.     upgrade_version_310_I($tempfile, $FORMref, $result) if $FORMref->{posi} <= 9;
  46.     upgrade_version_310_J($tempfile, $FORMref, $result) if $FORMref->{posi} <= 10;
  47.     upgrade_version_310_K($tempfile, $FORMref, $result) if $FORMref->{posi} <= 11;
  48.     upgrade_version_310_L($tempfile, $FORMref, $result) if $FORMref->{posi} <= 12;
  49.     upgrade_version_310_M($tempfile, $FORMref, $result);
  50. }
  51.  
  52. ###
  53. ### upgrade_reserved_for_superuser
  54. ###
  55. ### Error message if an upgrade needs to be done and an ordinary moderator logs in
  56. ###
  57.  
  58. sub upgrade_reserved_for_superuser {
  59.     my $subst = {};
  60.     $subst->{general}->{upgrade} = 2;
  61.     screen_out("badlogin", $subst);    
  62. }
  63.  
  64. ###
  65. ### upgrade_version_310_A
  66. ###
  67. ### Upgrades administration files (posting.txt & security.txt => topicprv.txt)
  68. ###
  69.  
  70. sub upgrade_version_310_A {
  71.     my @sd = map { join("/", $DCONF->{admin_dir}, $_) } ('backups', 'data', 'locks', 'msg_index', 'profiles', 'queue', 'secure', 'skins');
  72.     push @sd, map { join("/", $DCONF->{admin_dir}, 'data', $_) } ('debug', 'dtaskman', 'newusers', 'pop3_in', 'tokens', 'updates');
  73.     push @sd, map { join("/", $DCONF->{admin_dir}, 'msg_index', $_) } ('lim-accs', 'searches', 'temp', 'uploads');
  74.     push @sd, join("/", $DCONF->{message_dir}, "thumbnails");
  75.     map { _upgrade_version_310_A_mkdir($_) } @sd;
  76.     touch_createfile("$DCONF->{admin_dir}/data/db.txt");
  77.     if (! -e "$DCONF->{admin_dir}/data/topicprv.txt") {
  78.         dreq("fcn-usrp");
  79.         write_topic_privilege_file(import_posting_reading_privileges(), { create => 1 });
  80.     }
  81.     if (! -e "$DCONF->{admin_dir}/skins/$GLOBAL_OPTIONS->{skinchoice}.tmpl") {
  82.         my $scorig = $GLOBAL_OPTIONS->{skinchoice};
  83.         my $scnew = $scorig;
  84.         $scnew = $` if $scnew =~ /\//;
  85.         my @avail_skins = ('tables2', 'classic');
  86.         unshift @avail_skins, 'classic' if $scorig =~ /^classic/;
  87.         unshift @avail_skins, 'classic' if $scorig =~ /^updated/;
  88.         unshift @avail_skins, 'tables2' if $scorig =~ /^tables/;
  89.         unshift @avail_skins, 'tables2' if $scorig =~ /^supportforum/;
  90. WI:        while (! -e "$DCONF->{admin_dir}/skins/$scnew.tmpl") {
  91.             if ($scnew = shift @avail_skins) {
  92.                 next WI if -e "$DCONF->{admin_dir}/skins/$scnew.tmpl";
  93.             } else {
  94.                 template_error("Restore Error", "Cannot find a skin to use for this board");
  95.             }
  96.         }
  97.         my $JH = {};
  98.         $JH->{skinchoice} = $scnew if $scorig ne $scnew;
  99.         $JH->{alt_color_1} = "#0000a0" if length($GLOBAL_OPTIONS->{alt_color_1}) < 3;
  100.         $JH->{alt_color_2} = "#f7f7f7" if length($GLOBAL_OPTIONS->{alt_color_2}) < 3;
  101.         for (my $i = 3; $i <= 10; $i++) {
  102.             my $l = join("_", "alt", "color", $i);
  103.             next if $GLOBAL_OPTIONS->{$l} ne "" && $GLOBAL_OPTIONS->{$l} ne "0";
  104.             $JH->{$l} = $i % 2 ? "#cccccc" : "#f7f7f7";
  105.         }
  106.         if (scalar(keys %{$JH})) {
  107.             dreq("adm-opts");
  108.             options_save($JH);
  109.         }
  110.     }    
  111. }
  112.  
  113. sub _upgrade_version_310_A_mkdir {
  114.     my ($dir) = @_;
  115.     return if -d $dir;
  116.     unlink "$dir";
  117.     mkdir("$dir", oct($DCONF->{perms0777}));
  118.     chmod(oct($DCONF->{perms0777}), "$dir");
  119. }
  120.  
  121. ###
  122. ### upgrade_version_310_B
  123. ###
  124. ### Delete unnecessary files (most, but not all) and some miscellaneous upgrades
  125. ###
  126.  
  127. sub upgrade_version_310_B {
  128.     my ($tempfile, $FORMref, $result) = @_;
  129.     
  130.     # Old message source dirs (replaced by inverse_webtags function)
  131.     
  132.     if (opendir(DIR, "$DCONF->{admin_dir}/msg_index")) {
  133.         my @dir = map { $_ } readdir(DIR);
  134.         closedir(DIR);
  135.         foreach my $dir (grep { /^\d+$/ } @dir) {
  136.             if (opendir(DIR, "$DCONF->{admin_dir}/msg_index/$dir")) {
  137.                 my @f = map { "$DCONF->{admin_dir}/msg_index/$dir/$_" } readdir(DIR);
  138.                 closedir(DIR);
  139.                 unlink grep (-f $_, @f);
  140.                 rmdir("$DCONF->{admin_dir}/msg_index/$dir");
  141.             }
  142.         }
  143.         if (my @x = grep(/^\-/, @dir)) {
  144.             unlink map { "$DCONF->{admin_dir}/msg_index/$_" } @x;
  145.         }
  146.         unlink "$DCONF->{admin_dir}/msg_index/attach-mgr.txt";
  147.     }
  148.     
  149.     # Old src-board-subs-* files (replaced by much nicer *.pl files)
  150.     
  151.     if (opendir(DIR, "$DCONF->{admin_dir}/source")) {
  152.         my @dir = map { "$DCONF->{admin_dir}/source/$_" } readdir(DIR);
  153.         closedir(DIR);
  154.         @dir = grep (/\/src-board-subs/, @dir);
  155.         push @dir, "$DCONF->{admin_dir}/source/dep.txt";
  156.         unlink @dir;
  157.     }    
  158.     
  159.     # Old file locks, just for fun    
  160.     
  161.     if (opendir(DIR, "$DCONF->{admin_dir}/locks")) {
  162.         my @dir = map { "$DCONF->{admin_dir}/locks/$_" } grep { ! /^\./ } readdir(DIR);
  163.         closedir(DIR);
  164.         unlink @dir;
  165.     }
  166.     
  167.     # Various remnants in administration directory
  168.     
  169.     my @files = map { join("/", $DCONF->{admin_dir}, $_) } ('posting.txt', 'frontpage_conf.txt', 'security.txt', 'queue.txt', 'upgrade.txt');
  170.     unlink @files;    
  171.     
  172.     # If you're running Discus Pro, make sure necessary files/directories exist
  173.     
  174.     if ($DCONF->{pro}) {
  175.         dreq("pro-init-PRO");
  176.         create_discus_pro_files();
  177.         convert_selfreg_file();
  178.     }
  179.     
  180.     # Convert email.txt
  181.     
  182.     my $emt = readfile("$DCONF->{admin_dir}/email.txt", "upgrade_version_310_B", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  183.     my @f = ('to', 'from', 'subject', 'bcc', 'replyto', 'user');
  184.     @f = map { join("", $_, "address") } @f;
  185.     my %f = map { $_, 1 } @f;
  186.     foreach my $line (@{ $emt }) {
  187.         if ($line =~ m|^(.*?)=(.*)|) {
  188.             my ($var, $val) = ($1, $2);
  189.             if ($f{$var} == 1) {
  190.                 if ($val == 0) {
  191.                     $val = 1;
  192.                 } elsif ($val == 1) {
  193.                     $val = 0;
  194.                 }
  195.                 $line = join("=", $var, join("", $val, "\n"));
  196.             }
  197.         }
  198.     }
  199.     writefile("$DCONF->{admin_dir}/email.txt", $emt, "upgrade_version_310_B", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  200.  
  201.     # Done
  202.     
  203.     upgrade_version_310_gauge($tempfile, $result, { descr => 403, posi => 3 });
  204. }
  205.  
  206. ###
  207. ### upgrade_version_310_C
  208. ###
  209. ### Calculate moderator editing privileges
  210. ###
  211.  
  212. sub upgrade_version_310_C {
  213.     my ($tempfile, $FORMref, $result) = @_;
  214.     dreq("fcn-priv", "fcn-grp");
  215.     my $Z = read_privilege_file(1);
  216.     my $T = board_topics();
  217.     my $G = read_group_file();
  218.     my @actions = ();
  219.     foreach my $t (@{$T}) {
  220.         next if $t->{type} != 1;
  221.         next if defined $Z->{by_topic}->{$t->{number}};
  222.         my $PG = GetPage($t->{number}, $t->{number}, { no_error => 1 });
  223.         if ($PG->{head}->{topic_number} == $t->{number} && $PG->{head}->{owner} ne "") {
  224.             my $X = $G->{by_grp}->{$PG->{head}->{owner}};
  225.             if (ref $X ne 'HASH' || scalar(keys(%{$X})) == 0) {
  226.                 push @actions, { topic => $t->{number}, action => 'add_topic', moderator => $DCONF->{superuser} };
  227.             } else {
  228.                 $X->{$DCONF->{superuser}} = 1;
  229.                 my $mod_str = join(",", sort keys %{$X});
  230.                 push @actions, { topic => $t->{number}, action => 'add_topic', moderator => $mod_str };
  231.             }
  232.         } else {
  233.             push @actions, { topic => $t->{number}, action => 'add_topic', moderator => $DCONF->{superuser} };
  234.         }    
  235.     }
  236.     touch_createfile("$DCONF->{admin_dir}/privs.txt");
  237.     write_privilege_file(\@actions, 1) if scalar(@actions);    
  238.     upgrade_version_310_gauge($tempfile, $result, { descr => 403, posi => 4 });
  239. }
  240.  
  241. ###
  242. ### upgrade_version_310_D
  243. ###
  244. ### Convert version 3.1 enhanced user profile fields file
  245. ###
  246.  
  247. sub upgrade_version_310_D {
  248.     my ($tempfile, $FORMref, $result) = @_;
  249.     return if ! $DCONF->{pro};
  250.     dreq("fcn-prfl-PRO");
  251.     my $Z = read_profile_fields();
  252.     if (ref $Z eq 'ARRAY' && scalar @{$Z} > 0) {
  253.         upgrade_version_310_gauge($tempfile, $result, { descr => 404, posi => 5 });
  254.     }
  255.     my $old = readfile("$DCONF->{admin_dir}/profiles/config.txt", "upgrade_version_310_D", { create => 1 });
  256.     if (scalar(@{$old})) {
  257.         my @newfld = ();
  258.         foreach my $line (@{$old}) {
  259.             chomp $line;
  260.             my ($var, $descr, $disp, $type, $size, $req) = split(/:/, $line);
  261.             my $k = join(":", 1+scalar(@newfld), $descr, $disp, $type, $size, $req, 1+scalar(@newfld));
  262.             push @newfld, join("", $k, "\n");
  263.             last if scalar(@newfld) >= 20;
  264.         }
  265.         writefile("$DCONF->{admin_dir}/data/fields.txt", \@newfld, "upgrade_version_310_D");
  266.     }
  267.     upgrade_version_310_gauge($tempfile, $result, { descr => 404, posi => 5 });
  268. }
  269.  
  270. ###
  271. ### upgrade_version_310_E
  272. ###
  273. ### From posting logs, determine creation times of various users & count posts
  274. ###
  275.  
  276. sub upgrade_version_310_E {
  277.     my ($tempfile, $FORMref, $result) = @_;
  278.     my $tfile1 = join("/", $DCONF->{admin_dir}, "backups", join(".", $tempfile, "31E"));
  279.     my $tfile2 = join("/", $DCONF->{admin_dir}, "backups", join(".", $tempfile, "PLG"));
  280.     my $tfile3 = join("/", $DCONF->{admin_dir}, "backups", join(".", $tempfile, "PCT"));
  281.     if (! -e $tfile1) {
  282.         touch_createfile($tfile2);
  283.         touch_createfile($tfile3);
  284.         my $l = directory_list("$DCONF->{admin_dir}/msg_index", '^\d+-log\.txt$', 1);
  285.         return if scalar(@{$l}) == 0;
  286.         touch_createfile($tfile1);
  287.         my @l = map { join("", $_, "\n") } @{$l};
  288.         writefile($tfile1, \@l, "upgrade_version_310_E", { no_lock => 1, no_unlock => 1 });
  289.         upgrade_version_310_gauge($tempfile, $result, { descr => 404, posi => 5, total => scalar(@l) });
  290.     } else {
  291.         my $TSF1 = readfile($tfile2, "upgrade_version_310_E", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  292.         my %J = map { chomp $_; split(/\t/, $_, 2); } @{$TSF1};
  293.         my $TSF2 = readfile($tfile3, "upgrade_version_310_E", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  294.         my %PC = map { chomp $_; split(/\t/, $_, 2); } @{$TSF2};
  295.         undef $TSF1;
  296.         undef $TSF2;
  297.         my $T1 = readfile($tfile1, "upgrade_version_310_E", { no_lock => 1, no_unlock => 1 });
  298.         my $lg = shift @{$T1};
  299.         if (open (LOG, "< $DCONF->{admin_dir}/msg_index/$lg")) {
  300.             while (<LOG>) {
  301.                 my $z = _upgrade_version_310_E_line_to_hash($_);
  302.                 next if ref $z ne 'HASH';
  303.                 $PC{$z->{uid}}++;
  304.                 next if $J{$z->{uid}} < $z->{ptime} && $J{$z->{uid}} != 0;
  305.                 $J{$z->{uid}} = $z->{ptime};
  306.             }
  307.             close (LOG);
  308.         }
  309.         my @TSF = map { join("", $_, "\t", $J{$_}, "\n") } keys %J;
  310.         my @PCT = map { join("", $_, "\t", $PC{$_}, "\n") } keys %PC;
  311.         writefile($tfile2, \@TSF, "upgrade_version_310_E", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  312.         writefile($tfile3, \@PCT, "upgrade_version_310_E", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  313.         if (ref $T1 ne 'ARRAY' || scalar @{$T1} == 0) {
  314.             unlink $tfile1;
  315.             upgrade_version_310_gauge($tempfile, $result, { descr => 406, posi => 6 });
  316.         } else {
  317.             writefile($tfile1, $T1, "upgrade_version_310_E", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  318.             upgrade_version_310_gauge($tempfile, $result, { descr => 405, posi => 5, total => $FORMref->{total}, done => 1 + $FORMref->{done} });
  319.         }
  320.     }    
  321. }
  322.  
  323. sub _upgrade_version_310_E_line_to_hash {
  324.     my ($line) = @_;
  325.     my ($post, $uid, $ptime) = split(/;/, $line, 4);
  326.     my ($username, $group) = split(/:/, $uid);
  327.     return undef if $group eq "PUBLIC";
  328.     return undef if $group eq "";
  329.     return undef if $ptime == 0;
  330.     return { uid => join(":", $username, 'MODERATOR'), ptime => $ptime } if $group eq "MODERATOR";    
  331.     return { uid => $username, ptime => $ptime };
  332. }
  333.  
  334. ###
  335. ### upgrade_version_310_F
  336. ###
  337. ### Update user database
  338. ###
  339.  
  340. sub upgrade_version_310_F {
  341.     my ($tempfile, $FORMref, $result) = @_;
  342.     my $tfile1 = join("/", $DCONF->{admin_dir}, "backups", join(".", $tempfile, "users.bak"));
  343.     my $tfile2 = join("/", $DCONF->{admin_dir}, "backups", join(".", $tempfile, "passwd.bak"));
  344.     if (! -e $tfile1) {
  345.         foreach my $fr ("users.txt/$tfile1", "passwd.txt/$tfile2") {
  346.             my ($file, $tmpfile) = split(/\//, $fr, 2);
  347.             if (open(SRC, "< $DCONF->{admin_dir}/$file")) {
  348.                 if (open(DEST, "> $tmpfile")) {
  349.                     while (<SRC>) {
  350.                         print DEST;
  351.                     }
  352.                     close (DEST);
  353.                     close (SRC);
  354.                 } else {
  355.                     error_message("File Creation Error", "Could not write to $tmpfile");
  356.                 }
  357.             } else {
  358.                 error_message("File Creation Error", "Could not open [admin_dir]/$file");
  359.             }
  360.         }
  361.         upgrade_version_310_gauge($tempfile, $result, { descr => 406, posi => 6, total => 3, done => 1 });
  362.     }    
  363.     my $tfile3 = join("/", $DCONF->{admin_dir}, "backups", join(".", $tempfile, "PLG"));
  364.     my $tfile4 = join("/", $DCONF->{admin_dir}, "backups", join(".", $tempfile, "DUP"));
  365.     my $TSF = readfile($tfile3, "upgrade_version_310_F", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  366.     my %J = map { chomp $_; split(/\s+/, $_, 2); } @{$TSF};
  367.     undef $TSF;
  368.     my $src = $FORMref->{done} == 1 ? "users.txt" : "passwd.txt";
  369.     my $dest = $FORMref->{done} == 1 ? $tfile1 : $tfile2;
  370.     my $timecache = time;
  371.     my $seen = {};
  372.     open (SRC, "< $dest");
  373.     while (<SRC>) {
  374.         my @s = split(/:/, $_);
  375.         my $q = user_line_as_hash($_);
  376.         if (scalar(@s) < 10) {
  377.             $q = v31_user_line_as_hash($_);
  378.             my $uid = $q->{user};
  379.             $uid .= ":MODERATOR" if $src eq "passwd.txt";
  380.             $q->{ctime} = $J{$uid} if $J{$uid} > 0;
  381.             $q->{ctime} = $q->{atime} if ($q->{ctime} == 0 || $q->{atime} < $q->{ctime}) && $q->{atime} > 0;
  382.             $q->{ctime} = $q->{stime} if ($q->{ctime} == 0 || $q->{stime} < $q->{ctime}) && $q->{stime} > 0;
  383.             $q->{ctime} = $timecache if $q->{ctime} == 0;
  384.             $q->{ctime} = $' if $q->{ctime} =~ /.*\D/;
  385.         }
  386.         push @{ $seen->{$q->{user}}->{$q->{pass}} }, $q;
  387.     }
  388.     close (SRC);
  389.     my @dupe = ();
  390.     open (DEST, "> $DCONF->{admin_dir}/$src");
  391.     foreach my $user (keys %{$seen}) {
  392.         my $Z1 = $seen->{$user};
  393.         if (scalar keys(%{$Z1}) == 1) {
  394.             my $Z2 = $Z1->{(keys(%{$Z1}))[0]};
  395.             my $q = $Z2->[0];
  396.             my @g = map { $_->{groups} } @{$Z2};
  397.             $q->{groups} = join("/", "", @g, "");
  398.             $q->{groups} =~ s%/+%/%g;
  399.             print DEST generate_user_line($q);
  400.         } else {
  401.             my @P = keys %{$Z1};
  402.             my $c = 0;
  403.             my $p = $Z1->{shift @P};
  404.             my $q = $p->[0];
  405.             my @g = map { $_->{groups} } @{$p};
  406.             $q->{groups} = join("/", "", @g, "");
  407.             print DEST generate_user_line($q);
  408.             foreach my $j (@P) {
  409.                 my $qcpy = $Z1->{$j}->[0];
  410.                 $c++ until ! defined $seen->{join("_", $user, $c)};
  411.                 $qcpy->{user} = join("_", $user, $c);
  412.                 $seen->{$user} = { used => 1 };
  413.                 my @g = map { $_->{groups} } @{$Z1->{$j}};
  414.                 $qcpy->{groups} = join("/", "", @g, "");
  415.                 $qcpy->{groups} =~ s%/+%/%g;
  416.                 print DEST generate_user_line($qcpy);
  417.                 push @dupe, { old => $user, new => $qcpy, groups => $g[0] };
  418.             }            
  419.         }
  420.     }    
  421.     close (DEST);
  422.     if (scalar @dupe) {
  423.         open (TFILE, "> $tfile4");
  424.         foreach my $d (@dupe) {
  425.             print TFILE join("", join(":", $d->{old}, $d->{new}->{user}, $d->{new}->{email}, $d->{new}->{fullname}, $d->{groups}), "\n");
  426.         }
  427.         close (TFILE);
  428.     }
  429.     if ($FORMref->{done} == 1) {    
  430.         upgrade_version_310_gauge($tempfile, $result, { descr => 406, posi => 6, total => 3, done => 2 });
  431.     } else {
  432.         unlink $tfile3;
  433.         upgrade_version_310_gauge($tempfile, $result, { descr => 407, posi => 7 });
  434.     }    
  435. }
  436.  
  437. ###
  438. ### upgrade_version_310_G
  439. ###
  440. ### Import user profiles
  441. ###
  442.  
  443. sub upgrade_version_310_G {
  444.     my ($tempfile, $FORMref, $result) = @_;
  445.     if (! $DCONF->{pro}) {
  446.         unlink join("/", $DCONF->{admin_dir}, "backups", join(".", $tempfile, "PCT"));
  447.         return;
  448.     }
  449.     dreq("fcn-prfl-PRO");
  450.     my $tfile1 = join("/", $DCONF->{admin_dir}, "backups", join(".", $tempfile, "PRL"));
  451.     if (! -e $tfile1) {
  452.         my $dl = directory_list("$DCONF->{admin_dir}/profiles", '^\w+\-', 1);
  453.         my @dl = sort map { join("", $_, "\n") } @{$dl};
  454.         return if scalar(@dl) == 0;
  455.         writefile($tfile1, \@dl, "upgrade_version_310_G", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  456.         upgrade_version_310_gauge($tempfile, $result, { descr => 407, posi => 7, total => scalar(@dl) });
  457.     }
  458.     my $tfile4 = join("/", $DCONF->{admin_dir}, "backups", join(".", $tempfile, "DUP"));
  459.     my $tfile5 = join("/", $DCONF->{admin_dir}, "backups", join(".", $tempfile, "PCT"));
  460.     my $plist = readfile($tfile1, "upgrade_version_310_G", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  461.     my $dlist = readfile($tfile4, "upgrade_version_310_G", { no_lock => 1, no_unlock => 1, zero_ok => 1, create => 1 });
  462.     my $clist = readfile($tfile5, "upgrade_version_310_G", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  463.     my $oldconf = readfile("$DCONF->{admin_dir}/profiles/config.txt", "upgrade_version_310_G", { no_lock => 1, no_unlock => 1, create => 1 });
  464.     my $ctr = 0; my $oldconfhash = {};
  465.     foreach my $line (@{$oldconf}) {
  466.         chomp $line;
  467.         my ($var, $descr, $disp, $type, $size, $req) = split(/:/, $line);
  468.         $oldconfhash->{$var} = $ctr;
  469.         $ctr++;
  470.     }
  471.     my %q = undef;
  472.     my %m = undef;
  473.     foreach my $line (@{$plist}) {
  474.         $line =~ s/\.txt\s*$//;
  475.         my ($user, $group) = split(/-/, $line);
  476.         push @{ $q{$user} }, $group if $group ne 'MODERATOR';
  477.         $m{$user} = 1 if $group eq 'MODERATOR';
  478.     }
  479.     my %dupe = undef;
  480.     foreach my $line (@{$dlist}) {
  481.         chomp $line;
  482.         my ($olduser, $newuser, $email, $fullname, $group) = split(/:/, $line);
  483.         $dupe{$olduser} = { newuser => $newuser, group => $group };        
  484.     }
  485.     my %posts = undef;
  486.     foreach my $line (@{$clist}) {
  487.         chomp $line;
  488.         my ($uid, $posts) = split(/\t/, $line);
  489.         $posts{$uid} = $posts;
  490.     }
  491.     my %o1 = undef;
  492.     my %o2 = undef;
  493.     my $done = 0;
  494.     while ($done <= 15 && scalar(keys %q)) {
  495.         my $k = (keys %q)[0]; $done++;
  496.         $o1{$k} = {};
  497.         foreach my $grp (@{ $q{$k} }) {
  498.             my $j = readfile("$DCONF->{admin_dir}/profiles/$k-$grp.txt", "upgrade_version_310_G", { no_lock => 1, no_unlock => 1, create => 1, zero_ok => 1 });
  499.             if (ref $j ne 'ARRAY' || scalar(@{$j}) == 0) {
  500.                 delete $q{$k};
  501.                 next;
  502.             }
  503.             $FORMref->{done}++;
  504.             my $L = enhanced_user_profile_3031($j, $k, $oldconfhash);
  505.             $L->{posts} = $posts{$k};
  506.             if ($dupe{$k}->{group} eq $grp) {
  507.                 $L->{username} = $dupe{$k}->{newuser};
  508.                 hash_merge($o1{$dupe{$k}->{newuser}}, $L, 1);
  509.             } else {
  510.                 $L->{username} = $k;
  511.                 hash_merge($o1{$k}, $L, 1);
  512.             }
  513.             unlink "$DCONF->{admin_dir}/profiles/$k-$grp.txt";            
  514.         }
  515.         delete $q{$k};
  516.         $done++;
  517.     }
  518.     while ($done <= 15 && scalar(keys %m)) {
  519.         my $k = (keys %m)[0]; $done++;
  520.         my $j = readfile("$DCONF->{admin_dir}/profiles/$k-MODERATOR.txt", "upgrade_version_310_G", { no_lock => 1, no_unlock => 1, create => 1, zero_ok => 1 });
  521.         if (ref $j ne 'ARRAY' || scalar(@{$j}) == 0) {
  522.             delete $m{$k};
  523.             next;
  524.         }
  525.         my $L = enhanced_user_profile_3031($j, $k, $oldconfhash);
  526.         $L->{posts} = $posts{"$k:MODERATOR"};
  527.         $L->{username} = $k;
  528.         $o2{$k} = $L;
  529.         unlink "$DCONF->{admin_dir}/profiles/$k-MODERATOR.txt";            
  530.         delete $m{$k};
  531.         $done++;
  532.         $FORMref->{done}++;
  533.     }
  534.     if (scalar(keys %o1) + scalar(keys %o2)) {
  535.         if (scalar(keys %o1)) {
  536.             open (USERS, ">> $DCONF->{admin_dir}/data/us-accts.txt") || error_message("File Append Error", "Could not append [admin_dir]/data/us-accts.txt");
  537.             foreach my $k (keys %o1) {
  538.                 print USERS enhanced_profile_hash_to_line($o1{$k}, 0, 0) if $k ne "";
  539.             }
  540.             close (USERS);
  541.         }
  542.         if (scalar(keys %o2)) {
  543.             open (MODS, ">> $DCONF->{admin_dir}/data/md-accts.txt") || error_message("File Append Error", "Could not append [admin_dir]/data/md-accts.txt");
  544.             foreach my $k (keys %o2) {
  545.                 my $su = $DCONF->{superuser} eq $k ? 1 : 0;
  546.                 print MODS enhanced_profile_hash_to_line($o2{$k}, 1, $su) if $k ne "";
  547.             }
  548.             close (MODS);
  549.         }
  550.     }
  551.     if (scalar(keys %q) + scalar(keys %m)) {
  552.         my @d = ();
  553.         foreach my $k (keys %q) {
  554.             foreach my $g (@{$q{$k}}) {
  555.                 push @d, join("", join("-", $k, $g), ".txt\n");
  556.             }
  557.         }
  558.         foreach my $k (keys %m) {
  559.             push @d, join("", join("-", $k, "MODERATOR"), ".txt\n");
  560.         }
  561.         writefile($tfile1, \@d, "upgrade_version_310_G", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  562.         upgrade_version_310_gauge($tempfile, $result, { descr => 407, posi => 7, total => $FORMref->{total}, done => $FORMref->{done} });
  563.     } else {
  564.         unlink $tfile1;
  565.         unlink "$DCONF->{admin_dir}/profiles/config.txt";
  566.         unlink $tfile5;
  567.         upgrade_version_310_gauge($tempfile, $result, { descr => 408, posi => 8 });
  568.     }                
  569. }
  570.  
  571. ###
  572. ### upgrade_version_310_H
  573. ###
  574. ### Combined reindexing & build search index
  575. ###
  576.  
  577. sub upgrade_version_310_H {
  578.     my ($tempfile, $FORMref, $result) = @_;
  579.     dreq("fcn-regn", "fcn-indx", "fcn-logs");
  580.     if (! -e "$DCONF->{admin_dir}/backups/$tempfile.TMP") {
  581.         my $d = directory_list("$DCONF->{admin_dir}/msg_index", '^\d+-(tree|search)\.TMP$', 1);
  582.         unlink @{$d} if ref $d eq "ARRAY" && scalar(@{$d});
  583.         my $out = incremental({ operation => 1, tempfile => $tempfile });
  584.         upgrade_version_310_gauge($tempfile, $result, { total => $out->{count}, descr => 408, posi => 8 });
  585.     }
  586.     my $tempfileR = incremental({ operation => "read", tempfile => $tempfile });
  587.     my $timer = time;
  588.     my $topic = 0;
  589.     my $fileopen = 0;
  590.     my $ctr = 0;    
  591.     while (1) {
  592.         my $file = shift(@{ $tempfileR->{data} }) or last;
  593.         my ($tn, $pn) = split(/\D/, $file);
  594.         next if $tn == 0;
  595.         if ($topic != 0 && $topic != $tn) {
  596.             unshift(@{ $tempfileR->{data} }, $file);
  597.             last;
  598.         }
  599.         if ($topic == 0) {
  600.             open (TREETMP, ">> $DCONF->{admin_dir}/msg_index/$tn-tree.TMP") || error_message("File Write Error", "Could not create temporary tree index file in 'msg_index' directory!");
  601.             open (SRCHTMP, ">> $DCONF->{admin_dir}/msg_index/$tn-search.TMP") || error_message("File Write Error", "Could not create temporary tree index file in 'msg_index' directory!");
  602.             $topic = $tn;
  603.             $fileopen = 1;
  604.         }
  605.         my $get = GetPage($tn, $pn, { no_lock => 1, no_unlock => 1, no_error => 1 });
  606.         next if $get->{head}->{me_number} ne $pn;
  607.         my ($pdata, $subs) = build_page_data($tn, $pn, $get);
  608.         my $pdta1 = shift(@{ $pdata });
  609.         chomp $pdta1;
  610.         if (scalar(@{ $subs })) {
  611.             print TREETMP $pdta1, "\t", join(",", @{ $subs }), "\n";
  612.         } else {
  613.             print TREETMP $pdta1, "\tX\n";
  614.         }
  615.         if (scalar(@{ $pdata })) {
  616.             print TREETMP @{ $pdata };
  617.         }
  618.         foreach my $m (@{ $get->{messages} }) {
  619.             $m->{postindex} = $m->{number};
  620.             $m->{text} = search_stop($m->{text});
  621.             print SRCHTMP search_hash_to_line($m);
  622.         }
  623.         $ctr++;
  624.         $FORMref->{done}++;
  625.         if ($ctr % 10 == 0) {
  626.             last if time > ($timer+2+$GLOBAL_OPTIONS->{reindex_secs});
  627.         }
  628.     }
  629.     close (TREETMP) if $fileopen;
  630.     close (SRCHTMP) if $fileopen;
  631.     my $res = incremental({ operation => "write", data => $tempfileR->{data}, tempfile => $tempfile });
  632.     if ($res->{'continue'}) {
  633.         upgrade_version_310_gauge($tempfile, $result, { done => $FORMref->{done}, total => $FORMref->{total}, descr => 408, posi => 8 });
  634.     } else {
  635.         upgrade_version_310_gauge($tempfile, $result, { descr => 409, posi => 9 });
  636.     }
  637. }
  638.  
  639. ###
  640. ### upgrade_version_310_I
  641. ###
  642. ### Conclude Reindexing
  643. ###
  644.  
  645. sub upgrade_version_310_I {
  646.     my ($tempfile, $FORMref, $result) = @_;
  647.     dreq("fcn-indx");
  648.     my $d = directory_list("$DCONF->{admin_dir}/msg_index", '^\d+-tree\.TMP$', 1);
  649.     $FORMref->{total} = scalar(@{$d}) if ! $FORMref->{total};
  650.     if (scalar(@{$d}) == 0) {
  651.         _upgrade_version_310_I_maintree();
  652.         upgrade_version_310_gauge($tempfile, $result, { descr => 410, posi => 10 });
  653.     }
  654.     my $k = pop @{$d};
  655.     if ($k =~ m|^(\d+)-tree\.TMP$|) {
  656.         sorter($1);
  657.     } else {
  658.         unlink "$DCONF->{admin_dir}/msg_index/$k";
  659.     }
  660.     upgrade_version_310_gauge($tempfile, $result, { descr => 409, posi => 9, total => $FORMref->{total}, done => 1 + $FORMref->{done} });
  661. }
  662.  
  663. sub _upgrade_version_310_I_maintree {
  664.     my $J = board_topics();
  665.     my @t = grep($_->{type} == 1, @{$J});
  666.     my @M = ();
  667.     foreach my $T (@t) {
  668.         my $k = read_tree($T->{number}, { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  669.         push @M, $k->[0] if ref $k eq 'ARRAY' && defined $k->[0]->{topic};
  670.     }
  671.     write_tree(0, \@M, { no_lock => 1 });
  672. }
  673.  
  674. ###
  675. ### upgrade_version_310_J
  676. ###
  677. ### Conclude Search Log Indexing
  678. ###
  679.  
  680. sub upgrade_version_310_J {
  681.     my ($tempfile, $FORMref, $result) = @_;
  682.     dreq("fcn-indx");
  683.     my $d = directory_list("$DCONF->{admin_dir}/msg_index", '^\d+-search\.TMP$', 1);
  684.     $FORMref->{total} = scalar(@{$d}) if ! $FORMref->{total};
  685.     if (scalar(@{$d}) == 0) {
  686.         upgrade_version_310_gauge($tempfile, $result, { descr => 411, posi => 11 });
  687.     }
  688.     my $k = pop @{$d};
  689.     if ($k =~ m|^(\d+)-search\.TMP$|) {
  690.         open (SRC, "< $DCONF->{admin_dir}/msg_index/$k");
  691.         open (DEST, "> $DCONF->{admin_dir}/msg_index/$1-search.txt");
  692.         while (<SRC>) { print DEST; }
  693.         close (DEST);
  694.         close (SRC);
  695.         unlink "$DCONF->{admin_dir}/msg_index/$k";
  696.     } else {
  697.         unlink "$DCONF->{admin_dir}/msg_index/$k";
  698.     }
  699.     upgrade_version_310_gauge($tempfile, $result, { descr => 410, posi => 10, total => $FORMref->{total}, done => 1 + $FORMref->{done} });
  700. }
  701.  
  702. ###
  703. ### upgrade_version_310_K
  704. ###
  705. ### Regenenerate Board, fully upgrading files
  706. ###
  707.  
  708. sub upgrade_version_310_K {
  709.     my ($tempfile, $FORMref, $result) = @_;
  710.     dreq("fcn-regn");
  711.     if (! -e "$DCONF->{admin_dir}/backups/$tempfile.TMP") {
  712.         my $out = incremental({ operation => 1, tempfile => $tempfile });
  713.         upgrade_version_310_gauge($tempfile, $result, { total => $out->{count}, descr => 411, posi => 11 });
  714.     }
  715.     my $i = incremental({ tempfile => $tempfile, operation => "read" });
  716.     my $R = regeneration_resource_init();
  717.     my $last_topic_number = 0;
  718.     my $tree = undef;
  719.     lock("*");
  720.     while (my $f = shift @{ $i->{data} }) {
  721.         chomp $f;
  722.         my ($topic, $page) = ($f =~ m|^(\d+)/(\d+)|);
  723.         next if $page == 0;
  724.         my $dirpath = get_message_path($topic);
  725.         next if ! -e "$dirpath/$topic.$DCONF->{ext}";
  726.         if ($last_topic_number == 0) {
  727.             $last_topic_number = $topic;
  728.             $tree = read_tree($topic, { no_unlock => 1, no_lock => 1 });
  729.         } elsif ($last_topic_number != $topic) {
  730.             unshift(@{ $i->{data} }, "$f\n");
  731.             last;
  732.         }
  733.         my $pinfo = GetPage($topic, $page);
  734.         $pinfo->{general}->{subtopic_raw} = 0;
  735.         $pinfo->{general}->{messages_raw} = 0;
  736.         $pinfo->{head}->{owner} = undef;
  737.         $pinfo->{sublist} = expand_sublist($pinfo->{sublist}, $topic, $tree) if scalar(@{ $pinfo->{sublist} });
  738.         SetPage($pinfo);
  739.         $R = regeneration_resource_estimate($R, 1, $pinfo->{general}->{'length'});
  740.         last if regeneration_reset_trigger($R);
  741.         $FORMref->{done}++;
  742.     }
  743.     unlock("*");
  744.     my $iw = incremental({ operation => 3, data => $i->{data}, tempfile => $tempfile });
  745.     if ($iw->{'continue'}) {
  746.         upgrade_version_310_gauge($tempfile, $result, { total => $FORMref->{total}, done => $FORMref->{done}, descr => 411, posi => 11 });
  747.     }
  748.     upgrade_version_310_gauge($tempfile, $result, { descr => 412, posi => 12 });
  749. }
  750.  
  751. ###
  752. ### upgrade_version_310_L
  753. ###
  754. ### Generate Posting Mini-Logs
  755. ###
  756.  
  757. sub upgrade_version_310_L {
  758.     my ($tempfile, $FORMref, $result) = @_;
  759.     dreq("adm-dr");
  760.     my $tfmini = join("", $tempfile, "MINI");
  761.     if (! -e "$DCONF->{admin_dir}/backups/$tfmini.TMP") {
  762.         my $ttl = log_recovery_3({ tempfile => $tfmini }, undef, 1);
  763.         upgrade_version_310_gauge($tempfile, $result, { total => $ttl, done => 0, descr => 412, posi => 12 }) if $ttl > 0;
  764.         upgrade_version_310_M($tempfile, $FORMref, $result);
  765.     } else {
  766.         my ($frdone, $isdone) = log_recovery_4( { tempfile => $tfmini, done => 0 }, undef, 1, 1);
  767.         upgrade_version_310_M($tempfile, $FORMref, $result) if $isdone == 1;
  768.         upgrade_version_310_gauge($tempfile, $result, { done => 1 + $FORMref->{done}, total => $FORMref->{total}, descr => 412, posi => 12 });
  769.     }    
  770. }
  771.  
  772. ###
  773. ### upgrade_version_310_M
  774. ###
  775. ### Finish upgrade (prompt re-registration, etc.)
  776. ###
  777.  
  778. sub upgrade_version_310_M {
  779.     my ($tempfile, $FORMref, $result) = @_;
  780.     dreq("adm-menu", "adm-opts", "topic-pg");
  781.     check_first_install_serial();
  782.     my $tfile = join("/", $DCONF->{admin_dir}, "backups", join(".", $tempfile, "DUP"));
  783.     my @J = ();
  784.     if (-e $tfile) {
  785.         my $X = readfile($tfile, "upgrade_version_310_L", { no_lock => 1, no_unlock => 1 });
  786.         unlink $tfile;
  787.         foreach my $x (@{$X}) {
  788.             chomp $x;
  789.             my ($old, $new, $email, $fullname, $group) = split(/:/, $x);
  790.             push @J, { old_username => $old, new_username => $new, email => $email, fullname => $fullname, group => $group };
  791.         }
  792.         @J = sort { $a->{old_username} cmp $b->{old_username} } @J;
  793.     }
  794.     options_save( { maintenance => 0 }) if $GLOBAL_OPTIONS->{maintenance} == 2;
  795.     regenerate_topic_page();
  796.     my $subst = {};
  797.     $subst->{'changed'} = \@J;
  798.     $subst->{'general'}->{'skipreg'} = 0;
  799.     $subst->{'general'}->{'email'} = $result->[0]->{email};
  800.     $subst->{'general'}->{'name'} =  $result->[0]->{fullname};
  801.     $subst->{'general'}->{'recent_upgrade'} = 1;
  802.     screen_out("register", $subst);
  803. }
  804.  
  805. ###
  806. ### upgrade_version_310_gauge
  807. ###
  808. ### Gauge for the upgrade of version 3.10 to 4.00+
  809. ###
  810.  
  811. sub upgrade_version_310_gauge {
  812.     my ($tempfile, $result, $hash, $cookie) = @_;
  813.     my $subst = {};
  814.     my $total = defined $hash->{total} ? $hash->{total} : 0;
  815.     my $done = defined $hash->{done} ? $hash->{done} : 0;
  816.     $subst->{'gauge'}->{'refresh_url'} = "$PARAMS->{cgiurl}?action=upgrade-act&username=$result->[0]->{user}&upgrtf=$tempfile&total=$total&done=$done&posi=$hash->{posi}";
  817.     $subst->{'gauge'}->{'operation'} = 4;
  818.     $subst->{'gauge'}->{'description'} = defined $hash->{descr} ? $hash->{descr} : 499;
  819.     $subst->{'gauge'}->{'total'} = $total;
  820.     $subst->{'gauge'}->{'done'} = $done;
  821.     $subst->{'gauge'}->{'percent'} = $total > 0 ? (int(100*$done/$total)) : 0;
  822.     screen_out("gauge", $subst, $cookie);
  823. }
  824.  
  825. 1;
  826.