#!/usr/bin/perl -T ###################################################################### # # ident -- Look up identifiers # # Arne Georg Gleditsch # Per Kristian Gjermshus # # # 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 strict; use lib do { $0 =~ m{(.*)/} ? "$1/lib" : "lib" }; # if LXR modules are in ./lib =head1 ident script This script manages the HTTP requests for identifier search. =cut use LXR::Common; use LXR::Template; use Local; # # Global variables # our $defonly = undef; my $reference_hits; my $declare_hits; my $file_hits; my $bad_refs; =head2 C Function C returns the number of files for the references. =over =item 1 C<$refs> a I to an array containing the references =back The result can be used to display a short informative message. =cut sub countfiles { my $refs = shift; $file_hits = 0; my $last_file; foreach my $ref (@$refs) { my ($file, $line, $type, $rel) = @$ref; $file_hits++ if $file ne $last_file; $last_file = $file; } } =head2 C Function C is a "$variable" substitution function. It returns CSS class name C if the file timestamp is incorrect, meaning the file has been modified after I indexing. Otherwise, it returns an empty string. =over =item 1 C<$file> a I containing the filename to check =back Bad referenced file counter is updated to note the existence of possible trouble. =cut sub checkvalidref { my ($file) = @_; if (!$index->filetimestamp ( $file , $files->filerev($file, $releaseid) ) # Strictly speaking, call to parseable() is pointless since # identifier search requests information from the database # only. The file has thus been parsed and parseable() will # always return true. # However, the line is left here in case some evolution would # need it # && LXR::Lang::parseable($file, $releaseid) ) { $bad_refs++; 'identinvalid' } else { '' } } =head2 C Function C is a "$function" substitution function. It returns its argument if bad referenced file counter is not zero. Otherwise, it returns an empty string. =over =item 1 C<$templ> a I containing the template (i.e. argument) =back The block for this marker should contain some warning message for inaccurate cross-references. =cut sub expandwarning { my ($templ) = @_; if ($bad_refs) { return expandtemplate($templ) } else { '' } } =head2 C Function C is an auxiliary front-end function to C to handle the case of negative line numbers. =over =item 1 C<$desc> a I containing the visible text for the link =item 2 C<$css> a I containing HTML C attribute =item 3 C<$path> a I containing the file name for the link =item 4 C<$line> an I equal to the line number =back A negative line number flags a match in case insensitive mode. The real identifier may differ in case from the search key. Such a reference will be marked C to flag the approximative match. =cut sub ref_in_file { my ($desc, $css, $path, $line) = @_; if ($line < 0) { return fileref($desc, $css.' identapprox', $path, -$line); } else { return fileref($desc, $css, $path, $line); } } =head2 C Function C is a "$function" substitution function. It returns an HTML string which is the concatenation of its expanded argument applied to every reference in array C<$refs>. =over =item 1 C<$templ> a I containing the template (i.e. argument) =item 2 C<$refs> a I to an array containing the usages =back The block may use one of two variants for the usages. The variant is detected from C<$lines> marker use in the template. Processing is then dispatched on the "one ref per line" (no C<$lines> marker) or "many refs per line" (C<$lines> marker used) processing. This basic expansion function is used both for definitions and uses. The difference is driven by the block content. B =over =item I =back =cut sub refsexpand { my ($templ, $refs) = @_; my $ret = ''; my $last_file; countfiles ($refs); # Select usage layout on the presence of a specific marker if (0 <= index($templ, '$lines')) { # We are in "many refs per line" layout my @lines; $last_file = @$refs[0]; ($last_file) = @$last_file; my $i = 0; foreach my $ref (@$refs) { my ($file, $line, $type, $rel) = @$ref; if ($last_file eq $file) { push @lines, $line; } LAST_EXPAND: ++$i; if ( $last_file ne $file || $i >= scalar (@$refs) ) { $ret .= expandtemplate ( $templ , ( 'file' => sub { ref_in_file($last_file, 'identfile', $last_file) } , 'fileonce'=> sub { ref_in_file($last_file, 'identfile', $last_file) } , 'lines' => sub { join ( ' ' , map { ref_in_file( abs($_), 'identline', $last_file, $_) } @lines ) } , 'type' => sub { $type } , 'rel' => sub { if ($rel) { idref($rel, 'identrel', $rel) } } , 'fileref' => sub { ref_in_file("$last_file, line ".abs($line), 'identline', $last_file, $line); } , 'refinvalid' => sub { checkvalidref($last_file) } ) ); @lines = ($line); if ( $i == scalar (@$refs) && $last_file ne $file ) { $last_file = $file; goto LAST_EXPAND; } } $last_file = $file; } } else { # We are in "one ref per line" layout foreach my $ref (@$refs) { my ($file, $line, $type, $rel) = @$ref; my $fileonce = $file if $last_file ne $file; $ret .= expandtemplate ( $templ , ( 'file' => sub { ref_in_file($file, 'identfile', $file) } , 'fileonce'=> sub { if ($fileonce) { ref_in_file($fileonce, 'identfile', $file) } } , 'line' => sub { ref_in_file( abs($line), 'identline', $file, $line) } , 'type' => sub { $type } , 'rel' => sub { if ($rel) { idref($rel, 'identrel', $rel) } } , 'fileref' => sub { ref_in_file("$file, line ".abs($line), 'identline', $file, $line); } , 'refinvalid' => sub { checkvalidref($file) } ) ); $last_file = $file; } } return $ret; } =head2 C Function C compares its arguments and returns +1, 0 or +1 if the left argument precedes, is equal or follows the right argument. =over =item 1 C<$a>, C<$b> I to the arrays to compare =back The references are I containing the file name and line number of the reference. For definitions, these elements are followed by type name and parent name. B =over =item I =back =cut sub cmprefs { my $val; $val = $$a[0] cmp $$b[0]; # compare file names return $val if $val != 0; $val = abs($$a[1]) <=> abs($$b[1]); # line numbers return $val if $val != 0; return $val unless defined $$a[2]; $val = $$a[2] cmp $$b[2]; # compare types return $val if $val != 0; return $$a[3] cmp $$b[3]; # compare parents } =head2 C Function C is a "$function" substitution function. It returns an HTML string which is the concatenation of its expanded argument applied to every declaration. =over =item 1 C<$templ> a I containing the template (i.e. argument) =back The function queries the database for definitions, then hands over definition layout to C. Since some languages are case-insensitive, the database is also queried for the case-insensitive version of the identifier. The returned definitions are flagged with their line numbers set negative. The two lists are merged, removing duplicates and sorted as if a single query was made. =cut sub defsexpand { my $templ = shift; my $ret; return '' unless $identifier; my @defs = $index->symdeclarations($identifier, $releaseid); my @idefs = $index->symdeclarations(uc($identifier), $releaseid); return '

