irpgdbtool

   1 # IRPG db conversion tool; converts db version 2.4 -> 3.0
   2 # Jon Honeycutt, jotun@idlerpg.net, http://idlerpg.net
   3 # Free for all use, public and private, with retention of copyright notice.
   4
   5 use strict;
   6 use IO::Socket;
   7
   8 my %rps = ();
   9 my $temp;
  10
  11 $|=1;
  12
  13 print "\nIRPG db conversion tool; version 2.4 -> 3.0\n\n";
  14
  15 do {
  16     print "Read from file [irpg.db]: ";
  17     chomp($temp=<STDIN>);
  18     $temp ||= "irpg.db";
  19     if (! -e $temp) { print "Error: No such file\n"; }
  20 } until (-e $temp);
  21
  22 loaddb($temp);
  23
  24 print "Loaded ".scalar(keys(%rps))." accounts from $temp.\n";
  25
  26 do {
  27     print "\nBackup old irpg.db file? [yes]: ";
  28     chomp($temp=<STDIN>);
  29     $temp||="yes";
  30     $temp=lc($temp);
  31 } until ($temp eq "yes" || $temp eq "no");
  32
  33 if ($temp eq "yes") {
  34     do {
  35         print "\nBackup filename [irpg.db.old]: ";
  36         chomp($temp=<STDIN>);
  37         $temp||="irpg.db.old";
  38     } until (defined($temp));
  39     open(RPS,">$temp") or die("Cannot write $temp: $!");
  40     print RPS "# username\tpass\tlevel\tclass\tnext\tnick\tuserhost\tonline\t".
  41               "idled\tpen_mesg\tpen_nick\tpen_part\tpen_kick\tpen_quit\t".
  42               "pen_quest\tpen_logout\tcreated\tlast login\tamulet\tcharm\t".
  43               "helm\tboots\tgloves\tring\tleggings\tshield\ttunic\tweapon\n";
  44     for my $k (keys %rps) {
  45         print RPS join("\t",
  46           $k,
  47           $rps{$k}{pass},
  48           $rps{$k}{level},
  49           $rps{$k}{class},
  50           $rps{$k}{next},
  51           $rps{$k}{nick}||"",
  52           $rps{$k}{userhost}||"",
  53           $rps{$k}{online}||0,
  54           $rps{$k}{idled}||0,
  55           $rps{$k}{pen_mesg}||0,
  56           $rps{$k}{pen_nick}||0,
  57           $rps{$k}{pen_part}||0,
  58           $rps{$k}{pen_kick}||0,
  59           $rps{$k}{pen_quit}||0,
  60           $rps{$k}{pen_quest}||0,
  61           $rps{$k}{pen_logout}||0,
  62           $rps{$k}{created},
  63           $rps{$k}{lastlogin},
  64           $rps{$k}{item}{amulet}||0,
  65           $rps{$k}{item}{charm}||0,
  66           $rps{$k}{item}{helm}||0,
  67           $rps{$k}{item}{"pair of boots"}||0,
  68           $rps{$k}{item}{"pair of gloves"}||0,
  69           $rps{$k}{item}{ring}||0,
  70           $rps{$k}{item}{"set of leggings"}||0,
  71           $rps{$k}{item}{shield}||0,
  72           $rps{$k}{item}{tunic}||0,
  73           $rps{$k}{item}{weapon}||0)."\n";
  74     }
  75     close(RPS);
  76     print "Wrote $temp.\n";
  77 }
  78
  79 do {
  80     print "\nReset all user levels to 0, all times to level to 0, all items ".
  81           "to 0, all penalties to 0, all online flags to 0, all idled times ".
  82           "to 0, all creation dates and last login times to today (i.e., ".
  83           "reset game)? [no]: ";
  84     chomp($temp=<STDIN>);
  85     $temp||="no";
  86     $temp=lc($temp);
  87 } until ($temp eq "yes" || $temp eq "no");
  88
  89 if ($temp eq "yes") {
  90     for my $k (keys(%rps)) {
  91         $rps{$k}{next}=0;
  92         $rps{$k}{level}=0;
  93         $rps{$k}{online}=0;
  94         $rps{$k}{idled}=0;
  95         $rps{$k}{item}{amulet}=0;
  96         $rps{$k}{item}{charm}=0;
  97         $rps{$k}{item}{helm}=0;
  98         $rps{$k}{item}{"pair of boots"}=0;
  99         $rps{$k}{item}{"pair of gloves"}=0;
 100         $rps{$k}{item}{ring}=0;
 101         $rps{$k}{item}{"set of leggings"}=0;
 102         $rps{$k}{item}{shield}=0;
 103         $rps{$k}{item}{tunic}=0;
 104         $rps{$k}{item}{weapon}=0;
 105         $rps{$k}{pen_mesg}=0;
 106         $rps{$k}{pen_nick}=0;
 107         $rps{$k}{pen_part}=0;
 108         $rps{$k}{pen_kick}=0;
 109         $rps{$k}{pen_quit}=0;
 110         $rps{$k}{pen_quest}=0;
 111         $rps{$k}{pen_logout}=0;
 112         $rps{$k}{created}=time();
 113         $rps{$k}{lastlogin}=time();
 114     }
 115     print "Game reset.\n";
 116 }
 117
 118 do {
 119     print "\nStrip all control codes from character names and classes? [no]: ";
 120     chomp($temp=<STDIN>);
 121     $temp ||="no";
 122     $temp=lc($temp);
 123 } until ($temp eq "yes" || $temp eq "no");
 124
 125 if ($temp eq "yes") {
 126     my(@usernames,@classes);
 127     for my $k (keys(%rps)) {
 128         if ($k =~ /[[:cntrl:]]/) {
 129             my $newusername = $k;
 130             $newusername =~ s/[[:cntrl:]]//g;
 131             if (exists($rps{$newusername}) || !defined($newusername) ||
 132                 !length($newusername)) {
 133                 print "\nError: While trying to strip control codes from $k, ".
 134                       "found stripped version ($newusername) already exists ".
 135                       "in database or is undefined. Skipping this user, so ".
 136                       "sorry.\n";
 137             }
 138             else {
 139                 $rps{$newusername}=delete($rps{$k});
 140                 push(@usernames,"$k is now: $newusername");
 141                 $k = $newusername;
 142             }
 143         }
 144         if ($rps{$k}{class} =~ /[[:cntrl:]]/) {
 145             $rps{$k}{class} =~ s/[[:cntrl:]]//g;
 146             push(@classes,"$k is now: $rps{$k}{class}");
 147         }
 148     }
 149     if (@usernames) {
 150         print "\nUsernames changed (would be good to alert these users):\n";
 151         print "User $_\n" for @usernames;
 152         print "\n";
 153     }
 154     if (@classes) {
 155         print "\nClass names changed (might be good to alert these users):\n";
 156         print "User $_\n" for @classes;
 157         print "\n";
 158     }
 159 }
 160
 161 do {
 162     print "\nStrip all non-printable characters from character names and ".
 163           "classes? [no]: ";
 164     chomp($temp=<STDIN>);
 165     $temp ||="no";
 166     $temp=lc($temp);
 167 } until ($temp eq "yes" || $temp eq "no");
 168
 169 if ($temp eq "yes") {
 170     my(@usernames,@classes);
 171     for my $k (keys(%rps)) {
 172         if ($k =~ /[[:^print:]]/) {
 173             my $newusername = $k;
 174             $newusername =~ s/[[:^print:]]//g;
 175             if (exists($rps{$newusername}) || !defined($newusername) ||
 176                 !length($newusername)) {
 177                 print "\nError: While trying to strip non-printable chars ".
 178                       "from $k, found stripped version ($newusername) already ".
 179                       "exists in database or is undefined. Skipping this ".
 180                       "user, so sorry.\n";
 181             }
 182             else {
 183                 $rps{$newusername}=delete($rps{$k});
 184                 push(@usernames,"$k is now: $newusername");
 185                 $k = $newusername;
 186             }
 187         }
 188         if ($rps{$k}{class} =~ /[[:^print:]]/) {
 189             $rps{$k}{class} =~ s/[[:^print:]]//g;
 190             push(@classes,"$k\'s class is now: $rps{$k}{class}");
 191         }
 192     }
 193     if (@usernames) {
 194         print "\nUsernames changed (would be good to alert these users):\n";
 195         print "User $_\n" for @usernames;
 196         print "\n";
 197     }
 198     if (@classes) {
 199         print "\nClass names changed (might be good to alert these users):\n";
 200         print "User $_\n" for @classes;
 201         print "\n";
 202     }
 203 }
 204
 205 do {
 206     print "\nVersion 3.0 supports 'named items,' or a method of marking ".
 207           "unique items as being unique. Attempt to name existing items that ".
 208           "are known uniques? [yes]: ";
 209     chomp($temp=<STDIN>);
 210     $temp ||="yes";
 211     $temp=lc($temp);
 212 } until ($temp eq "yes" || $temp eq "no");
 213
 214 if ($temp eq "yes") {
 215     for my $k (keys(%rps)) {
 216         for my $item (keys(%{$rps{$k}{item}})) {
 217             if ($rps{$k}{item}{$item} > int(1.5*$rps{$k}{level})) {
 218                 if ($item eq "helm") {
 219                     print "$k\'s $item named as Mattt's Omniscience.\n";
 220                     $rps{$k}{item}{$item} .= "a";
 221                 }
 222                 elsif ($item eq "tunic") {
 223                     print "$k\'s $item named as Res0's Protectorate.\n";
 224                     $rps{$k}{item}{$item} .= "b";
 225                 }
 226                 elsif ($item eq "amulet") {
 227                     print "$k\'s $item named as Dwyn's Storm.\n";
 228                     $rps{$k}{item}{$item} .= "c";
 229                 }
 230                 elsif ($item eq "weapon" && $rps{$k}{item}{$item} < 175) {
 231                     print "$k\'s $item named as Jotun's Fury.\n";
 232                     $rps{$k}{item}{$item} .= "d";
 233                 }
 234                 elsif ($item eq "weapon" && $rps{$k}{item}{$item} > 175 &&
 235                        $rps{$k}{item}{$item} < 201) {
 236                     print "$k\'s $item named as Drdink's Cane of Blind Rage.\n";
 237                     $rps{$k}{item}{$item} .= "e";
 238                 }
 239                 else {
 240                     print "$k has unknown unique of level ".
 241                           "$rps{$k}{item}{$item}.\n";
 242                 }
 243             }
 244         }
 245     }
 246 }
 247
 248 do {
 249     print "\nThere exist new items in version 3.0 that some of your clients ".
 250           "may already have had the chance to find. I.E., there is a new item ".
 251           "with a required level of 48. Simulate an item find for all users ".
 252           "above 48 for this and other new items to make the game fair for ".
 253           "older users? [yes]: ";
 254     chomp($temp=<STDIN>);
 255     $temp ||="yes";
 256     $temp=lc($temp);
 257 } until ($temp eq "yes" || $temp eq "no");
 258
 259 if ($temp eq "yes") {
 260     for my $k (keys(%rps)) {
 261         if ($rps{$k}{level} >= 48) {
 262             for (48..$rps{$k}{level}) {
 263                 # approximately equal to normal item find, i believe
 264                 if (rand(100) < 2.25) {
 265                     my $ulevel = 250+int(rand(51));
 266                     if ($ulevel > int($rps{$k}{item}{"pair of boots"})) {
 267                         print "$k found level $ulevel Mrquick's Magical Boots ".
 268                               "of Swiftness.\n";
 269                         $rps{$k}{item}{"pair of boots"} = $ulevel."f";
 270                     }
 271                 }
 272             }
 273         }
 274         if ($rps{$k}{level} >= 52) {
 275             for (52..$rps{$k}{level}) {
 276                 # approximately equal to normal item find, i believe
 277                 if (rand(100) < 2.15) {
 278                     my $ulevel = 300+int(rand(51));
 279                     if ($ulevel > int($rps{$k}{item}{weapon})) {
 280                         print "$k found level $ulevel Jeff's Cluehammer of ".
 281                               "Doom.\n";
 282                         $rps{$k}{item}{weapon} = $ulevel."g";
 283                     }
 284                 }
 285             }
 286         }
 287         if ($rps{$k}{level} >= 25) {
 288             for (25..$rps{$k}{level}) {
 289                 # approximately equal to normal item find, i believe
 290                 if (rand(100) < 2.43) {
 291                     my $ulevel = 50+int(rand(25));
 292                     if ($ulevel > int($rps{$k}{item}{ring})) {
 293                         print "$k found level $ulevel Juliet's Glorious Ring ".
 294                               "of Sparkliness.\n";
 295                         $rps{$k}{item}{ring} = $ulevel."h";
 296                     }
 297                 }
 298             }
 299         }
 300     }
 301 }
 302
 303 for my $k (keys(%rps)) {
 304     $rps{$k}{x} = int(rand(500));
 305     $rps{$k}{y} = int(rand(500));
 306     $rps{$k}{isadmin}=0;
 307     $rps{$k}{alignment}="n";
 308 }
 309
 310 print "\nUsernames that you would like to have admin status (separate with ".
 311       "commas, use proper CaSe): ";
 312 chomp($temp=<STDIN>);
 313 $temp =~ s/\s//g;
 314 for my $k (split(/,/,$temp)) {
 315     if (!exists($rps{$k})) {
 316         print "\nError: Account name '$k' does not exist. Remember that ".
 317               "account names are case sensitive. Skipping this username. Edit ".
 318               "the database manually, or use the MKADMIN command after the ".
 319               "bot connects to add this user.\n\n";
 320     }
 321     else {
 322         print "$k is now admin.\n";
 323         $rps{$k}{isadmin}=1;
 324     }
 325 }
 326 print "\nYou can add more admins later with the MKADMIN command.\n";
 327
 328 do {
 329     print "\nWrite to new db file [irpg.db]: ";
 330     chomp($temp=<STDIN>);
 331     $temp ||= "irpg.db";
 332 } until (defined($temp));
 333
 334 open(RPS,">$temp") or die "Cannot open $temp: $!";
 335
 336 print RPS join("\t","# username",
 337     "pass",
 338     "is admin",
 339     "level",
 340     "class",
 341     "next ttl",
 342     "nick",
 343     "userhost",
 344     "online",
 345     "idled",
 346     "x pos",
 347     "y pos",
 348     "pen_mesg",
 349     "pen_nick",
 350     "pen_part",
 351     "pen_kick",
 352     "pen_quit",
 353     "pen_quest",
 354     "pen_logout",
 355     "created",
 356     "last login",
 357     "amulet",
 358     "charm",
 359     "helm",
 360     "boots",
 361     "gloves",
 362     "ring",
 363     "leggings",
 364     "shield",
 365     "tunic",
 366     "weapon",
 367     "alignment")."\n";
 368
 369 for my $k (keys(%rps)) {
 370     print RPS join("\t",
 371         $k,
 372         $rps{$k}{pass},
 373         $rps{$k}{isadmin},
 374         $rps{$k}{level},
 375         $rps{$k}{class},
 376         $rps{$k}{next},
 377         $rps{$k}{nick},
 378         $rps{$k}{userhost},
 379         $rps{$k}{online},
 380         $rps{$k}{idled},
 381         $rps{$k}{x},
 382         $rps{$k}{y},
 383         $rps{$k}{pen_mesg},
 384         $rps{$k}{pen_nick},
 385         $rps{$k}{pen_part},
 386         $rps{$k}{pen_kick},
 387         $rps{$k}{pen_quit},
 388         $rps{$k}{pen_quest},
 389         $rps{$k}{pen_logout},
 390         $rps{$k}{created},
 391         $rps{$k}{lastlogin},
 392         $rps{$k}{item}{amulet},
 393         $rps{$k}{item}{charm},
 394         $rps{$k}{item}{helm},
 395         $rps{$k}{item}{"pair of boots"},
 396         $rps{$k}{item}{"pair of gloves"},
 397         $rps{$k}{item}{ring},
 398         $rps{$k}{item}{"set of leggings"},
 399         $rps{$k}{item}{shield},
 400         $rps{$k}{item}{tunic},
 401         $rps{$k}{item}{weapon},
 402         $rps{$k}{alignment})."\n";
 403 }
 404 close(RPS);
 405
 406 do {
 407     print "\nDone writing $temp! Thanks for your interest in the Idle RPG. May ".
 408           "I send an (anonymous) user count to idlerpg.net? jotun is ".
 409           "interested in knowing how many people play his game :^) [yes]: ";
 410     chomp($temp=<STDIN>);
 411     $temp||="yes";
 412     $temp=lc($temp);
 413 } until ($temp eq "yes" || $temp eq "no");
 414
 415 if ($temp eq "yes") {
 416     print "Sending...\n";
 417     my $sock = IO::Socket::INET->new(PeerAddr=>"jotun.ultrazone.org:80");
 418     if ($sock) {
 419         print $sock "GET /g7/count.php?converted=".scalar(keys(%rps)).
 420                         " HTTP/1.1\r\n".
 421                     "Host: jotun.ultrazone.org:80\r\n\r\n";
 422         1 while <$sock>;
 423     }
 424     print "\nDone! Thanks a million! Enjoy Idle RPG. :^)\n";
 425 }
 426 else {
 427     print "\nI'm setting your chance of evil HoG to 100%, then. Just kidding. ".
 428           "Thanks anyway.\n";
 429 }
 430
 431 sub loaddb { # load the players database
 432   open(RPS,shift(@_)) or die("loaddb() failed: $!");
 433   while (my $l=<RPS>) {
 434     chomp $l;
 435     next if $l =~ /^#/; # skip comments
 436     my @i = split("\t",$l);
 437     print Dumper @i if @i != 28;
 438     die("Anomaly in loaddb(); line $. of database has wrong fields (".
 439       scalar(@i).")") if @i != 28;
 440     ($rps{$i[0]}{pass},
 441     $rps{$i[0]}{level},
 442     $rps{$i[0]}{class},
 443     $rps{$i[0]}{next},
 444     $rps{$i[0]}{nick},
 445     $rps{$i[0]}{userhost},
 446     $rps{$i[0]}{online},
 447     $rps{$i[0]}{idled},
 448     $rps{$i[0]}{pen_mesg},
 449     $rps{$i[0]}{pen_nick},
 450     $rps{$i[0]}{pen_part},
 451     $rps{$i[0]}{pen_kick},
 452     $rps{$i[0]}{pen_quit},
 453     $rps{$i[0]}{pen_quest},
 454     $rps{$i[0]}{pen_logout},
 455     $rps{$i[0]}{created},
 456     $rps{$i[0]}{lastlogin},
 457     $rps{$i[0]}{item}{amulet},
 458     $rps{$i[0]}{item}{charm},
 459     $rps{$i[0]}{item}{helm},
 460     $rps{$i[0]}{item}{"pair of boots"},
 461     $rps{$i[0]}{item}{"pair of gloves"},
 462     $rps{$i[0]}{item}{ring},
 463     $rps{$i[0]}{item}{"set of leggings"},
 464     $rps{$i[0]}{item}{shield},
 465     $rps{$i[0]}{item}{tunic},
 466     $rps{$i[0]}{item}{weapon}) = (@i[1..$#i]);
 467   }
 468   close RPS;
 469 }