ident.in

项目源码察看工具lxr-0.3.tar.gz

#!@perlbin@
# $Id: ident,v 1.6 1998/04/30 11:58:16 argggh Exp $

# ident --	Look up identifiers
#
#	Arne Georg Gleditsch <[e-mail]>
#	Per Kristian Gjermshus <[e-mail]>
#
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

######################################################################

use lib 'lib/';
use LXR::Common;
use LXR::Config;
use DB_File;

%ty = (('M', 'preprocessor macro'),
       ('V', 'variable'),
       ('f', 'function prototype'),
       ('F', 'function'),
       ('C', 'class'),			# C++
       ('c', '(forwarded) class'),	# C++
       ('T', 'type'),
       ('S', 'struct type'),
       ('E', 'enum type'),
       ('U', 'union type'));


sub ident {
    print("<form method=get action=\"ident\">\n");

    foreach ($Conf->allvariables) {
	if ($Conf->variable($_) ne $Conf->vardefault($_)) {
	    print("<input type=hidden name=\"",$_, "\" ",
		  "value=\"", $Conf->variable($_), "\">\n");
	}
    }
    
    print("Identifier: <input type=text name=\"i\" ",
	  "value=\"",$identifier,"\" size=60>\n",
	  "<input type=submit value=\"Go get it\">\n",
	  "</form>\n");

    
    if ($identifier) {
	tie(%xref, "DB_File", $Conf->dbdir."/xref", 
	    O_RDONLY, undef, $DB_HASH) || 
		&fatal("Could not open \"".$Conf->dbdir."/xref\"");

	@refs = split(/\t/,$xref{$identifier});

	print("<h1>$identifier</h1>\n");

	if (@refs) {
	    tie(%fileidx, "DB_File", $Conf->dbdir."/fileidx", 
		O_RDONLY, undef, $DB_HASH) || 
		    &fatal("Could not open \"".$Conf->dbdir."/fileidx\"");
	    
	    foreach (@refs) {
		$f{$1} .= "$2\t" if /^(.)(.*)/;
	    }

	    foreach $t (keys(%ty)) {
		if ($f{$t}) {
		    print("Defined as a $ty{$t} in:<ul>\n");

		    @_ = split(/\t/, $f{$t});
		    unshift(@_);
		    foreach (@_) {
			($fnum, $line, @clss) = split(/:/, $_);
			
			print("<li>",
			      &fileref("$fileidx{$fnum}, line $line",
				       "/$fileidx{$fnum}", $line));

			if (@clss) { 
			    if ($t eq 'F' || $t eq 'f') {
				print(", as member of ");
				if ($xref{$clss[0]}) {
				    print(&idref("class $clss[0]", $clss[0]));
				} else {
				    print("class $clss[0]");
				}
			    } elsif ($t eq 'C') {
				print(", inheriting <ul>\n");
				foreach (@clss) {
				    print("<li>");
				    if ($xref{$_}) {
					print(&idref("class $_", $clss[0]));
				    } else {
					print("class $_");
				    }
				}
				print("</ul>");
			    }
			}
			print("\n");
		    }
		    print("</ul>\n");
		}
	    }

	    print("Referenced (in ",int(grep(/^R/, @refs))," files total) in:\n",
		  "<ul>\n");
	    $concise = $#refs > 100;
	    foreach (@refs) {
		if (/^R(.+):([\d,]+)/) {
		    $fnam = $fileidx{$1};
		    @fpos = split(/,/, $2);
		    if ($#fpos > 0) {
			if ($concise) {
			    print("<li>", &fileref("$fnam", "/$fnam"),
				  ", ",$#fpos+1," times\n");
			} else {
			    print("<li>$fnam:\n<ul>\n");
			    foreach (@fpos) {
				print("<li>", &fileref("line $_",
						       "/$fnam", $_),
				      "\n");
			    }
			    print("</ul>\n");
			}
		    } else {
			print("<li>", &fileref("$fnam, line $fpos[0]",
					       "/$fnam", $fpos[0]), 
			      "\n");
		    }
		}
	    }
	    print("</ul>\n");
	    untie(%fileidx);

	} else {
	    print("<br><b>Not used</b>");
	}
	
	untie(%xref);
    }
}

($Conf, $HTTP, $Path) = &init;
$identifier = $HTTP->{'param'}->{'i'};

&makeheader('ident');
&ident;
&makefooter('ident');