No definition found

' if (scalar(@defs)+scalar(@idefs) == 0); my %defs; # Quich access to native-case definition, key is file foreach my $i (@defs) { # Group all definitions from a file my @defn = @$i; $defs{$defn[0]} = [] unless defined($defs{$defn[0]}); push(@{$defs{$defn[0]}}, [ @defn[1..3] ]); } NATIVE_CASE: # Remove uppercase duplicates foreach (@idefs) { my @idefn = @$_; # Next uppercase definition foreach (@{$defs{$idefn[0]}}) { my @defn = @$_; if ( $idefn[1] == $defn[0] # same line number && $idefn[2] eq $defn[1] # same type && $idefn[3] eq $defn[2] # same parent ) { next NATIVE_CASE; # Skip, this is a duplicate } } $idefn[1] = -$idefn[1]; # Flag case-isensitive definition push (@defs, [ @idefn ] ); # Add to list } @defs = sort cmprefs @defs; countfiles (\@defs); $bad_refs = 0; # Reset "inaccurate xref" indicator my $last_file; $ret = expandtemplate ( $templ , ( 'refs' => sub { refsexpand (@_, \@defs) } , 'occurs' => sub { scalar(@defs) } , 'filehits'=> sub { $file_hits } , 'identifier' => sub { $_ = $identifier; s/&/&/g; s//>/g; return $_; } , 'identifier_escaped'=> sub { $_ = $identifier; s/&/&/g; s/\"/"/g; s//>/g; return $_; } , 'indexwarning' => sub { expandwarning(@_) } ) ); return $ret; } =head2 C Function C is a "$function" substitution function. It returns an HTML string which is the concatenation of its expanded argument applied to every usage. =over =item 1 C<$templ> a I containing the template (i.e. argument) =back The function queries the database for usages, then hands over definition layout to C. Since some languages are case-insensitive, the database is also queried for the case-insensitive version of the identifier. The returned definitions are flagged with their line numbers set negative. The two lists are merged, removing duplicates and sorted as if a single query was made. =cut sub usesexpand { my $templ = shift; my $ret = ''; return '' if $defonly || !$identifier; my @uses = $index->symreferences($identifier, $releaseid); my @iuses = $index->symreferences(uc($identifier), $releaseid); return '

