Show upgrade-224-to-23.pl syntax highlighted
#!/usr/bin/perl
BEGIN { use FindBin; use lib "$FindBin::Bin"; }
$| = 1; # do not buffer output on STDOUT
our $VERSION = '1.00';
use strict;
use warnings;
use File::Spec::Functions qw(catfile canonpath rel2abs abs2rel splitpath);
use File::Basename;
use File::Copy;
use install::Wizard;
use LoadConfig;
use Getopt::Long;
use DBI;
use Data::Dumper;
use util;
use PS;
our ($wiz,$origconf,$c,$conf,$in,$args,$db);
die usage() unless GetOptions(
'config=s' => \$args->{config},
'nopause' => \$args->{nopause},
'noconfigs' => \$args->{noconfigs}, # skip config file processing?
'nodb' => \$args->{nodb},
);
$args->{config} = 'stats.cfg' unless $args->{config};
my $fromver = "2.2.4b";
my $tover = "2.3";
my $statscfgname = $args->{config};
my $install = catfile($FindBin::Bin, 'install.pl');
my $statspl = catfile($FindBin::Bin, 'stats.pl');
my $statscfg = catfile($FindBin::Bin, $statscfgname);
my $defaultstatscfg = catfile('..', "psychostats".$fromver, $statscfgname);
LoadConfig->ADDPATH($FindBin::Bin);
# load the current config for the current version of PS
$origconf = LoadConfig->load( location => "stats.cfg.orig" ); # do not use $statscfgname here
# initialize the wizard
$wiz = new install::Wizard();
$wiz->wraptext([
"PsychoStats v$fromver to v$tover upgrade wizard.\\n\\n",
"Your PsychoStats v$fromver installation will be upgraded to v$tover. All player data will remain intact. ",
"Including all player and clan customizations. Any changes to your config files will also be saved. ",
"However, any changes you have made to the 'psweb' theme will be lost. Backup whatever files you need before continuing.",
"\\n\\nIMPORTANT: If your current PsychoStats v$fromver installation does not actually work 100 percent this upgrade ",
'will fail. If you receive any errors during the upgrade you will have to start over with a new installation.',
"\\n\\nI need to know where your $statscfgname file from the previous v$fromver installation is located. ",
"The path you enter here should be a valid directory or filename of your $statscfgname file that was used ",
"in your PsychoStats v$fromver installation. It must be in a DIFFERENT directory then the current v$tover directory ",
"that you're currently in right now.",
]);
$defaultstatscfg = "" unless -f $defaultstatscfg; # if the default stats.cfg location isn't valid default to nothing
$in = $defaultstatscfg;
while (1) {
$wiz->wraptext("\\nWhere is your original v$fromver $statscfgname file located?");
$in = $wiz->promptfor("Filename [$in]: ", $in);
$in = canonpath($in);
$in = catfile($in, $statscfgname) if $in and -f catfile($in, $statscfgname); # append 'stats.cfg' if it's valid
last if $in and -f $in;
$wiz->wraptext('* Invalid file path given! You must specify a valid directory or file.');
}
$wiz->wraptext("File Found: $in\n");
### STEP 1: Load original configs and merge with new 2.3 configs
unless ($args->{noconfigs}) {
$wiz->wraptext(">>> Processing configuration files ...");
sleep(1) unless $args->{nopause};
$conf = mergeconf($origconf, $in);
writeconfig($conf, $statscfg);
# find all config files and merge each into our current directory
my @destlist = ();
my @srclist = ();
my $srcpath = dirname($in);
my $destpath = $FindBin::Bin;
push(@destlist, sort grep { /\.cfg$/ } processpath($destpath, '*.cfg'));
push(@destlist, sort grep { /\.cfg$/ } processpath("$destpath/games/*"));
foreach my $destfile (@destlist) {
next if $destfile =~ /$statscfgname/; # ignore the basic stats.cfg since it was handled above ...
my $file = basename($destfile);
my $sdir = dirname($destfile);
my $nobase = $destfile;
$sdir =~ s/$destpath/$srcpath/;
my $srcfile = catfile($sdir, $file);
$nobase =~ s/$destpath//;
$nobase = substr($nobase, 1) if $nobase =~ m|[\\/]|; # remove leading slash
my $c = LoadConfig->load( location => $srcfile, fatal => 0, warning => 0 ); # load old version of file
next if !$c;
$wiz->wraptext("\\s2Processing $nobase ... ");
my $allkeys = ($srcfile !~ /clantags/); # we keep original clantag keys
my $newconf = mergeconf($c, $destfile, $allkeys); # merge old version of file into new
writeconfig($newconf, $destfile); # write new config over current files
}
$wiz->wraptext(">>> Copying state.psf file ...");
my $f = 'state.psf';
copy(catfile($srcpath, $f), catfile($destpath, $f));
}
### STEP 2: Add new tables into the database
unless ($args->{nodb}) {
$wiz->wraptext(">>> Adding new tables to database ...");
sleep(1) unless $args->{nopause};
$db = DBI->connect("DBI:mysql:$conf->{mysql}{dbname};host=$conf->{mysql}{host}",
$conf->{mysql}{username},
$conf->{mysql}{password},
{ PrintError => 0, RaiseError => 0, AutoCommit => 1 }
) or logerror("MYSQL ERROR: " . $DBI::errstr,1);
# load the new sql file
my $tables;
my $sqlfile = catfile('install', 'sql_' . $conf->{savetype} . '.txt');
my $sqltext = join('', slurpfile(catfile($FindBin::Bin, $sqlfile)));
$sqltext =~ s/^(#|--).*$//mg; # remove the comments
$sqltext = trim($sqltext); # remove leading/trailing whitespace
$sqltext =~ s/\n{3,}/\n\n/mg; # remove blank lines (leaving only a single newline between each table)
my @sqltables = split(/\n\n/, $sqltext); # seperate each table
my $s = $conf->{ $conf->{savetype} };
# get a list of current tables already in the database
my $sth = $db->prepare("SHOW TABLES");
if ($sth->execute()) {
while (my $data = $sth->fetchrow_arrayref) {
$tables->{ $data->[0] } = 1;
}
} else {
logerror("MYSQL ERROR (loading tables): " . $db->errstr, 1);
}
# loop through tables that are found in the installation SQL file
foreach my $sql (@sqltables) {
$sql =~ s/pstats_/$s->{tableprefix}/ if $s->{tableprefix} ne 'pstats_';
if ($sql =~ /^\s*CREATE TABLE `(.+?)`/i) {
my $tbl = $1;
next if exists $tables->{$tbl}; # if it already exists ignore it. We only want new tables
$wiz->wraptext("\\s2Creating table $tbl ...");
if (!$db->do($sql)) {
logerror("MYSQL ERROR (table): " . $db->errstr,0); # show the error, but do not FATAL die
}
}
}
### STEP 3: delete older tables ...
$wiz->wraptext(">>> Drop old tables ... ");
sleep(1) unless $args->{nopause};
foreach my $tbl (qw(gamemaps_cssource plrdata_cssource plrmaps_cssource)) {
my $table = $s->{tableprefix} . $tbl;
next unless exists $tables->{$table};
$wiz->wraptext("\\s2Dropping table $table ...");
$db->do("DROP TABLE $table");
}
### STEP 4: copy player/clan profile information from old table to the new table
my $settings = { CONFFILE => $statscfg, params => { quiet => 1 } };
my $ps = PS->new($settings)->do_init($settings);
my $saver = $ps->getobj('saver');
$wiz->wraptext(">>> Moving player/clan profiles ...");
sleep(1) unless $args->{nopause};
my @keys = qw(worldid name ipaddr plremail plraim plricq plrmsn plrwebsite plricon plrlogo plrnamelocked username password accesslevel);
my $total = $saver->load_registered_plrlist({ TOTAL => 1 });
my $totaldone = 0;
my $limit = 1000;
my $pct;
while ($totaldone < $total) { # while there are players to process .....
my $plrlist = $saver->load_registered_plrlist({
START => $totaldone,
LIMIT => $limit,
ALLOWALL => 1, # make sure we process everyone
NOCALC => 1, # don't include calculated variables
});
foreach my $plr (@$plrlist) {
$totaldone++;
$pct = sprintf("%3.0f", calcpct($totaldone, $total));
my $cmd = $plr->{plrprofileid} ? "UPDATE " : "INSERT INTO ";
$cmd .= $saver->{t_plrprofile} . " SET ";
foreach my $key (@keys) {
$cmd .= "`$key`=" . $db->quote($plr->{$key}) . ", ";
}
$cmd = substr($cmd, 0, -2); # remove trailing: ", "
$cmd .= " WHERE plrprofileid=" . $db->quote($plr->{plrprofileid}) if $plr->{plrprofileid};
if (!$db->do($cmd)) {
print "\n";
logerror("MYSQL ERROR (plr profile #$plr->{plrid}): " . $db->errstr,0);
}
print " Player $totaldone/$total [$pct%] \r"; # don't use wraptext() here ...
} # foreach plr in plrlist ...
} # while totaldone < total ...
print "\n";
@keys = qw(clantag clanname clanlogo clanemail clanicon clanwebsite clanlocked);
$total = $saver->load_registered_clanlist({ TOTAL => 1 });
$totaldone = 0;
$limit = 1000;
$pct = 0;
while ($totaldone < $total) { # while there are players to process .....
my $clanlist = $saver->load_registered_clanlist({
START => $totaldone,
LIMIT => $limit,
ALLOWALL => 1, # make sure we process everyone
NOCALC => 1, # don't include calculated variables
});
foreach my $clan (@$clanlist) {
$totaldone++;
$pct = sprintf("%3.0f", calcpct($totaldone, $total));
my $cmd = $clan->{clanprofileid} ? "UPDATE " : "INSERT INTO ";
$cmd .= $saver->{t_clansprofile} . " SET ";
foreach my $key (@keys) {
$cmd .= "`$key`=" . $db->quote($clan->{$key}) . ", ";
}
$cmd = substr($cmd, 0, -2); # remove trailing: ", "
$cmd .= " WHERE clanprofileid=" . $db->quote($clan->{clanprofileid}) if $clan->{clanprofileid};
if (!$db->do($cmd)) {
print "\n";
logerror("MYSQL ERROR (clan profile #$clan->{clanid}): " . $db->errstr,0);
}
print " Clan $totaldone/$total [$pct%] \r"; # don't use wraptext() here ...
} # foreach clan in clanlist ...
} # while totaldone < total ...
print "\n";
### Alter original tables to new formats ...
$wiz->wraptext(">>> Updating table structures ... ");
sleep(1) unless $args->{nopause};
my @lines = ();
while (defined(my $line = <DATA>)) {
push(@lines, $line);
}
chomp(@lines);
my $idx = 0;
my $table = '';
while ($idx < @lines) {
my $line = $lines[$idx];
$line =~ s/^\s+//;
$line =~ s/\s+$//;
if ($line eq '') {
$idx++;
next;
}
if ($table eq '') { # continue until we find the next table to alter
$table = $1 if $line =~ /^TABLE: (\S+)/i;
} else {
if ($line =~ /^TABLE: \S+/i) { # reset table and redo this iteration to capture the table name
$table = '';
next;
}
my $tblname = $s->{tableprefix} . $table;
my $cmd = sprintf($line, $tblname);
my $res = $db->do($cmd);
if (!$res) {
logerror("MYSQL ERROR ($tblname): " . $db->errstr,0);
}
}
$idx++;
}
$wiz->wraptext(">>> Assigning default ranks to players ...");
sleep(1) unless $args->{nopause};
$db->do('SET @newrank := 0'); # initialize the rank variable
$db->do("UPDATE $s->{tableprefix}plr SET rank=IF(allowrank, \@newrank:=\@newrank+1, 0) ORDER BY `skill` DESC ");
$wiz->wraptext(">>> Setting PsychoStats version to $tover ...");
sleep(1) unless $args->{nopause};
my $verexists = $db->selectcol_arrayref("SELECT 1 FROM " . $s->{tableprefix} . "info WHERE `name`='version'");
my $cmd = $verexists->[0] ? "UPDATE " : "INSERT INTO ";
$cmd .= $s->{tableprefix} . "info SET `name`='version', `value`=" . $db->quote($tover);
$cmd .= " WHERE `name`='version'" if $verexists->[0];
if (!$db->do($cmd)) {
logerror("MYSQL ERROR: " . $db->errstr);
}
}
print "\n" . hline('- ') . "\n";
$wiz->wraptext([
"\\nThis last stage of the upgrade will update the web and theme files on your stats website. When you're ready ",
"press the <enter> key and the Install Wizard will run through the updating process. This stage is automatic and ",
"you will see a lot of information scroll by, you can ignore it (assuming there are no errors).\n",
"If you do not want this step to occur automatically you may press ^C now. However, if you do this your stats website ",
"will not function properly until all of the web related PsychoStats files are updated.",
"\\n",
]);
$wiz->pause(1);
system($install, "-upgrade"); # do web upgrade
#system($statspl, "-nologs", "-noawards", "-playerranks"); # assign a rank to everyone
print "\n" . hline('- ') . "\n";
$wiz->wraptext([
"$fromver to $tover PsychoStats upgrade complete. \\n",
"Once you've confirmed that everything is working you can delete the old psychostats$fromver directory ",
"and keep this current directory instead. ",
]);
exit(0);
# -----------------------------------------------------------------
# Get all files in a directory and its sub-directories
sub processpath {
my ($path,$wildcard) = @_;
my @list = ();
$wildcard ||= '*';
foreach my $f (glob($path)) {
# print "$f\n";
push(@list, -d $f ? processpath("$f/$wildcard") : $f );
}
return @list;
}
# -----------------------------------------------------------------
# merge the configs together, but only new keys
# $in is a filename to the new config to merge the $origconf hash into
sub mergeconf {
my ($origconf, $in, $allkeys) = @_;
$allkeys ||= 0;
my $conf = LoadConfig->load( location => $in, fatal => 0, warning => 0 );
return $origconf if !$conf;
foreach my $key (keys %$origconf) {
if (ref $origconf->{$key} eq 'HASH') {
foreach my $k2 (keys %{$origconf->{$key}}) {
$conf->{$key}{$k2} = $origconf->{$key}{$k2} if $allkeys or !exists $conf->{$key}{$k2};
}
} else {
$conf->{$key} = $origconf->{$key} if $allkeys or !exists $conf->{$key};
}
}
return $conf;
}
# -----------------------------------------------------------------
sub writeconfig {
my ($c, $filename) = @_;
my ($sub, $key, $value, @list, @sublist);
my $length = 0;
if (open(F, ">$filename")) {
print F "# Config auto-generated on " . scalar(localtime) . "\n\n";
# first we write all global variables ...
@list = sort grep { ref $c->{$_} ne 'HASH' } keys %$c;
foreach (@list) { # get longest length of variables
$length = length($_) if length($_) > $length;
}
foreach $key (@list) {
print F _writevar($key, $c->{$key}, '', $length);
}
# now we write all non-global variables ...
@list = sort { ($c->{$a}{IDX} || 0) <=> ($c->{$b}{IDX} || 0) } grep { ref $c->{$_} eq 'HASH' } keys %$c;
foreach $key (@list) {
print F "\n[" . (defined $c->{$key}{SECTION} ? $c->{$key}{SECTION} : $key) . "]\n";
@sublist = sort keys %{$c->{$key}};
$length = 0;
foreach (@sublist) { # get longest length of variables
$length = length($_) if length($_) > $length;
}
foreach $sub (@sublist) {
next if uc $sub eq $sub;
print F _writevar($sub, $c->{$key}{$sub}, ' ', $length);
}
}
close(F);
# $wiz->{conf} = $c;
} else {
return 0;
}
return 1;
}
# -----------------------------------------------------------------
# internal func for writeconfig(), do not call directly
sub _writevar {
my ($key, $value, $prefix, $length) = @_;
my $line = "";
if (ref $value eq 'ARRAY') {
$line .= _writevar($key, $_, $prefix, $length) foreach @$value; # write each array element seperately
} else {
$line = $length ? sprintf("%-${length}s ", $key) : "$key ";
if ($value =~ /\n/) { # if there are newlines, we treat the variable as a var >> END block
$value .= "\n" unless $value =~ /\n$/; # add newline if its not present
$line .= ">> END\n" . $value . "END\n";
} elsif ($value =~ /^\s+/ or $value =~ /\s+$/) { # if there are leading/trailing spaces we surround it with quotes
$line .= "= \"$value\"\n";
} else { # just print it out normally
$line .= "= $value\n";
}
}
return defined $prefix ? $prefix . $line : $line;
}
# -----------------------------------------------------------------
sub trim {
my ($s) = @_;
$s =~ s/^\s+//;
$s =~ s/\s+$//;
return $s;
}
# -----------------------------------------------------------------
sub hline {
my $pat = shift || '- ';
my $width = shift || $wiz->{SCREENWIDTH};
return $pat x int( $width / length($pat) );
}
# -----------------------------------------------------------------
__DATA__
TABLE: plr
ALTER TABLE `%s` ADD `oldrank` mediumint(8) unsigned NOT NULL AFTER `rank`
ALTER TABLE `%s` DROP `plrnamelocked`
ALTER TABLE `%s` DROP `plremail`
ALTER TABLE `%s` DROP `plraim`
ALTER TABLE `%s` DROP `plricq`
ALTER TABLE `%s` DROP `plrmsn`
ALTER TABLE `%s` DROP `plrwebsite`
ALTER TABLE `%s` DROP `plricon`
ALTER TABLE `%s` DROP `plrlogo`
ALTER TABLE `%s` DROP `username`
ALTER TABLE `%s` DROP `password`
ALTER TABLE `%s` DROP `accesslevel`
TABLE: clans
ALTER TABLE `%s` DROP `clanname`
ALTER TABLE `%s` DROP `clanlogo`
ALTER TABLE `%s` DROP `clanemail`
ALTER TABLE `%s` DROP `clanicon`
ALTER TABLE `%s` DROP `clanwebsite`
ALTER TABLE `%s` DROP `clanlocked`
ALTER TABLE `%s` ADD UNIQUE (`clantag`)
See more files for this project here