sub loadattacks{ %attack=loadfile("attacks.xml"); } sub loadfile { my $file=shift; open(FILE, "$file"); local $/; my $a=<FILE>; my $hash=load_decend($a); return %{$hash}; } sub loadfilenew { my $file=shift; open(FILE, "$file"); local $/; my $a=<FILE>; eval ($a); return %{$VAR1}; } sub loadcommands { 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 { $/="</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){ 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{ my $filename=shift; $/="</room>"; foreach $map (($filename or glob("map/map*.xml"))){ unless (open(MAP, "$map")){ print "can't open the mapfile."; die; } while ($a=<MAP>){ unless ($a=~s/<num=(\d+)>//i){ next; } my $room=$1; $a=~s/<room>//i; $a=~s/<\room>//i; $room[$room]=load_decend($a); } close MAP; } } sub loaditems { $/="</item>"; unless (open(ITEM, "item.xml")){ print "can't open the mapfile."; die; } while ($a=<ITEM>){ unless ($a=~s/<item num=(.*?)>//i){ next; } my $item=$1; $itemtemplate{$item}=load_decend($a); } 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 $/; my $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 { local $/; my $a; foreach $a (glob("items/*")){ unless (open(ITEM, "$a")){ print "can't open the realitem file $a: $!."; next; } $item=$a; $item=~s/items\///i; $a=<ITEM>; $item{$item}=load_decend("$a"); close ITEM; } } sub saverealitem { $item=shift; 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); eval $c; %{$user{$user2}}=(%{$user{$user2}}, %{$VAR1}); delete $user{$user2}{eng}; #cycle through for items, only really needed for the default items new #players start with foreach $body_part (keys %{$user{$user2}{health}}){ foreach $a (keys %{$user{$user2}{health}{$body_part}{wear}}){ if ($user{$user2}{health}{$body_part}{wear}{$a}=~/#(\d*)/i){ additemtowear("$body_part","$a",makeitem($1)); } } if (defined($user{$user2}{health}{$body_part}{weapon})){ if ($user{$user2}{health}{$body_part}{weapon}=~/#(\d*)/i){ $user{$user2}{health}{$body_part}{weapon} = makeitem($1); } } if (defined($user{$user2}{health}{$body_part}{hold})){ push (@{$user{$user2}{hold}}, $body_part); if ($user{$user2}{health}{$body_part}{hold}=~/#(\d*)/i){ additemtoinventory(makeitem($1),$body_part); } } } return 1; } sub loadplayerold { my $user=shift; my $user2=shift; my $dir=(shift or "players"); unless (open(FILE,"$dir/$user")){ return 0; } local $/; my $c=<FILE>; close(FILE); if (defined($user{$user2})){ $userold=$user{$user2}; $user{$user2}=load_decend($c); %{$user{$user2}}=(%{$userold},%{$user{$user2}}); }else { $user{$user2}=load_decend($c); } foreach $body_part (keys %{$user{$user2}{health}}){ if ($user{$user2}{health}{$body_part}{requires}){ $user{$user2}{health}{$body_part}{requires}=~s/\n//g; } foreach $a (keys %{$user{$user2}{health}{$body_part}{wear}}){ if ($user{$user2}{health}{$body_part}{wear}{$a}=~/#(\d*)/i){ additemtowear("$body_part","$a",makeitem($1)); } } if (defined($user{$user2}{health}{$body_part}{weapon})){ if ($user{$user2}{health}{$body_part}{weapon}=~/#(\d*)/i){ $user{$user2}{health}{$body_part}{weapon}=makeitem($1); } } if (defined($user{$user2}{health}{$body_part}{hold})){ push (@{$user{$user2}{hold}}, $body_part); if ($user{$user2}{health}{$body_part}{hold}=~/#(\d*)/i){ additemtoinventory(makeitem($1),$body_part); } } } return 1; } sub loaddesc { unless (open(DESC, "describe.lst")){ print "can't open the commands file."; die; } local $/; my $a=<DESC>; close DESC; while ($a=~s/<(.*?)>\n(.*?)<\/\1>//is){ my $desc=$1; @{$desc{$desc}}=split(/\n/,$2); } } sub load_decend { my $string=shift; my %hash; my $a; while($string=~s/<(.*?)>(.*?)<\/\1>\n?//is){ $a=1; my $b=$1; $hash{$b}=load_decend($2); if ($b=~/>/s){ print "error1 $b, $c"; } } while($string=~s/<([^>]*?)=([^>]*?)>\n?//is){ $a=1; my $b=$1; $hash{$b}=$2; if ($b=~/>/s){ print "error2 $b, $c, $&"; } } unless ($a){ return $string; } return \%hash; } return 1;