| 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 | }
|
|---|
