Finddbref

From Gwen Morse's Wiki
Jump to: navigation, search
#!/usr/local/bin/perl
# finddbref.pl (Wed Jan 8, 2003)
# By: Morris@Shadowrun (dryan@dnaco.net) [aka Dan Ryan]
#
# Version: 1.1 
#

use Getopt::Std;

getopts('din', \%opts) || die "Usage: $0 [-din] <flatfile> or - [object number]\n";
if ($#ARGV < 0) {die "Usage: $0 [-din] <flatfile> or - [object number]\n";}
if ($opts{'i'} != 1 && $#ARGV < 1) {die "You must define at least one object number to search for.\nUsage: $0 [-din] <flatfile> or - [object number]\n";}
if ($opts{'i'} && $ARGV[0] eq "-") {die "Cannot use STDIN with Interactive mode.\nUsage: $0 [-din] <flatfile> or - [object number]\n";}

$firstnum = 256;

print "finddbref.pl v1.1\n";
print "By: Morris\@Shadowrun (dryan\@dnaco.net)\n";
if ($ARGV[0] eq '-')  {
	print "Reading Standard Input...\n";
} else {
	print "Reading $ARGV[0]...\n"; 
}
open(FLATFILE,$ARGV[0]) || die "Can't open $ARGV[0].\n";

%attr_name = (
	0 => '@NULL',
	1 => '@OSUCC',
	2 => '@OFAIL',
	3 => '@FAIL',
	4 => '@SUCC',
	5 => '@PASS',
	6 => '@DESC',
	7 => '@SEX',
	8 => '@ODROP',
	9 => '@DROP',
	10 => '@OKILL',
	11 => '@KILL',
	12 => '@ASUCC',
	13 => '@AFAIL',
	14 => '@ADROP',
	15 => '@AKILL',
	16 => '@AUSE',
	17 => '@CHARGES',
	18 => '@RUNOUT',
	19 => '@STARTUP',
	20 => '@ACLONE',
	21 => '@APAY',
	22 => '@OPAY',
	23 => '@PAY',
	24 => '@COST',
	25 => '@MONEY',
	26 => '@LISTEN',
	27 => '@AAHEAR',
	28 => '@AMHEAR',
	29 => '@AHEAR',
	30 => '@LAST',
	31 => '@QUEUEMAX',
	32 => '@IDESC',
	33 => '@ENTER',
	34 => '@OXENTER',
	35 => '@AENTER',
	36 => '@ADESC',
	37 => '@ODESC',
	38 => '@RQUOTA',
	39 => '@ACONNECT',
	40 => '@ADISCONNECT',
	41 => '@ALLOWANCE',
	42 => '@LOCK',
	43 => '@NAME',
	44 => '@COMMENT',
	45 => '@USE',
	46 => '@OUSE',
	47 => '@SEMAPHORE',
	48 => '@TIMEOUT',
	49 => '@QUOTA',
	50 => '@LEAVE',
	51 => '@OLEAVE',
	52 => '@ALEAVE',
	53 => '@OENTER',
	54 => '@OXLEAVE',
	55 => '@MOVE',
	56 => '@OMOVE',
	57 => '@AMOVE',
	58 => '@ALIAS',
	59 => '@LOCK/ENTER',
	60 => '@LOCK/LEAVE',
	61 => '@LOCK/PAGE',
	62 => '@LOCK/USE',
	63 => '@LOCK/GIVE',
	64 => '@EALIAS',
	65 => '@LALIAS',
	66 => '@EFAIL',
	67 => '@OEFAIL',
	68 => '@AEFAIL',
	69 => '@LFAIL',
	70 => '@OLFAIL',
	71 => '@ALFAIL',
	72 => '@REJECT',
	73 => '@AWAY',
	74 => '@IDLE',
	75 => '@UFAIL',
	76 => '@OUFAIL',
	77 => '@AUFAIL',
	78 => '@PFAIL',
	79 => '@TPORT',
	80 => '@OTPORT',
	81 => '@OXTPORT',
	82 => '@ATPORT',
	83 => '@PRIVS',
	84 => '@LOGINDATA',
	85 => '@LOCK/TPORT',
	86 => '@LOCK/DROP',
	87 => '@LOCK/RECEIVE',
	88 => '@LASTSITE',
	89 => '@INPREFIX',
	90 => '@PREFIX',
	91 => '@INFILTER',
	92 => '@FILTER',
	93 => '@LOCK/LINK',
	94 => '@LOCK/TELOUT',
	95 => '@FORWARDLIST',
	96 => '@MAILFOLDERS',
	97 => '@LOCK/USER',
	98 => '@LOCK/PARENT',
	99 => '@LOCK/CONTROL',
	100 => '@VA',
	101 => '@VB', 
	102 => '@VC',
	103 => '@VD',
	104 => '@VE',
	105 => '@VF',
	106 => '@VG',
	107 => '@VH',
	108 => '@VI',
	109 => '@VJ',
	110 => '@VK',
	111 => '@VL',
	112 => '@VM',
	113 => '@VN',
	114 => '@VO',
	115 => '@VP',
	116 => '@VQ',
	117 => '@VR',
	118 => '@VS',
	119 => '@VT',
	120 => '@VU',
	121 => '@VV',
	122 => '@VW',
	123 => '@VX',
	124 => '@VY',
	125 => '@VZ',
	129 => '@GFAIL',
	130 => '@OGFAIL',
	131 => '@AGFAIL',
	132 => '@RFAIL',
	133 => '@ORFAIL',
	134 => '@ARFAIL',
	135 => '@DFAIL',
	136 => '@ODFAIL',
	137 => '@ADFAIL',
	138 => '@TFAIL',
	139 => '@OTFAIL',
	140 => '@ATFAIL',
	141 => '@TOFAIL',
	142 => '@OTOFAIL',
	143 => '@ATOFAIL',
	150 => '@LOCK/ASTRAL',
	151 => '@AAURA',
	152 => '@AURA',
	153 => '@BARRIER',
	154 => '@BARSUCC',
	155 => '@BARFAIL',
	156 => '@ABARFAIL',
	200 => '@LASTPAGE',
	201 => '@MAIL',
	202 => '@AMAIL',
	203 => '@SIGNATURE',
	204 => '@DAILY',
	205 => '@MAILTO',
	206 => '@MAILMSG',
	207 => '@MAILSUB',
	208 => '@MAILCURF',
	209 => '@LSPEECH',
	210 => '@PROGCMD',
	211 => '@MAILFLAGS',
	212 => '@DESTROYER',
	213 => '@NEWOBJS',
	214 => '@LCON_FMT',
	215 => '@LEXITS_FMT',
	216 => '@EXITVARDEST',
	217 => '@LOCK/CHOWN',
	220 => '@VRML_URL',
	221 => '@HTDESC',
	252 => '@VLIST',
	253 => '@LIST',
	254 => '@STRUCT',
	255 => '@TEMP',
);

$count = 1;
print "Reading +A records...\n";
while(<FLATFILE>)
{
    if (/^\+A([0-9]*)$/) {
	$index=$1;
	<FLATFILE> =~ /^"([0-9]+):(.*)"$/;
	$attr_name{$index}=$2;
	if (eof(FLATFILE)) { die "Premature EOF in attr section.\n"; }
        ++$count;
        if ($opts{'d'} && !($count % 1000)) {
          print "$count\n";
        }
    }
    if (/^!([0-9]*)$/) { $objnum=$1; last };
}
print "Done...\n";
shift @ARGV;
$do_search = 1;
if ($opts{'i'}) {
    print "Enter Object to search for (q to quit): ";
    chomp($answer = <STDIN>);
    if ($answer eq 'q') {
	$do_search = 0;
    }
} else {
	@dbrefs = sort @ARGV;
	$answer = $dbrefs[0];
}
while($do_search) {
    print "Searching for object...\n";
    while(<FLATFILE>) {
    	chomp;
    	if (!$opts{'n'}) {
       	    if ($objnum == $answer) { $doprint++; }
    	} else {
       	    /"(.*)"/;
       	    if ($answer eq $1) { $doprint++; }
    	}
    	if ($doprint) {
	    print $_," (#$objnum)\n";
    	}
    	<FLATFILE>;
    	<FLATFILE>;
    	<FLATFILE>;
    	<FLATFILE>;
    	<FLATFILE>;
    	# following line inserted by Geoff, to test.
    	<FLATFILE>;
    	if (eof(FLATFILE)) { 
	    die "Premature EOF reading obj \#$objnum\n"; 
    	}

    	while (<FLATFILE>) {
	    if (/^\>([0-9]*)$/) {
	    	if ($doprint) {
		    if ($1 < 256) {
			print $attr_name{$1}," #",$objnum,"=";
		    } else {
	 		print "&",$attr_name{$1}," #",$objnum,"=";
		    }
	      	}
	    	$_=<FLATFILE>;
	    	if ($doprint) {
	    	    if (/^"(.*)\015$/) {
	 		print $1;
			while (($_ = <FLATFILE>) =~ /\015$/) {
				print $_;
			}
			/(.*)"$/;
			print $1,"\n";
			print "-\n"

		    } else {	
			/^"(.*)"$/;
			print $1,"\n";
			print "-\n"
		    }
	    	}
	    } elsif (/^!([0-9]*)$/) { 
	    	$objnum=$1;
	    	last; 
	    }
    	}
    	if ($doprint) {
	    last;
    	}
    }			       
    if ($opts{'i'}) {
    	print "Enter Object to search for (q to quit): ";
    	chomp($answer = <STDIN>);
    	if ($answer eq 'q') {
	    $do_search = 0;
    	}
    } else {
    	shift @dbrefs;
    	if ($#dbrefs < 0) {
    	    $do_search = 0;
    	} else {
	    $answer = $dbrefs[0];
    	}
    }
    $doprint = 0;
}