sub loadcommands { print "loading commands\r\n"; unless (open(COMMANDS, "commands.lst")){ print "can't open the commands file."; die; } $/="\n"; if (defined(%command)){ %command=""; } while ($a=<COMMANDS>){ chomp($a); if ($a=~/<commandset name=(\w*) failed="(.*?[^\\])">/i){ $type=$1; $commandtype{$type}{failed}=$2; next; } if ($a=~/<commandset name=(\w*) type=(.*) sub=(.*)>/i){ $commandtype{$1}{$2}=$3; next; } if ($a=~/<\/commandset>/i){ my @a=sort(keys(%command)); undef %command; $commandlist{$type}=[@a]; $type=undef; next; } if ($a=~/<([^\/].*)>/i){ $command=$1; $command{$command}=$command; next; } if (defined($command) and ($a=~/<\/$command>/i)){ $command=undef; next; } $commands{$type}{$a}=$command; } close (COMMANDS); } sub loadmonster { print "loading monsters\r\n"; $/="</monster>"; $monstertotal=1; unless (open(MONSTER, "monster.xml")){ print "can't open the monster file."; die; } while ($a=<MONSTER>){ unless ($a=~s/<monster num=(\d+)>\n?//i){ print"bad monster #, probably done loading monsters.\r\n"; next; } my $monster=$1; while($a=~s/<adjective>\n?(.*?)\n?<\/adjective>\n?//is){ push (@{$monster[$monster]{adjectives}}, $1); } while ($a=~/<(.*?)>(.*?)<\/\1>/isg){ $monster[$monster]{$1}=$2; } while ($a=~/<(.*?)=(.*?)>/ig){ $monster[$monster]{$1}=$2; } } } sub loadroom{ print "loading rooms\r\n"; $/="</room>"; foreach $map (glob("map/map*.xml")){ print "$map"; unless (open(MAP, "$map")){ print "can't open the mapfile."; die; } while ($a=<MAP>){ unless ($a=~/<room num=(\d+)>/i){ print"bad room #, probably done loading map.\r\n"; next; } my $room=$1; if ($a=~/<hiding difficulty=(\d*)\/>/is){ $room[$room]{hidedifficulty}=$1; } unless($a=~/<shortdesc>\n?(.*)<\/shortdesc>\n?/is){ } $room[$room]{shortdesc}=$1; $a=~/<longdesc>\n?(.*)\n?<\/longdesc>/is; $room[$room]{longdesc}=$1; unless($a=~/<exits>(.*)<\/exits>/is){ } $b=$1; while ($a=~/<item num=(.*?)>/isg){ $item=makeitem($1); additemtoroom($room,$item); } while ($b=~/<(\w+) dest=(\d+)>/ig){ $room[$room]{exits}{$1}=$2; } $b=~/<obvious="(.*)"/is; $room[$room]{obvious}=$1; if ($a=~/<commands>(.*)<\/commands>/is){ $b=$1; while($b=~/<(.*)>?(.*)<\/\1>/gis){ my @a=split(/\n/,$2); chomp(@a); foreach $a (@a){ $room[$room]{commands}{$a}="$1"; } } } } close MAP; } } sub loaditems { print "loading items\r\n"; $/="</item>"; unless (open(ITEM, "item.xml")){ print "can't open the mapfile."; die; } while ($a=<ITEM>){ unless ($a=~/<item num=(.*?)>/i){ print "bad item #, probably done loading items.\r\n"; next; } my $item=$1; while ($a=~/<(.*?)>(.*?)<\/\1>/isg){ $itemtemplate{$item}{$1}=$2; } while ($a=~/<(.*?)=(.*?)>/ig){ $itemtemplate{$item}{$1}=$2; } } close ITEM; } sub loadmuddata{ unless (open(MUD, "muddata.xml")){ print "can't open the muddata file $a: $!."; next; } local $/; $a=<MUD>; while ($a=~/<(.*?)>(.*?)<\/\1>/isg){ ${$1}=$2; } while ($a=~/<(.*?)=(.*?)>/ig){ ${$1}=$2; } close MUD; } sub savemuddata{ unless (open(MUD, "muddata.xml")){ print "can't open the muddata file $a: $!."; next; } local $/; $a=<MUD>; close MUD; $a=~s/<itemtotal=.*?>/<itemtotal=$itemtotal>/is; unless (open(MUD, ">muddata.xml")){ print "can't open the muddata file $a: $!."; next; } print MUD $a; close MUD; } sub loadrealitems { print "loading real items\r\n"; local $/; foreach $a (glob("items/*")){ print "$a\n"; unless (open(ITEM, "$a")){ print "can't open the realitem file $a: $!."; next; } $item=$a; $item=~s/items\///i; while ($a=<ITEM>){ while ($a=~/<(.*?)>(.*?)<\/\1>/isg){ $item{$item}{$1}=$2; } while ($a=~/<(.*?)=(.*?)>/ig){ $item{$item}{$1}=$2; } } close ITEM; } } sub saverealitem { $item=shift; print "saving $item\n\n"; unless (open(ITEM, ">items/$item")){ print "can't save realitem!!!! $!"; return 0; } local $string; foreach $a (keys %{$item{$item}}){ descend($item{$item}{$a},$a); } print ITEM $string; close ITEM; return 1; } sub loadplayer { my $user=shift; my $user2=shift; my $dir=(shift or "players"); unless (open(FILE,"$dir/$user")){ return 0; } local $/; my $c=<FILE>; close(FILE); unless($c=~s/<exp>(.*)<\/exp>\n?//is){ print "ERROR\n"; } my $exp=$1; while($exp=~s/<(.*?)>(.*?)<\/\1>//is){ my $field=$1; my $e=$2; while($e=~s/<(.*?)>(.*?)<\/\1>//is){ my $skill=$1; my $data=$2; while($data=~/<(.*?)=(.*)>/g){ $user{$user2}{exp}{$field}{$skill}{$1}=$2; } } } unless($c=~s/<health>(.*)<\/health>\n?//is){ print "ERROR\n"; } my $health=$1; while($health=~s/<(.*?)>(.*?)<\/\1>//is){ my $field=$1; my $e=$2; $e=~s/<wear>(.*?)<\/wear>//is; my $f=$1; while($e=~s/<(.*?)=(.*?)>//is){ $user{$user2}{health}{$field}{$1}=$2; } if (defined($user{$user2}{health}{$field}{hold})){ push (@{$user{$user2}{hold}}, $field); if ($user{$user2}{health}{$field}{hold}=~/#(\d*)/i){ print "make item $1\n"; $user{$user2}{health}{$field}{hold}=makeitem($1); # print "$user{$user2}{health}{$field}{hold}\n\n"; } } while ($f=~/<(.*?)=(.*?)>/sg){ my $a=$1; my $item=$2; if ($item=~/^#(\d*)/i) { print "make item $1\n"; $item=makeitem($1); } $user{$user2}{health}{$field}{wear}{$a}=$item; # print "$a=$item"; } } my @d=split(/\n/,$c); for $a (@d){ chomp ($a); $a=~s/[<|>]//g; my @e=split(/=/,$a); $user{$user2}{$e[0]}=$e[1]; } return 1; } return 1;