On Thu, 31 Jul 1997, Ron Cole wrote:
> >note, I've got the ascii patch in and tweaked to my liking, but I noticed
> >than when a character self deletes, it doesn't remove their entry from the
> >index file, nor does it remove the actual pfile... hrm hrm.
>
> This was true before also. You had to run purgeplay to get rid of them
> completely.
>
Posted before, but here it is again, just a short messy perl
script to reorder, delete, etc for pfile indexs, aliases, saveobjs, etc...
whatever.. basically purgeplay w/o the timing info for levels, and minus
checks for immos, i think. My own is now far modified of this one, and
specific to my mud, but this one is a good base.
#!/usr/bin/perl
# House Cleaner v.1, by Pat Dughi 5-30-97
# kinda a substitute for automaint once you get that fancy ascii pfile
# thing and they aint removed no more.
#general declares
#change these as needed for your system.
$DELETE_BIT=1024; #this is 2^10 or (1 << 10)
$NODELETE_BIT=8192; #this is 2^13 or (1 << 13)
$START_PLAYER_DIR="a";
@OLD_STYLE_DIRS={
"A-E",
"F-J",
"K-O",
"P-T",
"U-Z",
"ZZZ"
};
$PLAYER_DIR="lib/pfiles";
$RENT_DIR="lib/plrobjs";
$ALIAS_DIR="lib/alias";
$TEMP_DIR="/tmp";
$PLAYER_INDEX="lib/pfiles/plr_index";
# Subroutine "find_old_dir", returns old style directory of character
# being examined.
sub find_old_dir {
my $character_name = @_;
$first_letter=($character_name[0] =~ tr/a-z/A-z/);
foreach $old_dir (@OLD_STYLE_DIRS) {
if ($first_letter <= $old_dir[0] && $first_letter >= $old_dir[2]) {
return $old_dir;
}
}
#this couldn't possibly happen, but hey, we'll put it in for fun.
return "ZZZ";
}
# find_and_remove subroutine
# Find out if a named player needs to be deleted!
sub find_and_remove {
my $character_name = shift(@_);
$delete=0;
open(PFILE, "$PLAYER_DIR/$START_PLAYER_DIR/$character_name");
while(<PFILE>) {
#Act and Id are the unique lines for the player flags, and the idnum,
# if you've changed it in your system, change it here too.
# make sure you have all 4 letters, maybe..
if (/~Act /) {
($act,$colon,$actnum)=split(/\s/,$_,3);
if ($actnum & $DELETE_BIT && !($actnum & $NODELETE_BIT)) {
$delete=1;
}
}
if (/~Id /) {
($id,$colon,$idnum)=split(/\s/,$_,3);
}
}
close(PFILE);
if($delete) {
print("Deleting $character_name, delete bits set.\n");
# right here, you may want to comment this bit out, until you're SURE it
# works.. don't delete your files if you don't have to!
unlink("$PLAYER_DIR/$START_PLAYER_DIR/$character_name");
if(-e ("$RENT_DIR . "/" . find_old_dir($character_name) . "/$character_name.objs")) {
unlink($RENT_DIR . "/" . find_old_dir($character_name) . "/$character_name.objs");
}
if(-e ($ALIAS_DIR . find_old_dir($character_name) . "/" . $character_name)) {
unlink($ALIAS_DIR . find_old_dir($character_name) . "/" . $character_name);
}
return 0; # found and removed.
}
return $idnum; # found, is okay for insertion in index.
}
#this is the main function.
print("House cleaning started.\n");
open(NEW_PLAYER_INDEX, "> $TMP_DIR/tmpplr_index");
while($START_PLAYER_DIR ne "aa") {
opendir TEMPDIR, "$PLAYER_DIR/$START_PLAYER_DIR";
@dir_list= readdir TEMPDIR;
closedir TEMPDIR;
foreach $character (@dir_list) {
if(find_and_remove($character)>0) {
$their_id=find_and_remove($character);
print NEW_PLAYER_INDEX "$their_id\t$character\n";
}
}
$START_PLAYER_DIR++;
}
close(NEW_PLAYER_INDEX);
open(NEW_PLAYER_INDEX, "$TMP_DIR/tmpplr_index"); #just for reading.
@presort=split(/\n/,<NEW_PLAYER_INDEX>);
close(NEW_PLAYER_INDEX);
@sorted=sort sorter @presort;
open(PLAYER_INDEX, "> $PLAYER_INDEX");
foreach $line (@sorted) {
($num,$name)=split(/\s/,$line);
chop($name);
print PLAYER_INDEX "$num\t$name\n";
}
close(PLAYER_INDEX);
print("All done!\n");
sub sorter {
$numbera =split(/\s/,$a);
$numberb =split(/\s/,$b);
$numbera cmp $numberb;
}
+------------------------------------------------------------+
| Ensure that you have read the CircleMUD Mailing List FAQ: |
| http://democracy.queensu.ca/~fletcher/Circle/list-faq.html |
+------------------------------------------------------------+
This archive was generated by hypermail 2b30 : 12/08/00 PST