1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381 |
- #!/usr/bin/perl
- # $Id: genxref,v 1.7 2006/12/07 04:59:38 reed%reedloden.com Exp $
- # genxref.pl -- Finds identifiers in a set of C files using an
- # extremely fuzzy algorithm. It sort of works.
- #
- # Arne Georg Gleditsch <argggh@ifi.uio.no>
- # Per Kristian Gjermshus <pergj@ifi.uio.no>
- #
- #
- # 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.
- # TODO: ns/cmd/xfe/src/MozillaApp.h, XFE_MozillaApp
- ######################################################################
- use lib 'lib';
- use integer;
- use DB_File;
- use strict;
- my %fileidx;
- my %itype = (('macro', 'M'),
- ('typedef', 'T'),
- ('struct', 'S'),
- ('enum', 'E'),
- ('union', 'U'),
- ('function', 'F'),
- ('funcprot', 'f'),
- ('class', 'C'), # (C++)
- ('classforw', 'c'), # (C++)
- ('var', 'V'),
- ('interface', 'I'),
- ('reference', 'R'),
- );
- my @reserved = ('auto', 'break', 'case', 'char', 'const', 'continue',
- 'default', 'do', 'double', 'else', 'enum', 'extern',
- 'float', 'for', 'goto', 'if', 'int', 'long', 'register',
- 'return', 'short', 'signed', 'sizeof', 'static',
- 'struct', 'switch', 'typedef', 'union', 'unsigned',
- 'void', 'volatile', 'while', 'fortran', 'asm',
- 'inline', 'operator',
- 'class', # (C++)
- # Her bør vi ha flere av disse:
- '__inline', # seved
- '__asm__','__inline__');
- my @reservedJS = ( 'abstract', 'as', 'break', 'case', 'catch', 'class', 'const', 'continue', 'default', 'delete', 'do', 'else', 'export', 'extends', 'false', 'final', 'finally', 'for', 'function', 'if', 'import', 'in', 'instanceof', 'is', 'namespace', 'new', 'null', 'package', 'private', 'public', 'return', 'static', 'super', 'switch', 'this ', 'throw', 'true', 'try', 'typeof', 'use', 'var', 'let', 'void', 'while', 'with');
- my @reservedXUL = (''); #nothing yet
- my @reservedXBL = (''); #nothing yet
- my %xref;
- my (@ft, @f, @jsfiles, @plfiles, @idlfiles, @xblfiles);
- my $ident = '\~?_*[a-zA-Z][a-zA-Z0-9_]*';
- my $fnum = 1;
- my $plidentp = '[$@%&]';
- my ($realpath, $verb, $fix, @extra) = @ARGV;
- $realpath ||= '.';
- $realpath .= '/';
- $verb = 'default' unless defined $verb;
- my $suffix = defined $fix ? ".$fix" : '';
- my ($totaldefs, $totalrefs) = (0, 0);
- sub wash {
- my $towash = $_[0];
- return ("\n" x ($towash =~ tr/\n//));
- }
- sub stripodd {
- my $tostrip = $_[0];
- while ($tostrip =~ s/\{([^\{\}]*)\}/\05$1\06/gs) {}
- $tostrip =~ s/[\{\}]//gs; # remove *before* restoring outermost block
- $tostrip =~ tr/\05\06/\{\}/;
- return($tostrip);
- }
- sub enumval {
- my $enum_conts = $_[0];
- $enum_conts =~ s/($ident)([^,]*(?:,|$))/"enum \01$itype{'enum'}$1\02 ;".&wash($2)/ges;
- return($enum_conts);
- }
- sub classes {
- my @c = (shift =~ /($ident)\s*(?:$|,)/gm);
- if (@c) {
- return(join(":", @c)."::");
- } else {
- return('');
- }
- }
- sub findidentXBL {
- print(STDERR "Starting pass 1 for XBL: Collect identifier definitions.\n");
- my $start = time;
- my $defs = 0;
- my $f = "";
- my $contents = "";
- my @contents;
- my $curfnum = 0;
- foreach $f (@xblfiles) {
- $fileidx{++$fnum} = $f;
- ++$curfnum;
- open(SRCFILE, $realpath.$f);
- {
- local $/ = undef;
- $contents = <SRCFILE>;
- }
- close(SRCFILE);
- print(STDERR
- "(Pass 1 XBL) $f (",length($contents),
- "), file $curfnum of ",$#xblfiles+1,"...\n");
- # XBL
- next unless $contents =~ /<!DOCTYPE\s+bindings/ms;
- # Remove comments.
- # Magic
- $contents =~ s/<\?([^?]*(?:\?[^?>]|))*\?>/&wash($1)/ges;
- # XML Comment
- $contents =~ s/^<!--(?:\w+?\n)-->/&wash($1)/ges;
- # Preprocessor Comment
- $contents =~ s/^\s*\#[^\n]*//g;
- # From here on, \01 and \02 are used to encapsulate found
- # identifiers,
- my ($ct, $ct2, $input);
- $ct = $input = $contents;
- $contents = '';
- my $ct2 = ($ct =~ s/\n//g) || 0;
- my ($ids, $junk, $tailjunk, $junkkind);
- my (@tagstack, @tagattrs);
- # <tag...>
- # </tag>
- my ($class, $func);
- my $l = 1;
- while ($input =~ s{(^.*?<)(/?)(\w+)([^>]*)>}{}ms) {
- my ($pre, $close, $tag, $rest) = ($1, $2, $3, $4);
- $l += ($pre =~ s/\n//g) || 0;
- if ($close) {
- pop @tagstack;
- pop @tagattrs;
- for ($tag) {
- /^binding$/ && do {
- $class = undef;
- last;
- };
- /^(?:property|method|field)$/ && do {
- $func = undef;
- last;
- };
- }
- next;
- }
- my %attrs = ();
- push @tagstack, $tag;
- push @tagattrs, \%attrs;
- my %attrlines = ();
- my $attrline = 0;
- while ($rest =~ /(\s+)(\S+)(\s*=\s*)(?:"([^"]*)"|'([^']*)')/g) {
- my ($pre, $attr, $val) = ($1.$3, $2.$5, $4.$6);
- $attrline += ($pre =~ s/\n//g) || 0;
- $attrs{$attr} = $val;
- $attrlines{$attr} = $attrline;
- $attrline += ($val =~ s/\n//g) || 0;
- }
- for ($tag) {
- /^(?:content|children|resources|body|handlers)$/ && do {
- last;
- };
- /^binding$/ && do {
- # Binding (class) declarations
- if (defined $attrs{'id'}) {
- $class = $attrs{'id'};
- $contents = $contents . "\04$l\01" .
- $itype{'classforw'} .
- $class .
- "\02";
- }
- last;
- };
- /^implementation$/ && do {
- # Implementation (interface) derivations
- if (defined $attrs{'implements'}) {
- $contents .=
- "\04$l\01" .
- $itype{'class'} .
- &classes($attrs{'implements'}) .
- "$class\02";
- }
- last;
- };
- /^(de|con)structor$/ && do {
- if (defined $class) {
- $contents .=
- "\04$l\01" .
- $itype{'function'} .
- &classes($class) .
- ($1 eq 'de' ? '~' : '') .
- $class .
- "\02";
- }
- last;
- };
- /^([gs])etter$/ && do {
- my $prefix = $1;
- $func =~ /^(.)(.*)/;
- # as an experiment, this declares both the flavors
- $contents .=
- "\04$l\01" .
- $itype{'function'} .
- $prefix . 'et' . uc($1) . $2 .
- "\02";
- last;
- };
- /^(?:property|method|field)$/ && do {
- if (defined $attrs{'name'}) {
- $func = $attrs{'name'};
- $contents .=
- "\04$l\01" .
- $itype{'function'} .
- $func .
- "\02";
- foreach my $attr (qw(onget onset)) {
- if (defined $attrs{$attr}) {
- $attr =~ /on([gs])et/;
- my $prefix = $1;
- $func =~ /(.)(.*)/;
- $contents .=
- "\04".($l+$attrlines{$attr})."\01" .
- $itype{'function'} .
- $prefix . 'et' . uc($1) . $2 .
- "\02";
- }
- }
- }
- last;
- };
- /^handler$/ && do {
- if (defined $attrs{'event'}) {
- $func = $attrs{'event'};
- $contents .=
- "\04$l\01" .
- $itype{'function'} .
- $func .
- "\02";
- $func = "on$func";
- $contents .=
- "\04$l\01" .
- $itype{'function'} .
- $func .
- "\02";
- }
- last;
- };
- /^parameter$/ && do {
- if (defined $attrs{'name'}) {
- $contents .=
- "\04$l\01" .
- $itype{'reference'} .
- $attrs{'name'} .
- "\02";
- }
- last;
- };
- }
- $l += $attrline;
- }
- foreach ($contents =~ /^(.*)/gm) {
- while (/\04(\d+)\01(.)($ident)\02/go) {
- $xref{$3} .= "$2$fnum:$1\t";
- $defs++;
- }
- }
- }
- # Cleanup.
- foreach (@reservedJS) {
- delete($xref{$_});
- }
- $totaldefs = $totaldefs + $defs;
- print(STDERR
- "Completed pass 1 XBL (",(time-$start),"s):",
- " $defs definitions found (total found so far: $totaldefs).\n\n");
- }
- sub findidentPL {
- print(STDERR "Starting pass 1 for Perl: Collect identifier definitions.\n");
- my $start = time;
- my $defs = 0;
- my $f = "";
- my $contents = "";
- my @contents;
- my $curfnum = 0;
- foreach $f (@plfiles) {
- $fileidx{++$fnum} = $f;
- ++$curfnum;
- open(SRCFILE, $realpath.$f);
- {
- local $/ = undef;
- $contents = <SRCFILE>;
- }
- close(SRCFILE);
- print(STDERR
- "(Pass 1 Perl) $f (",length($contents),
- "), file $curfnum of ",$#plfiles+1,"...\n");
- # Remove comments.
- $contents =~ s/(\n)=(\w+?\n.*?)=cut/&wash($1 . $2)/ges; # Perl Pod
- $contents =~ s/\#[^\n]*//g; # Perl Comment
- # Unwrap continuation lines.
- $contents =~ s/\\\s*\n/\05/gs;
- while ($contents =~ s/\05([^\n\05]+)\05/$1\05\05/gs) {}
- $contents =~ s/(\05+)([^\n]*)/"$2"."\n" x length($1)/gse;
- # Remove nested parentheses.
- while ($contents =~ s/\(([^\)]*)\(/\($1\05/g ||
- $contents =~ s/\05([^\(\)]*)\)/ $1 /g) {}
- # Some heuristics here: Try to recognize "code" and delete
- # everything up to the next block delimiter.
- # $contents =~ s/([\;\}\{])(\s*$ident\s*\([^\)]*\)[^\{\}]*)/
- # "$1".&wash($2)/goes;
- # $contents =~ s/([\;\{])(\s*\**$ident\s*\=[^\{\}]*)/
- # "$1".&wash($2)/goes;
- # Parentheses containing commas are probably not interesting.
- $contents =~ s/\(([^\)]*\,[^\)]*)\)/
- "()".&wash($1)/ges;
- # Ranges are uninteresting (and confusing).
- $contents =~ s/\[(.*?)\]/&wash($1)/ges;
- # From here on, \01 and \02 are used to encapsulate found
- # identifiers,
- my $ct = $contents;
- my $ct2 = ($ct =~ s/\n//g) || 0;
- my ($ids, $junk, $tailjunk, $junkkind);
- @contents = split(/[;}]/, $contents);
- $contents = '';
- my $l = 1;
- foreach (@contents) {
- my $line = $ct = $_;
- $ct2 = ($ct =~ s/\n//g) || 0;
- my $bl = $l;
- # Package (class) declarations
- if ($line =~ /^(\s*(?:package)\s+(?:\s*$ident\s*::)*\s*)($ident)(\s*)$/m) {
- ($ct, $ids, $tailjunk) = ($1, $2, $3);
- $l += ($ct =~ s/\n//g) || 0;
- $contents .= "\04$l\01".$itype{'class'}."$ids\02";
- }
- $l = $bl;
- # Variable (var) declarations
- if ($line =~ /^(\s*(?:my|local|our)\s+)($plidentp)($ident(?:\s*,\s*$plidentp$ident)*)(.*?)$/m) {
- ($ct, $ids, $tailjunk, $junkkind) = ($1, $3, $4, $2);
- $l += ($ct =~ s/\n//g) || 0;
- my @idds = split /\b/, $ids;
- while (@idds) {
- my $lid = shift @idds;
- $lid =~ /($ident)/;
- $contents .= "\04$l\01".$itype{'var'}."$1\02";
- my $spc;
- do {
- $spc = shift @idds;
- $l += $spc =~ s/[\r\n]//g;
- } while ($spc =~ /[,=]/);
- }
- }
- $l = $bl;
- # Function (function) declarations
- if ($line =~ /^(.*?\s*\b)sub(\s+)($ident|)(\s*.*)$/sm) {
- my ($impl, $ws1, $ws2, $ws3) = ($3, $1, $2, $4);
- $l += $ws1 =~ s/\n//g;
- $l += $ws2 =~ s/\n//g;
- $contents .= "\04$l\01".$itype{'function'}."$impl\02" if $impl;
- $l += $ws3 =~ s/\n//g;
- }
- $l = $bl;
- # constant property () declarations
- =useless
- if ($line =~ /($ident)\s*=>/m) {
- }
- $l = $bl;
- =cut
- $l += $ct2;
- }
- foreach ($contents =~ /^(.*)/gm) {
- while (/\04(\d+)\01(.)($ident)\02/go) {
- $xref{$3} .= "$2$fnum:$1\t";
- $defs++;
- }
- }
- }
- # Cleanup.
- foreach (@reservedJS) {
- delete($xref{$_});
- }
- $totaldefs = $totaldefs + $defs;
- print(STDERR
- "Completed pass 1 Perl (",(time-$start),"s):",
- " $defs definitions found (total found so far: $totaldefs).\n\n");
- }
- sub findidentJS {
- print(STDERR "Starting pass 1 for Javascript: Collect identifier definitions.\n");
- my $start = time;
- my $defs = 0;
- my $f = "";
- my $contents = "";
- my @contents;
- my $curfnum = 0;
- foreach $f (@jsfiles) {
- $fileidx{++$fnum} = $f;
- ++$curfnum;
- open(SRCFILE, $realpath.$f);
- {
- local $/ = undef;
- $contents = <SRCFILE>;
- }
- close(SRCFILE);
- print(STDERR
- "(Pass 1 JS) $f (",length($contents),
- "), file $curfnum of ",$#jsfiles+1,"...\n");
- # Remove comments.
- $contents =~ s{/\*(.*?)\*/}{&wash($1)}ges;
- $contents =~ s{//[^\n]*}{}g; # C++
- # $contents =~ s{^# [^\n]*|^#($)}{$1}gm; # evil preprocessor
- # Remove license blocks.
- $contents =~ s{(# \*\*\*\*\* BEGIN LICENSE BLOCK \*\*\*\*\*.*?# \*\*\*\*\* END LICENSE BLOCK \*\*\*\*\*)}{&wash($1)}ges;
- # Unwrap continuation lines.
- $contents =~ s/\\\s*\n/\05/gs;
- while ($contents =~ s/\05([^\n\05]+)\05/$1\05\05/gs) {}
- $contents =~ s/(\05+)([^\n]*)/"$2"."\n" x length($1)/gse;
- # Remove nested parentheses.
- # while ($contents =~ s/\(([^\)]*)\(/\($1\05/g ||
- # $contents =~ s/\05([^\(\)]*)\)/ $1 /g) {}
- # Some heuristics here: Try to recognize "code" and delete
- # everything up to the next block delimiter.
- # $contents =~ s/([\;\}\{])(\s*$ident\s*\([^\)]*\)[^\{\}]*)/
- # "$1".&wash($2)/goes;
- # $contents =~ s/([\;\{])(\s*\**$ident\s*\=[^\{\}]*)/
- # "$1".&wash($2)/goes;
- # Parentheses containing commas are probably not interesting.
- # $contents =~ s/\(([^\)]*\,[^\)]*)\)/
- # "()".&wash($1)/ges;
- # This operator-stuff messes things up. (C++)
- $contents =~ s/operator[\<\>\=\!\+\-\*\%\/]{1,2}/operator/g;
- # Ranges are uninteresting (and confusing).
- $contents =~ s/\[(.*?)\]/&wash($1)/ges;
- # From here on, \01 and \02 are used to encapsulate found
- # identifiers,
- =pod
- # Find class definitions. (C++)
- $contents =~ s/((class)\s+($ident)\s*(:[^;\{]*|)({}|(;)))/
- "$2 "."\01".$itype{$2.($6 ? 'forw' : '')}.
- &classes($4).$3."\02 ".$6.&wash($1)/goes;
- =cut
- my $pre;
- my $ct = $contents;
- my $ct2 = ($ct =~ s/\n//g) || 0;
- my ($ids, $junk);
- @contents = split(/[;}]/, $contents);
- $contents = '';
- my $l = 1;
- foreach (@contents) {
- my $line = $ct = $_;
- $ct2 = ($ct =~ s/\n//g) || 0;
- if ($line && $line =~ /(var|let|const)|(function|[gs]et)/) {
- my ($var_let_const, $function_get_set) = ($1, $2);
- my $bl = $l;
- if ($var_let_const &&
- $line =~ /^(.*\b(?:var|let|const)\s+)($ident(?:\s*(?:=[^,;]*|),\s*$ident)*)(.*?(?:\n|$))/s) {
- ($pre, $ids, $junk) = ($1, $2, $3);
- $l += ($pre =~ s/\n//g) || 0;
- my @idds = split /\b/, $ids;
- while (@idds) {
- my $lid = shift @idds;
- $lid =~ /($ident)/;
- $contents .= "\04$l\01".$itype{'var'}."$1\02";
- my $spc;
- do {
- $spc = shift @idds;
- $l += $spc =~ s/[\r\n]//g;
- } while ($spc =~ /[,=]/);
- }
- $l = $bl;
- }
- if ($function_get_set &&
- $line =~ /^(.*\n|)(.*?\s*)((?:$ident\s*[:=]*\s*)*)(?:function|[gs]et)(\s+)($ident|)(\s*.*)(\n|$)/s) {
- my ($decl, $impl, $ws1, $ws2, $ws3, $ws0) = ($3, $5, $2, $4, $6, $1);
- $l += $ws0 =~ s/\n//g;
- $l += $ws1 =~ s/\n//g;
- if ($decl) {
- my @idds = split /\b/, $decl;
- while (@idds) {
- my $lid = shift @idds;
- if ($lid =~ /($ident)/) {
- $contents .= "\04$l\01".$itype{'function'}."$1\02";
- } else {
- $l += $lid =~ s/\n//g;
- }
- }
- }
- $l += $ws2 =~ s/\n//g;
- $contents .= "\04$l\01".$itype{'function'}."$impl\02" if $impl;
- $l += $ws3 =~ s/\n//g;
- $l = $bl;
- }
- }
- $l += $ct2;
- }
- foreach ($contents =~ /^(.*)/gm) {
- while (/\04(\d+)\01(.)($ident)\02/go) {
- $xref{$3} .= "$2$fnum:$1\t";
- $defs++;
- }
- }
- }
- # Cleanup.
- foreach (@reservedJS) {
- delete($xref{$_});
- }
- $totaldefs = $totaldefs + $defs;
- print(STDERR
- "Completed pass 1 Javascript (",(time-$start),"s):",
- " $defs definitions found (total found so far: $totaldefs).\n\n");
- }
- sub c_clean {
- my $contents = $_[0];
- # We don't care so much about proper style,
- # from our perspective, most operators are equivalent to ,
- $contents =~ s{[-+<>=%&|?^]+}{,}g;
- # Find macro (un)definitions.
- my $l = 0;
- my $defs;
- foreach ($contents =~ /^(.*)/gm) {
- $l++;
- if (/^[ \t]*\#\s*(define|undef)\s+($ident)/o) {
- $xref{$2} .= "$itype{'macro'}$fnum:$l\t";
- $defs++;
- }
- }
- # We want to do some funky heuristics with preprocessor blocks
- # later, so mark them. (FIXME: #elif)
- $contents =~ s/^[ \t]*\#\s*if.*/\01/gm;
- $contents =~ s/^[ \t]*\#\s*else.*/\02/gm;
- $contents =~ s/^[ \t]*\#\s*endif.*/\03/gm;
- # Strip all preprocessor directives.
- $contents =~ s/^[ \t]*\#(.*)//gm;
- # Now, remove all odd block markers ({,}) we find inside
- # #else..#endif blocks. (And pray they matched one in the
- # preceding #if..#else block.)
- while ($contents =~ s/\02([^\01\02\03]*\03)/&stripodd($1)/ges ||
- $contents =~ s/\01([^\01\02\03]*)\03/&stripodd($1)/ges) {}
- while ($contents =~ /([\01\02\03\04\05])/gs) {
- print(STDERR "\t ** stray ".($1 eq "\01"
- ? "#if"
- : ($1 eq "\02"
- ? "#else"
- : ($1 eq "\03"
- ? "#endif"
- : "control sequence"
- )
- )
- )." found.\n");
- }
- $contents =~ s/[\01\02\03\04\05]//gs;
- # Special treatment of enum and struct: inhibit removal of such blocks
- $contents =~ s/(\s+enum\s+)($ident|)(\s*)\{([^\}]*)\}(\s*)($ident|)/
- "$1 ".($2 ? "\01".$itype{enum}.$2."\02 " : "").$3.&enumval($4).$5.($6 ? "\01".$itype{enum}.$6."\02 " : "")/goes;
- $contents =~ s/(\s+struct\s+)($ident|)(\s*)\{([^\}]*)\}(\s*)($ident|)/
- $1.$2.$3."{}".$4.$5.($6 ? "\01".$itype{typedef}.$6."\02 " : "")/goes;
- =pod
- # Remove all but outermost blocks. (No local variables.)
- while ($contents =~ s/\{([^\{\}]*)\}/
- "\05".&wash($1)/ges) {}
- $contents =~ s/\05/\{\}/gs;
- =cut
- # This operator-stuff messes things up. (C++)
- $contents =~ s/operator[\<\>\=\!\+\-\*\%\/]{1,2}/operator/g;
- # Ranges are uninteresting (and confusing).
- $contents =~ s/\[(.*?)\]/&wash($1)/ges;
- # And so are assignments.
- $contents =~ s/\=(.*?);/";".&wash($1)/ges;
- return $contents;
- }
- sub java_clean {
- my $contents = $_[0];
- while ($contents =~ s/(\{[^\{]*)\{([^\{\}]*)\}/
- $1."\05".&wash($2)/ges) {}
- $contents =~ s/\05/\{\}/gs;
- # Remove imports
- $contents =~ s/(^\s*import.*;)/&wash($1)/gem;
- # Remove packages
- $contents =~ s/(^\s*package.*;)/&wash($1)/gem;
- return $contents;
- }
- sub c_classes {
- my $contents = $_[0];
- # XXX this has issues w/ whitespace
- # Find struct, enum and union definitions with params (function returning struct etc)
- $contents =~ s/((struct|enum|union)\s+($ident|)\s+($ident|)\s*([{;]))/
- "$2 ".($3 ? "\01".$itype{$2}.$3."\02 " : " ").$4.$5.&wash($1)/gmoes;
- # Find struct, enum and union definitions.
- $contents =~ s/((struct|enum|union)\s+($ident|)\s*([{;]))/
- "$2 ".($3 ? "\01".$itype{$2}.$3."\02 " : "").$4.&wash($1)/gmoes;
- # Find class definitions. (C++)
- $contents =~ s/((class)\s+($ident)\s*(:[^;\{]*|)([{;]))/
- "$2 "."\01".$itype{$2.($5 eq ';' ? 'forw' : '')}.
- &classes($4).$3."\02 ".$5.&wash($1)/gmoes;
- return $contents;
- }
- sub java_classes {
- my $contents = $_[0];
- # Find Java classes
- $contents =~ s/((class)\s+($ident)\s*(extends\s+([\.\w]+)\s*|)(implements\s+([\.\w]+)|))/
- "$2 "."\01".$itype{$2}.&classes($5.", ".$7).$3."\02 ".
- &wash($1)/goes;
- # Find Java interfaces
- $contents =~ s/((interface)\s+($ident)\s*(extends\s+([\.\w]+)|))/
- "$2 "."\01".$itype{$2}.&classes($5).$3."\02 ".&wash($1)/goes;
- return $contents;
- }
- sub idl_decl {
- return 'NS_DECL_'.(uc shift);
- }
- sub idl_interfaces {
- my $contents = $_[0];
- # Find IDL interfaces
- $contents =~ s/((interface)\s+($ident)\s*(:[^;\{]*|)(\{|(;)))/
- "$2 ".($6 ? '' : "\01".$itype{macro}.idl_decl($3)."\02 ").
- "\01".$itype{$2.($6 ? 'forw' : '')}.
- &classes($4).$3."\02 ".$6.&wash($1)/goes;
- return $contents;
- }
- sub findidentIDL {
- print(STDERR "Starting pass 1 for IDL: Collect identifier definitions.\n");
- my $start = time;
- my $defs = 0;
- my $f = "";
- my $contents = "";
- my @contents;
- my $curfnum = 0;
- foreach $f (@idlfiles) {
- $fileidx{++$fnum} = $f;
- ++$curfnum;
- open(SRCFILE, $realpath.$f);
- $_ = $/; undef($/); $contents = <SRCFILE>; $/ = $_;
- close(SRCFILE);
- print(STDERR
- "(Pass 1 IDL) $f (",length($contents),
- "), file $curfnum of ",$#idlfiles+1,"...\n");
- # Remove comments.
- $contents =~ s/\/\*(.*?)\*\//&wash($1)/ges;
- $contents =~ s/\/\/[^\n]*//g; # C++
- # Remove annotations
- # XXX uuids should eventually be stored somehow
- $contents =~ s/\[[^]]*\]//gs;
- # Unwrap continuation lines.
- $contents =~ s/\\\s*\n/\05/gs;
- while ($contents =~ s/\05([^\n\05]+)\05/$1\05\05/gs) {}
- $contents =~ s/(\05+)([^\n]*)/"$2"."\n" x length($1)/gse;
- $contents = c_clean($contents);
- # Remove nested parentheses.
- while ($contents =~ s/\(([^\)]*)\(/\($1\05/g ||
- $contents =~ s/\05([^\(\)]*)\)/ $1 /g) {}
- # From here on, \01 and \02 are used to encapsulate found
- # identifiers,
- $contents = idl_interfaces($contents);
- @contents = split(/[;\}]/, $contents);
- $contents = '';
- foreach (@contents) {
- # readonly attribute
- # const
- # s/^(\s*)(struct|enum|union|inline)/$1/;
- # we don't care about [noscript] and similar friends
- # they're too complicated
- s/\[([^]]*)\]/&wash($1)/ge;
- if (/$ident[^a-zA-Z0-9_]+$ident/) { # It takes two, baby.
- my $t = /^\s*typedef/s; # Is this a type definition?
- s/((readonly\s+|)attribute\s+|)
- # ($1) readonly
- # ($2) attribute
- (\s*$ident\s*)
- # ($3) return or attribute type
- ($ident)
- # ($4) Match the identifier
- ([\s\)]*
- # ($5) Tokens allowed after identifier
- (\([^\)]*\)
- # ($6) Function parameters?
- |) # No function parameters
- (\s*(?:$|,)))/
- # ($7) Allowed termination chars.
- &wash($3)."\01".
- # identifier marker
- ($t
- # if type definition...
- ? $itype{'typedef'}
- # ..mark as such
- : ($6
- # $6 is empty unless function definition.
- ? $itype{'funcprot'}
- # function prototype.
- : $itype{'var'}
- # Variable.
- )
- )."$4\02 ".&wash($5 . $7)/goesx;
- }
- $contents .= $_;
- }
- my $l = 0;
- foreach ($contents =~ /^(.*)/gm) {
- $l++;
- while (/\01(.)(?:([^\01\02]+?)\s*::\s*|)($ident)\02/go) {
- $xref{$3} .= "$1$fnum:$l".($2 ? ":$2" : "")."\t";
- $defs++;
- }
- }
- }
- # Remove reserved from xref
- foreach (@reserved) {
- delete($xref{$_});
- }
- $totaldefs = $totaldefs + $defs;
- print(STDERR
- "Completed pass 1 IDL (",(time-$start),"s):",
- " $defs definitions found (total found so far: $totaldefs).\n\n");
- }
- sub findident {
- print(STDERR "Starting pass 1 for C/C++: Collect identifier definitions.\n");
- my $start = time;
- my $defs = 0;
- my $f = "";
- my $contents = "";
- my @contents;
- my $curfnum = 0;
- foreach $f (@f) {
- my ($java) = ($ft[$fnum] == 1);
- $fileidx{++$fnum} = $f;
- ++$curfnum;
- open(SRCFILE, $realpath.$f);
- $_ = $/; undef($/); $contents = <SRCFILE>; $/ = $_;
- close(SRCFILE);
- print(STDERR
- "(Pass 1 C/C++) $f (",length($contents),
- "), file $curfnum of ",$#f+1,"...");
- # Remove comments.
- $contents =~ s/\/\*(.*?)\*\//&wash($1)/ges;
- $contents =~ s/\/\/[^\n]*//g; # C++
- # Unwrap continuation lines.
- $contents =~ s/\\\n/\05/gs;
- while ($contents =~ s/\05([^\n\05]+)\05/$1\05\05/gs) {}
- $contents =~ s/(\05+)([^\n]*)/"$2"."\n" x length($1)/gse;
- if ($java) {
- $contents = java_clean($contents);
- } else {
- $contents = c_clean($contents);
- }
- # Remove nested parentheses.
- while ($contents =~ s/\(([^\)]*)\(/\($1\05/g ||
- $contents =~ s/\05([^\(\)]*)\)/ $1 /g) {}
- # Some heuristics here: Try to recognize "code" and delete
- # everything up to the next block delimiter.
- # $contents =~ s/([\;\}\{])(\s*$ident\s*\([^\)]*\)[^\{\}]*)/
- # "$1".&wash($2)/goes;
- # $contents =~ s/([\;\{])(\s*\**$ident\s*\=[^\{\}]*)/
- # "$1".&wash($2)/goes;
- # Parentheses containing commas are probably not interesting.
- $contents =~ s/\(([^\)]*\,[^\)]*)\)/
- "()".&wash($1)/ges;
- # From here on, \01 and \02 are used to encapsulate found
- # identifiers,
- if ($java) {
- $contents = java_classes($contents);
- } else {
- $contents = c_classes($contents);
- }
- @contents = split(/[;\}]/, $contents);
- $contents = '';
- foreach (@contents) {
- if (!$java) {
- my $t = /\n\s*typedef/s; # Is this a type definition?
- s/(\n\s*)(?:typedef|struct|enum|union|inline|static|__inline)/$1/g;
- if (/$ident[^a-zA-Z0-9_]+$ident/) { # It takes two, baby.
- s/($ident(?:\s*::\s*$ident|)) # ($1) Match the identifier
- ([\s\)]* # ($2) Tokens allowed after identifier
- (\([^\)]*\) # ($3) Function parameters?
- (?:\s*:[^\{]*|) # inheritage specification (C++)
- |) # No function parameters
- \s*($|,|\{))/ # ($4) Allowed termination chars.
- "\01". # identifier marker
- ($t # if type definition...
- ? $itype{'typedef'} # ..mark as such
- : ($3 # $3 is empty unless function definition.
- ? ($4 eq '{' # Terminating token indicates
- ? $itype{'function'} # function or
- : $itype{'funcprot'}) # function prototype.
- : $itype{'var'}) # Variable.
- )."$1\02 ".&wash($2)/goesx;
- }
- } else {
- s/($ident)\s*\([^\)]*\)([^\{]*)($|\{)/
- "\01".($3 eq '{' ? $itype{'function'} : $itype{'funcprot'})."$1\02 ".
- &wash($2)/goesx; # capture what's between the identifier & the '{' - it may contain newlines!
- s/($ident)\s*(=.*)$/
- "\01".$itype{'var'}."$1\02 ".&wash($2)/goesx;
- }
- $contents .= $_;
- }
- my $l = 0;
- my $ldefs = 0;
- foreach ($contents =~ /^(.*)/gm) {
- $l++;
- while (/\01(.)(?:(.+?)\s*::\s*|)($ident)\02/go) {
- $xref{$3} .= "$1$fnum:$l".($2 ? ":$2" : "")."\t";
- $defs++;
- $ldefs++;
- }
- }
- print(STDERR " $ldefs defs\n");
- }
- # Remove reserved from xref
- foreach (@reserved) {
- delete($xref{$_});
- }
- $totaldefs = $totaldefs + $defs;
- print(STDERR
- "Completed pass 1 C/C++ (",(time-$start),"s):",
- " $defs definitions found (total found so far: $totaldefs).\n\n");
- }
- sub findusagePL {
- print(STDERR "Starting pass 2 Perl: Generate reference statistics.\n");
- my $start = time;
- my $refs = 0;
- my $f;
- my $curfnum = 0;
- foreach $f (@plfiles) {
- ++$fnum;
- ++$curfnum;
- my $lcount = 0;
- my %tref = ();
- open(SRCFILE, $realpath.$f);
- $_ = $/; undef($/); my $contents = <SRCFILE>; $/ = $_;
- close(SRCFILE);
- print(STDERR
- "(Pass 2 Perl) $f (",length($contents),
- "), file $curfnum of ",$#plfiles+1,"...\n");
- # Remove comments.
- $contents =~ s/(\n)=(\w+?\n.*?)=cut/&wash($1 . $2)/ges; # Perl Pod
- $contents =~ s/\#[^\n]*//g; # Perl Comment
- # FIXME: "var"
- my @lines = split(/\n/, $contents);
- my $line;
- foreach $line (@lines) {
- $lcount++;
- foreach ($line =~ /(?:^|[^a-zA-Z_\#]|$plidentp)($ident)\b/og) {
- $tref{$_} .= "$lcount," if $xref{$_};
- }
- }
- while (($a, $b) = each(%tref)) {
- chop($b);
- $xref{$a} .= "R$fnum:$b\t";
- $refs++;
- }
- }
- $totalrefs = $totalrefs + $refs;
- print(STDERR
- "Completed pass 2 (",(time-$start),"s):",
- " $refs references to known identifiers found (total: $totalrefs).\n\n");
- }
- sub findusageJS {
- print(STDERR "Starting pass 2 Javascript: Generate reference statistics.\n");
- my $start = time;
- my $refs = 0;
- my $f;
- my $curfnum = 0;
- foreach $f (@jsfiles) {
- ++$fnum;
- ++$curfnum;
- my $lcount = 0;
- my %tref = ();
- open(SRCFILE, $realpath.$f);
- $_ = $/; undef($/); my $contents = <SRCFILE>; $/ = $_;
- close(SRCFILE);
- print(STDERR
- "(Pass 2 JS) $f (",length($contents),
- "), file $curfnum of ",$#jsfiles+1,"...\n");
- # Remove comments
- $contents =~ s/\/\*(.*?)\*\//&wash($1)/ges;
- $contents =~ s/\/\/[^\n]*//g;
- # Remove license blocks.
- $contents =~ s{(# \*\*\*\*\* BEGIN LICENSE BLOCK \*\*\*\*\*.*?# \*\*\*\*\* END LICENSE BLOCK \*\*\*\*\*)}{&wash($1)}ges;
- # FIXME: "var"
- my @lines = split(/\n/, $contents);
- my $line;
- foreach $line (@lines) {
- $lcount++;
- foreach ($line =~ /(?:^|[^a-zA-Z_\#])($ident)\b/og) {
- $tref{$_} .= "$lcount," if $xref{$_};
- }
- }
- while (($a, $b) = each(%tref)) {
- chop($b);
- $xref{$a} .= "R$fnum:$b\t";
- $refs++;
- }
- }
- $totalrefs = $totalrefs + $refs;
- print(STDERR
- "Completed pass 2 (",(time-$start),"s):",
- " $refs references to known identifiers found (total: $totalrefs).\n\n");
- }
- sub findusageIDL {
- print(STDERR "Starting pass 2 IDL: Generate reference statistics.\n");
- my $start = time;
- my $refs = 0;
- my $f;
- my $curfnum = 0;
- foreach $f (@idlfiles) {
- ++$fnum;
- ++$curfnum;
- my $lcount = 0;
- my %tref = ();
- open(SRCFILE, $realpath.$f);
- $_ = $/; undef($/); my $contents = <SRCFILE>; $/ = $_;
- close(SRCFILE);
- print(STDERR
- "(Pass 2 IDL) $f (",length($contents),
- "), file $curfnum of ",$#f+1,"...\n");
- =ignore
- # Remove comments
- $contents =~ s/\/\*(.*?)\*\//&wash($1)/ges;
- $contents =~ s/\/\/[^\n]*//g;
- # Remove include statements
- $contents =~ s/^[ \t]*\#include[ \t]+[^\n]*//gm;
- # FIXME: "var"
- my @lines = split(/\n/, $contents);
- my $line;
- foreach $line (@lines) {
- $lcount++;
- foreach ($line =~ /(?:^|[^a-zA-Z_\#])($ident)\b/og) {
- $tref{$_} .= "$lcount," if $xref{$_};
- }
- }
- while (($a, $b) = each(%tref)) {
- chop($b);
- $xref{$a} .= "R$fnum:$b\t";
- $refs++;
- }
- =cut
- }
- $totalrefs = $totalrefs + $refs;
- print(STDERR
- "Completed pass 2 IDL (",(time-$start),"s):",
- " $refs references to known identifiers found (total: $totalrefs).\n\n");
- }
- sub findusage {
- print(STDERR "Starting pass 2 C/C++: Generate reference statistics.\n");
- my $start = time;
- my $refs = 0;
- my $f;
- my $curfnum = 0;
- foreach $f (@f) {
- ++$fnum;
- ++$curfnum;
- my $lcount = 0;
- my %tref = ();
- open(SRCFILE, $realpath.$f);
- $_ = $/; undef($/); my $contents = <SRCFILE>; $/ = $_;
- close(SRCFILE);
- print(STDERR
- "(Pass 2 C/C++) $f (",length($contents),
- "), file $curfnum of ",$#f+1,"...\n");
- # Remove comments
- $contents =~ s/\/\*(.*?)\*\//&wash($1)/ges;
- $contents =~ s/\/\/[^\n]*//g;
- # Remove include statements
- $contents =~ s/^[ \t]*\#include[ \t]+[^\n]*//gm;
- # FIXME: "var"
- my @lines = split(/\n/, $contents);
- my $line;
- foreach $line (@lines) {
- $lcount++;
- foreach ($line =~ /(?:^|[^a-zA-Z_\#])($ident)\b/og) {
- $tref{$_} .= "$lcount," if $xref{$_};
- }
- }
- while (($a, $b) = each(%tref)) {
- chop($b);
- $xref{$a} .= "R$fnum:$b\t";
- $refs++;
- }
- }
- $totalrefs = $totalrefs + $refs;
- print(STDERR
- "Completed pass 2 C/C++ (",(time-$start),"s):",
- " $refs references to known identifiers found (total: $totalrefs).\n\n");
- }
- sub dumpdb {
- print STDERR "Starting stage 3: Dump database to disk.\n";
- my $start = time;
- my %xrefdb;
- tie (%xrefdb, "DB_File" , "xref.out.$$", O_RDWR|O_CREAT, 0664, $DB_HASH)
- || die("Could not open \"xref\" for writing");
- my $i = 0;
- my $k;
- my $v;
- while (($k, $v) = each(%xref)) {
- $i++;
- delete($xref{$k});
- $xrefdb{$k} = $v;
- unless ($i % 100) {
- print(STDERR "(Pass 3) identifier $i of maximum $totaldefs...\n");
- }
- }
- untie(%xrefdb);
- rename("xref.out.$$", "xref$suffix") || die "Couldn't rename xref.out.$$ to xref$suffix";
- print(STDERR
- "Completed stage 3 (",(time-$start),"s):",
- " Information on $i identifiers dumped to disk.\n\n");
- dbmclose(%fileidx);
- rename("fileidx.out.$$", "fileidx$suffix")
- || die "Couldn't rename fileidx.out.$$ to fileidx$suffix";
- }
- sub renumber {
- my ($line, $fadjust) = @_;
- # $xref{$3} .= "$2$fnum:$1\t";
- my @refs = split /\t/, $line;
- $line = '';
- foreach my $v (@refs) {
- $v =~ /(.)(\d+):(.*)/;
- my ($kind, $fileno, $lineno) = ($1, $fadjust + $2, $3);
- $line .= "$kind$fileno:$lineno\t";
- }
- return $line;
- }
- sub merge {
- print STDERR "Starting stage 4: Merging database to disk.\n";
- my $start = time;
- tie (%fileidx, "DB_File", "fileidx.out.$$", O_RDWR|O_CREAT, 0660, $DB_HASH)
- || die("Could not open \"fileidx.out.$$\" for writing");
- my %xrefdb;
- tie (%xrefdb, "DB_File" , "xref.out.$$", O_RDWR|O_CREAT, 0664, $DB_HASH)
- || die("Could not open \"xref\" for writing");
- my ($i, $k, $v);
- my $fadjust = 0;
- my $limit = scalar @extra;
- for (my $e = 0; $e < $limit; ++$e) {
- my $fix = $extra[$e];
- my ($prefix, $suffix) = ("$fix/", ".$fix");
- my %idx;
- tie (%idx, "DB_File", "fileidx$suffix", O_RDONLY, undef, $DB_HASH)
- || die("Could not open \"fileidx$suffix\" for reading");
- my $f = -1;
- while (($k, $v) = each(%idx)) {
- $f = $k if ($k > $f);
- $fileidx{$k + $fadjust} = "$prefix$v";
- unless ($i % 100) {
- print(STDERR "(Pass 4) file $i [$fix] of $e / $limit files...\n");
- }
- }
- untie (%idx);
- tie (%xref, "DB_File" , "xref$suffix", O_RDONLY, undef, $DB_HASH)
- || die("Could not open \"xref$suffix\" for reading");
- while (($k, $v) = each(%xref)) {
- $i++;
- $xrefdb{$k} .= renumber($v, $fadjust);
- unless ($i % 100) {
- print(STDERR "(Pass 4) identifier $i [$fix] of $e / $limit files...\n");
- }
- }
- untie (%xref);
- $fadjust += $f + 1;
- }
- untie(%xrefdb);
- rename("xref.out.$$", "xref") || die "Couldn't rename xref.out.$$ to xref";
- print(STDERR
- "Completed stage 4 (",(time-$start),"s):",
- "Information on $i identifiers dumped to disk.\n\n");
- untie(%fileidx);
- rename("fileidx.out.$$", "fileidx")
- || die "Couldn't rename fileidx.out.$$ to fileidx";
- foreach my $fix (@extra) {
- my ($suffix) = (".$fix");
- }
- }
- sub buildList {
- my ($fspre, $fspost) = ('', '');
- if ($suffix ne '') {
- $fspost = "! -type l ! -path '*/.git/*' ! -path '*/.hg/*' ! -path '*/.svn/*' ! -path '*/CVS/*'";
- } else {
- $fspre = '-L';
- }
- open(FILES, "find $fspre $realpath $fspost -type f -print |");
- print(STDERR "Starting pass 0: Checking for files to index.\n",
- "Looking in $realpath.\n");
- while (my $file = <FILES>) {
- $file =~ s/^\Q$realpath\E|\s+$//og;
- # Duplicated in lib/LXR/Common.pm
- if ($file =~ /\.(?:(hh?|cpp?|c[cs]?|fin|tbl|ipdlh?)|(java)|(jsm?)(?:\.in|)|(p[lm]|cgi)(?:\.in|)|(idl)|(xml))$/i) {
- if ($1) {
- push @ft, 0;
- push @f, $file;
- } elsif ($2) {
- push @ft, 1;
- push @f, $file;
- } elsif ($3) {
- if (($file =~ m!/Regress/!) || ($file =~ m!kraken/tests/kraken!)) {
- print(STDERR "Skipping $file\n");
- } else {
- push @jsfiles, $file;
- }
- } elsif ($4) {
- push @plfiles, $file;
- } elsif ($5) {
- push @idlfiles, $file;
- } elsif ($6) {
- push @xblfiles, $file;
- }
- }
- }
- close FILES;
- }
- # Stage 0: build file list
- # Stage 1: find identifiers
- # - this is pass 1 over the file content
- # Stage 2: find references
- # - this is pass 2 over the file content
- # Stage 3: dump the database
- # - we run from 0..3 for a "default" action
- # Stage 4: merge databases
- # - we only do this stage for a "merge" action
- sub buildIndex {
- tie (%fileidx, "DB_File", "fileidx.out.$$", O_RDWR|O_CREAT, 0660, $DB_HASH)
- || die("Could not open \"fileidx.out.$$\" for writing");
- buildList();
- print 'Stage 0 IDL file count is : ' . scalar(@idlfiles) . '
- Stage 0 C/C++ file count is : ' . scalar(@f) . '
- Stage 0 JS file count is : ' . scalar(@jsfiles) . '
- Stage 0 PL file count is : ' . scalar(@plfiles) . '
- ';
- $fnum = 0;
- # we need to search for IDL identifiers first because they can be
- # the only prototype
- # XXX i'm not certain this is necessary, oh well.
- &findidentIDL;
- print "Stage 1 IDL XREF keycount is : " . scalar(keys %xref) . "\n";
- &findident;
- print "Stage 1 C/C++ XREF keycount is : " . scalar(keys %xref) . "\n";
- &findidentJS;
- print "Stage 1 C/C++/JS XREF keycount is : " . scalar(keys %xref) . "\n";
- &findidentPL;
- print "Stage 1 C/C++/JS/PL XREF keycount is : " . scalar(keys %xref) . "\n";
- &findidentXBL;
- print "Stage 1 C/C++/JS/PL/XBL XREF keycount is : " . scalar(keys %xref) . "\n";
- $fnum = 0;
- &findusageIDL;
- print "Stage 2 IDL XREF keycount is : " . scalar(keys %xref) . "\n";
- &findusage;
- print "Stage 2 C/C++ XREF keycount is : " . scalar(keys %xref) . "\n";
- &findusageJS;
- print "Stage 2 C/C++/JS XREF keycount is : " . scalar(keys %xref) . "\n";
- &findusagePL;
- print "Stage 2 C/C++/JS/PL keycount is : " . scalar(keys %xref) . "\n";
- &dumpdb;
- }
- for ($verb) {
- /^default$/ && do {
- # Build database for directory.
- # Files are parsed using whole file regexp's.
- # This is SLOW.
- buildIndex();
- last;
- };
- /^merge$/ && do {
- # Merge databases
- unshift @extra, $fix;
- merge();
- last;
- };
- }
|