Back to home page
Get LXR Cross Referencer at SourceForge.net. Fast, secure and Free Open Source software downloads

LXR self cross-referenced (under SQLite)

 
 

    


File indexing completed on 2017-05-02 17:45:25

0001 #!/usr/bin/perl -T
0002 ######################################################################
0003 #
0004 # ident --  Look up identifiers
0005 #
0006 #   Arne Georg Gleditsch <argggh@ifi.uio.no>
0007 #   Per Kristian Gjermshus <pergj@ifi.uio.no>
0008 #
0009 #
0010 # This program is free software; you can redistribute it and/or modify
0011 # it under the terms of the GNU General Public License as published by
0012 # the Free Software Foundation; either version 2 of the License, or
0013 # (at your option) any later version.
0014 #
0015 # This program is distributed in the hope that it will be useful,
0016 # but WITHOUT ANY WARRANTY; without even the implied warranty of
0017 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
0018 # GNU General Public License for more details.
0019 #
0020 # You should have received a copy of the GNU General Public License
0021 # along with this program; if not, write to the Free Software
0022 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
0023 #
0024 ######################################################################
0025 
0026 use strict;
0027 use lib do { $0 =~ m{(.*)/} ? "$1/lib" : "lib" }; # if LXR modules are in ./lib
0028 
0029 =head1 ident script
0030 
0031 This script manages the HTTP requests for identifier search.
0032 
0033 =cut
0034 
0035 use LXR::Common;
0036 use LXR::Template;
0037 use Local;
0038 
0039 #
0040 # Global variables
0041 #
0042 our $defonly = undef;
0043 my $reference_hits;
0044 my $declare_hits;
0045 my $file_hits;
0046 my $bad_refs;
0047 
0048 
0049 =head2 C<countfiles ($refs)>
0050 
0051 Function C<countfiles> returns the number of files for the references.
0052 
0053 =over
0054 
0055 =item 1
0056 
0057 C<$refs>
0058 
0059 a I<reference> to an array containing the references
0060 
0061 =back
0062 
0063 The result can be used to display a short informative message.
0064 
0065 =cut
0066 
0067 sub countfiles {
0068     my $refs = shift;
0069 
0070     $file_hits = 0;
0071     my $last_file;
0072     foreach my $ref (@$refs) {
0073         my ($file, $line, $type, $rel) = @$ref;
0074         $file_hits++ if $file ne $last_file;
0075         $last_file = $file;
0076     }
0077 }
0078 
0079 
0080 =head2 C<checkvalidref ($file)>
0081 
0082 Function C<checkvalidref> is a "$variable" substitution function.
0083 It returns CSS class name C<identinvalid>
0084 if the file timestamp is incorrect,
0085 meaning the file has been modified after I<genxref> indexing.
0086 Otherwise, it returns an empty string.
0087 
0088 =over
0089 
0090 =item 1
0091 
0092 C<$file>
0093 
0094 a I<string> containing the filename to check
0095 
0096 =back
0097 
0098 Bad referenced file counter is updated to note the existence of
0099 possible trouble.
0100 
0101 =cut
0102 
0103 sub checkvalidref {
0104     my ($file) = @_;
0105 
0106     if (!$index->filetimestamp
0107                 ( $file
0108                 , $files->filerev($file, $releaseid)
0109                 )
0110     # Strictly speaking, call to parseable() is pointless since
0111     # identifier search requests information from the database
0112     # only. The file has thus been parsed and parseable() will
0113     # always return true.
0114     # However, the line is left here in case some evolution would
0115     # need it
0116     #   &&  LXR::Lang::parseable($file, $releaseid)
0117         ) {
0118         $bad_refs++;
0119         'identinvalid'
0120     } else {
0121         ''
0122     }
0123 }
0124 
0125 
0126 =head2 C<expandwarning ($templ)>
0127 
0128 Function C<expandwarning> is a "$function" substitution function.
0129 It returns its argument if bad referenced file counter is not zero.
0130 Otherwise, it returns an empty string.
0131 
0132 =over
0133 
0134 =item 1
0135 
0136 C<$templ>
0137 
0138 a I<string> containing the template (i.e. argument)
0139 
0140 =back
0141 
0142 The block for this marker should contain some warning message for
0143 inaccurate cross-references.
0144 
0145 =cut
0146 
0147 sub expandwarning {
0148     my ($templ) = @_;
0149 
0150     if ($bad_refs) {
0151         return expandtemplate($templ)
0152     } else {
0153         ''
0154     }
0155 }
0156 
0157 
0158 =head2 C<ref_in_file ($desc, $css, $path, $line)>
0159 
0160 Function C<ref_in_file> is an auxiliary front-end function to
0161 C<fileref> to handle the case of negative line numbers.
0162 
0163 =over
0164 
0165 =item 1
0166 
0167 C<$desc>
0168 
0169 a I<string> containing the visible text for the link
0170 
0171 =item 2
0172 
0173 C<$css>
0174 
0175 a I<string> containing HTML C<class> attribute
0176 
0177 =item 3
0178 
0179 C<$path>
0180 
0181 a I<string> containing the file name for the link
0182 
0183 =item 4
0184 
0185 C<$line>
0186 
0187 an I<integer> equal to the line number
0188 
0189 =back
0190 
0191 A negative line number flags a match in case insensitive mode.
0192 The real identifier may differ in case from the search key.
0193 Such a reference will be marked C<identapprox> to flag the
0194 approximative match.
0195 
0196 =cut
0197 
0198 sub ref_in_file {
0199     my ($desc, $css, $path, $line) = @_;
0200 
0201     if ($line < 0) {
0202         return fileref($desc, $css.' identapprox', $path, -$line);
0203     } else {
0204         return fileref($desc, $css, $path, $line);
0205     }
0206 }
0207 
0208 
0209 =head2 C<refsexpand ($templ, $refs)>
0210 
0211 Function C<refsexpand> is a "$function" substitution function.
0212 It returns an HTML string which is the concatenation of its
0213 expanded argument applied to every reference in array
0214 C<$refs>.
0215 
0216 =over
0217 
0218 =item 1
0219 
0220 C<$templ>
0221 
0222 a I<string> containing the template (i.e. argument)
0223 
0224 =item 2
0225 
0226 C<$refs>
0227 
0228 a I<reference> to an array containing the usages
0229 
0230 =back
0231 
0232 The block may use one of two variants for the usages. The variant
0233 is detected from C<$lines> marker use in the template.
0234 Processing is then dispatched on the "one ref per line" (no
0235 C<$lines> marker) or "many refs per line" (C<$lines> marker used)
0236 processing.
0237 
0238 This basic expansion function is used both for definitions and uses.
0239 The difference is driven by the block content.
0240 
0241 B<CAVEAT:>
0242 
0243 =over
0244 
0245 =item
0246 
0247 I<The element of the references array is a list.
0248 This list does not contain the same number of items for
0249 definitions and usages. In case of modification (notably
0250 the database transactions), take care to keep the file name
0251 and the line number as the first two items in the lists.
0252 Correct operation relies on this constraint.>
0253 
0254 =back
0255 
0256 =cut
0257 
0258 sub refsexpand {
0259     my ($templ, $refs) = @_;
0260     my $ret   = '';
0261     my $last_file;
0262 
0263     countfiles ($refs);
0264     # Select usage layout on the presence of a specific marker
0265     if (0 <= index($templ, '$lines')) {
0266     # We are in "many refs per line" layout
0267         my @lines;
0268         $last_file = @$refs[0];
0269         ($last_file) = @$last_file;
0270         my $i = 0;
0271         foreach my $ref (@$refs) {
0272             my ($file, $line, $type, $rel) = @$ref;
0273             if ($last_file eq $file) {
0274                 push @lines, $line;
0275             }
0276 LAST_EXPAND:
0277             ++$i;
0278             if  (   $last_file ne $file
0279                 ||  $i >= scalar (@$refs)
0280                 ) {
0281                 $ret .= expandtemplate
0282                         ( $templ
0283                         ,   ( 'file'    =>
0284                     sub { ref_in_file($last_file, 'identfile', $last_file) }
0285                             , 'fileonce'=>
0286                     sub { ref_in_file($last_file, 'identfile', $last_file) }
0287                             , 'lines'   => sub {
0288                                 join    ( ' '
0289                                         , map { ref_in_file( abs($_), 'identline', $last_file, $_)
0290                                             } @lines
0291                                         ) }
0292                             , 'type'    => sub { $type }
0293                             , 'rel'     => sub { if ($rel) { idref($rel, 'identrel', $rel) } }
0294                             , 'fileref' => sub {
0295                                 ref_in_file("$last_file, line ".abs($line), 'identline', $last_file, $line);
0296                                             }
0297                         , 'refinvalid'  => sub { checkvalidref($last_file) }
0298                             )
0299                         );
0300                 @lines = ($line);
0301                 if  (   $i == scalar (@$refs)
0302                     &&  $last_file ne $file
0303                     ) {
0304                     $last_file = $file;
0305                     goto LAST_EXPAND;
0306                 }
0307             }
0308         $last_file = $file;
0309         }
0310     } else {
0311     # We are in "one ref per line" layout
0312         foreach my $ref (@$refs) {
0313             my ($file, $line, $type, $rel) = @$ref;
0314             my $fileonce = $file if $last_file ne $file;
0315             $ret .= expandtemplate
0316                     ( $templ
0317                     ,   ( 'file'    =>
0318                 sub { ref_in_file($file, 'identfile', $file) }
0319                         , 'fileonce'=>
0320                 sub { if ($fileonce) { ref_in_file($fileonce, 'identfile', $file) } }
0321                         , 'line'    =>
0322                 sub { ref_in_file( abs($line), 'identline', $file, $line) }
0323                         , 'type'    => sub { $type }
0324                         , 'rel'     => sub { if ($rel) { idref($rel, 'identrel', $rel) } }
0325                         , 'fileref' => sub {
0326                             ref_in_file("$file, line ".abs($line), 'identline', $file, $line);
0327                                         }
0328                         , 'refinvalid'  => sub { checkvalidref($file) }
0329                         )
0330                     );
0331             $last_file = $file;
0332         }
0333     }
0334     return $ret;
0335 }
0336 
0337 
0338 =head2 C<cmprefs ($a, $b)>
0339 
0340 Function C<cmprefs> compares its arguments and returns +1, 0 or +1
0341 if the left argument precedes, is equal or follows the right argument.
0342 
0343 =over
0344 
0345 =item 1
0346 
0347 C<$a>, C<$b>
0348 
0349 I<references> to the arrays to compare
0350 
0351 =back
0352 
0353 The references are I<arrays> containing the file name and line number
0354 of the reference. For definitions, these elements are followed by
0355 type name and parent name.
0356 
0357 B<Note:>
0358 
0359 =over
0360 
0361 =item
0362 
0363 I<For usages, the last two element do no exist.
0364 The comparison stops after the first two steps.>
0365 
0366 =back
0367 
0368 =cut
0369 
0370 sub cmprefs {
0371     my $val;
0372 
0373     $val = $$a[0] cmp $$b[0];           # compare file names
0374     return $val if $val != 0;
0375     $val = abs($$a[1]) <=> abs($$b[1]); # line numbers
0376     return $val if $val != 0;
0377     return $val unless defined $$a[2];
0378     $val = $$a[2] cmp $$b[2];           # compare types
0379     return $val if $val != 0;
0380     return $$a[3] cmp $$b[3];           # compare parents
0381 }
0382 
0383 
0384 =head2 C<defsexpand ($templ)>
0385 
0386 Function C<defsexpand> is a "$function" substitution function.
0387 It returns an HTML string which is the concatenation of its
0388 expanded argument applied to every declaration.
0389 
0390 =over
0391 
0392 =item 1
0393 
0394 C<$templ>
0395 
0396 a I<string> containing the template (i.e. argument)
0397 
0398 =back
0399 
0400 The function queries the database for definitions, then hands over
0401 definition layout to C<refsexpand>.
0402 
0403 Since some languages are case-insensitive, the database is also
0404 queried for the case-insensitive version of the identifier.
0405 The returned definitions are flagged with their line numbers set
0406 negative.
0407 The two lists are merged, removing duplicates and sorted as if a
0408 single query was made.
0409 
0410 =cut
0411 
0412 sub defsexpand {
0413     my $templ = shift;
0414     my $ret;
0415 
0416     return '' unless $identifier;
0417     my @defs  = $index->symdeclarations($identifier, $releaseid);
0418     my @idefs = $index->symdeclarations(uc($identifier), $releaseid);
0419     return '<h2>No definition found</h2>' if (scalar(@defs)+scalar(@idefs) == 0);
0420 
0421     my %defs;   # Quich access to native-case definition, key is file
0422     foreach my $i (@defs) { # Group all definitions from a file
0423         my @defn = @$i;
0424         $defs{$defn[0]} = [] unless defined($defs{$defn[0]});
0425         push(@{$defs{$defn[0]}}, [ @defn[1..3] ]);
0426     }
0427 NATIVE_CASE:    # Remove uppercase duplicates
0428     foreach (@idefs) {
0429         my @idefn = @$_;    # Next uppercase definition
0430         foreach (@{$defs{$idefn[0]}}) {
0431             my @defn = @$_;
0432             if  (   $idefn[1] == $defn[0]   # same line number
0433                 &&  $idefn[2] eq $defn[1]   # same type
0434                 &&  $idefn[3] eq $defn[2]   # same parent
0435                 ) {
0436                 next NATIVE_CASE;           # Skip, this is a duplicate
0437             }
0438         }
0439         $idefn[1] = -$idefn[1];     # Flag case-isensitive definition
0440         push (@defs, [ @idefn ] );  # Add to list
0441     }
0442     @defs = sort cmprefs @defs;
0443 
0444     countfiles (\@defs);
0445     $bad_refs = 0;  # Reset "inaccurate xref" indicator
0446     my $last_file;
0447     $ret = expandtemplate
0448             ( $templ
0449             ,   ( 'refs'    => sub { refsexpand (@_, \@defs) }
0450                 , 'occurs'  => sub { scalar(@defs) }
0451                 , 'filehits'=> sub { $file_hits }
0452                 , 'identifier'      => sub { $_ = $identifier; s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g; return $_; }
0453                 , 'identifier_escaped'=> sub { $_ = $identifier; s/&/&amp;/g; s/\"/&quot;/g; s/</&lt;/g; s/>/&gt;/g; return $_; }
0454                 , 'indexwarning' => sub { expandwarning(@_) }
0455                 )
0456             );
0457     return $ret;
0458 }
0459 
0460 
0461 =head2 C<usesexpand ($templ)>
0462 
0463 Function C<usesexpand> is a "$function" substitution function.
0464 It returns an HTML string which is the concatenation of its
0465 expanded argument applied to every usage.
0466 
0467 =over
0468 
0469 =item 1
0470 
0471 C<$templ>
0472 
0473 a I<string> containing the template (i.e. argument)
0474 
0475 =back
0476 
0477 The function queries the database for usages, then hands over
0478 definition layout to C<refsexpand>.
0479 
0480 Since some languages are case-insensitive, the database is also
0481 queried for the case-insensitive version of the identifier.
0482 The returned definitions are flagged with their line numbers set
0483 negative.
0484 The two lists are merged, removing duplicates and sorted as if a
0485 single query was made.
0486 
0487 =cut
0488 
0489 sub usesexpand {
0490     my $templ = shift;
0491     my $ret   = '';
0492 
0493     return '' if $defonly || !$identifier;
0494     my @uses  = $index->symreferences($identifier, $releaseid);
0495     my @iuses = $index->symreferences(uc($identifier), $releaseid);
0496     return '<h2>No usage found</h2>' if (scalar(@uses)+scalar(@iuses) == 0);
0497 
0498     my %uses;   # Quich access to native-case usages, key is file
0499     foreach my $i (@uses) { # Group all usages from a file
0500         my @ref = @$i;
0501         $uses{$ref[0]} = [] unless defined($uses{$ref[0]});
0502         push (@{$uses{$ref[0]}},  @ref[1]);
0503     }
0504 NATIVE_CASE:    # Remove uppercase duplicates
0505     foreach (@iuses) {
0506         my @iref = @$_; # Next uppercase usage
0507         foreach (@{$uses{$iref[0]}}) {
0508             if  (   $iref[1] == $_  # same line number
0509                 ) {
0510                 next NATIVE_CASE;           # Skip, this is a duplicate
0511             }
0512         }
0513         $iref[1] = -$iref[1];       # Flag case-isensitive definition
0514         push (@uses, [ @iref ] );   # Add to list
0515     }
0516     @uses = sort cmprefs @uses;
0517 
0518     countfiles (\@uses);
0519     $bad_refs = 0;  # Reset "inaccurate xref" indicator
0520     my $last_file;
0521     $ret = expandtemplate
0522             ( $templ
0523             ,   ( 'refs'    => sub { refsexpand (@_, \@uses) }
0524                 , 'occurs'  => sub { scalar(@uses) }
0525                 , 'filehits'=> sub { $file_hits }
0526                 , 'identifier'      => sub { $_ = $identifier; s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g; return $_; }
0527                 , 'identifier_escaped'=> sub { $_ = $identifier; s/&/&amp;/g; s/\"/&quot;/g; s/</&lt;/g; s/>/&gt;/g; return $_; }
0528                 , 'indexwarning' => sub { expandwarning(@_) }
0529                 )
0530             );
0531     return $ret;
0532 }
0533 
0534 
0535 =head2 C<printident ()>
0536 
0537 Procedure C<printident> is the main driver for identifier search.
0538 
0539 It retrieves template C<'htmldir'> and expands it using the dedicated
0540 functions defined in this file.
0541 
0542 =cut
0543 
0544 sub printident {
0545     my $templ;
0546     my $errorsig = "<!-- ! -->";
0547 
0548     $templ = gettemplate    ( 'htmlident'
0549                             , $errorsig
0550                             );
0551     if ($templ =~ m/^$errorsig/) {
0552         die "Identifier search not available without 'htmlident' template\n";
0553     }
0554 
0555     print(
0556         expandtemplate
0557             ( $templ
0558             ,   ( 'variables'       => \&varexpand
0559                 , 'identifier'      => sub { $_ = $identifier; s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g; return $_; }
0560                 , 'identifier_escaped'=> sub { $_ = $identifier; s/&/&amp;/g; s/\"/&quot;/g; s/</&lt;/g; s/>/&gt;/g; return $_; }
0561                 , 'checked'         => sub { $defonly ? 'checked="checked"' : '' }
0562                 , 'varbtnaction'    => sub { varbtnaction(@_, 'ident') }
0563                 , 'urlargs'         => sub { urlexpand('-', 'ident') }
0564                 , 'noquery'             => sub { return 'hidden' if !$identifier }
0565                 , 'defs'            => \&defsexpand
0566                 , 'uses'            => \&usesexpand
0567                 , 'indexstate'      => sub { displayindexstate('ident') }
0568                 )
0569             )
0570     );
0571 }
0572 
0573 
0574 =head2 Script entry point
0575 
0576 Builds the header and footer and launches C<printident>
0577 for the real job.
0578 
0579 =cut
0580 
0581 httpinit();
0582 std_http_headers('ident');
0583 makeheader('ident');
0584 $defonly = 1 if ($HTTP->{'param'}{'_identdefonly'}
0585                 ||  (  $config->{'identdefonly'}
0586                     && !exists($HTTP->{'param'}{'_remember'})
0587                     )
0588                 );
0589 printident;
0590 makefooter('ident');
0591 httpclean;
0592