No usage found

' if (scalar(@uses)+scalar(@iuses) == 0); my %uses; # Quich access to native-case usages, key is file foreach my $i (@uses) { # Group all usages from a file my @ref = @$i; $uses{$ref[0]} = [] unless defined($uses{$ref[0]}); push (@{$uses{$ref[0]}}, @ref[1]); } NATIVE_CASE: # Remove uppercase duplicates foreach (@iuses) { my @iref = @$_; # Next uppercase usage foreach (@{$uses{$iref[0]}}) { if ( $iref[1] == $_ # same line number ) { next NATIVE_CASE; # Skip, this is a duplicate } } $iref[1] = -$iref[1]; # Flag case-isensitive definition push (@uses, [ @iref ] ); # Add to list } @uses = sort cmprefs @uses; countfiles (\@uses); $bad_refs = 0; # Reset "inaccurate xref" indicator my $last_file; $ret = expandtemplate ( $templ , ( 'refs' => sub { refsexpand (@_, \@uses) } , 'occurs' => sub { scalar(@uses) } , 'filehits'=> sub { $file_hits } , 'identifier' => sub { $_ = $identifier; s/&/&/g; s//>/g; return $_; } , 'identifier_escaped'=> sub { $_ = $identifier; s/&/&/g; s/\"/"/g; s//>/g; return $_; } , 'indexwarning' => sub { expandwarning(@_) } ) ); return $ret; } =head2 C Procedure C is the main driver for identifier search. It retrieves template C<'htmldir'> and expands it using the dedicated functions defined in this file. =cut sub printident { my $templ; my $errorsig = ""; $templ = gettemplate ( 'htmlident' , $errorsig ); if ($templ =~ m/^$errorsig/) { die "Identifier search not available without 'htmlident' template\n"; } print( expandtemplate ( $templ , ( 'variables' => \&varexpand , 'identifier' => sub { $_ = $identifier; s/&/&/g; s//>/g; return $_; } , 'identifier_escaped'=> sub { $_ = $identifier; s/&/&/g; s/\"/"/g; s//>/g; return $_; } , 'checked' => sub { $defonly ? 'checked="checked"' : '' } , 'varbtnaction' => sub { varbtnaction(@_, 'ident') } , 'urlargs' => sub { urlexpand('-', 'ident') } , 'noquery' => sub { return 'hidden' if !$identifier } , 'defs' => \&defsexpand , 'uses' => \&usesexpand , 'indexstate' => sub { displayindexstate('ident') } ) ) ); } =head2 Script entry point Builds the header and footer and launches C for the real job. =cut httpinit(); std_http_headers('ident'); makeheader('ident'); $defonly = 1 if ($HTTP->{'param'}{'_identdefonly'} || ( $config->{'identdefonly'} && !exists($HTTP->{'param'}{'_remember'}) ) ); printident; makefooter('ident'); httpclean;