[Lxr-commits] CVS: lxr/lib Local.pm,1.2,1.3
Brought to you by:
ajlittoz
From: Andre-Littoz <ajl...@us...> - 2013-09-24 08:54:23
|
Update of /cvsroot/lxr/lxr/lib In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv6780/lib Modified Files: Local.pm Log Message: source, Local.pm: sub descexpand moved from Local.pm to source This general sub belongs better in source Name fileexpand in Local.pm changed to filedesc to mirror dirdesc sub name for directories New sub iconlink in source to cope with security feature in fileref which forbids HTML code in link text. Also, better comments and various Perl syntax optimisations Index: Local.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/Local.pm,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- Local.pm 17 Sep 2012 11:56:14 -0000 1.2 +++ Local.pm 24 Sep 2013 08:54:19 -0000 1.3 @@ -35,7 +35,7 @@ require Exporter; our @ISA = qw(Exporter); -our @EXPORT = qw(&fdescexpand &descexpand &dirdesc &convertwhitespace); +our @EXPORT = qw(&filedesc &dirdesc); use LXR::Common; use LXR::Markup; @@ -75,25 +75,27 @@ # # Yea, though I walk through the valley of the shadow of pattern # matching, I shall fear no regex. -sub fdescexpand { +# +# ajl 13-07-09: name changed from fdescexpand to filedesc +# to better mirror dirdesc and emphasize the parallel semantics. +sub filedesc { my ($filename, $dir, $releaseid) = @_; my $fh; my $linecount = 0; - my $copy = ""; - my $desc = ""; + my $copy = ''; + my $desc = ''; my $maxlines = 40; #only look at the beginning of the file #ignore files that aren't source code - if ( - !( ($filename =~ /\.c$/) - | ($filename =~ /\.h$/) - | ($filename =~ /\.cc$/) - | ($filename =~ /\.cp$/) - | ($filename =~ /\.cpp$/) - | ($filename =~ /\.java$/) - ) - ) - { return ("\ \;"); } + if ( (substr($filename, -2) ne '.c') + && (substr($filename, -2) ne '.h') + && (substr($filename, -3) ne '.cc') + && (substr($filename, -3) ne '.cp') + && (substr($filename, -4) ne '.cpp') + && (substr($filename, -5) ne '.java') + ) { + return (' '); + } if ($fh = $files->getfilehandle($dir . $filename, $releaseid)) { while (<$fh>) { @@ -106,19 +108,19 @@ } # sanity check: if there's no description then stop - if (!($desc =~ /\w/)) { - return ("\ \;"); + if (!($desc =~ m/\w/)) { + return (' '); } # if a java file, only consider class-level javadoc comments - if ($filename =~ /\.java$/) { + if (substr($filename, -5) eq '.java') { # last /** ... */ before 'public class' or 'public interface' # find declaration - $desc =~ m/public\s((abstract|static|final|strictfp)\s)*(class|interface)/g; + $desc =~ m/public\s+((abstract|static|final|strictfp)\s+)*(class|interface)/; my $declPos = pos $desc; - return "\ \;" if !$declPos; + return ' ' if !$declPos; # last comment start before declaration pos $desc = 0; @@ -127,15 +129,17 @@ last if $declPos < pos $desc; $commentStart = pos $desc; } - return "\ \;" if $commentStart == -1; + return ' ' if $commentStart == -1; # find comment end, and extract pos $desc = $commentStart; $desc =~ m#\*/#g; my $commentEnd = pos $desc; - $desc = substr($desc, $commentStart + 3, $commentEnd - $commentStart - 5); - - return "\ \;" if !$desc; + $desc = substr ( $desc + , $commentStart + 3 + , $commentEnd - $commentStart - 5 + ); + return ' ' if !$desc; # strip off any leading * s $desc =~ s/^\s*\*\s?//mg; @@ -150,8 +154,7 @@ # strip off some CVS keyword lines foreach my $keyword ('Workfile', 'Revision', 'Modtime', 'Author', 'Id', 'Date', 'Source', - 'RCSfile') - { + 'RCSfile') { $desc =~ s/^\s*\$$keyword[\$:].*$//mg; } @@ -164,13 +167,13 @@ # descriptions before we go to the trouble of looking for # one in the first comment. The whitespace between the # delimeter and the description may include a newline. - if ( ($desc =~ s/(?:.*?$filename\s*?- ?-*\s*)([^\n]*)(?:.*)/$1/sgi) + if ( ($desc =~ s/(?:.*?$filename\s*?- ?-*\s*)([^\n]*)(?:.*)/$1/sgi) || ($desc =~ s/(?:.*?$filename\s*?:\s*)([^\n]*)(?:.*)/$1/sgi) - || ($desc =~ s/(?:.*?Description:\s*)([^\n]*)(?:.*)/$1/sgi)) - { + || ($desc =~ s/(?:.*?Description:\s*)([^\n]*)(?:.*)/$1/sgi) + ) { # if the description is non-empty then clean it up and return it - if ($desc =~ /\w/) { + if ($desc =~ m/\w/) { #strip trailing asterisks and "*/" $desc =~ s#\*/?\s*$##; @@ -190,7 +193,7 @@ } # if java and the <filename><seperator> check above didn't work, just dump the whole javadoc - if ($filename =~ /\.java$/) { + if (substr($filename, -5) eq '.java') { return $desc; } @@ -202,7 +205,7 @@ $desc =~ s/\n#.*//s; # Strip off code from the end, starting at typedef - $desc =~ s/\ntypedef.*//s; + $desc =~ s/\n\s*typedef.*//s; # Strip off license $desc =~ s#(?:/\*.*license.*?\*/)(.*)#$1#is; @@ -220,8 +223,8 @@ $desc =~ s#\n\s*/\*+[\s\*]+\*/\n#\n#sg; # Don't bother to continue if there aren't any comments here - if (!($desc =~ m#/\*#)) { - return (" "); + if (-1 == index($desc, '/*')) { + return (' '); } # Remove lines generated by jmc @@ -264,7 +267,7 @@ # If the description is still too long then assume it will look # like gobbeldygook and give up if (length($desc) > 200) { - return (" "); + return (' '); } # htmlify the comments, making links to symbols and files @@ -273,29 +276,15 @@ if ($desc) { return ("<p>$desc</p>"); } else { - return ("\ \;"); + return (' '); } } -# dme: create a short description for a subdirectory in a directory listing -# If no description, return the string "\ \;" to keep the -# table looking pretty. +# dme: Print a descriptive blurb in directory listings between +# the document heading and the table containing the actual listing. # # In Mozilla, if the directory has a README file look in it for lines # like the ones used in source code: "directoryname --- A short description" -sub descexpand { - my ($templ, $node, $dir, $releaseid) = @_; - if ($node =~ m!/$!) { - return LXR::Template::expandtemplate($templ, - ('desctext' => sub { return dirdesc($dir . $node, $releaseid); })); - } else { - return LXR::Template::expandtemplate($templ, - ('desctext' => sub { return fdescexpand($node, $dir, $releaseid); })); - } -} - -# dme: Print a descriptive blurb in directory listings between -# the document heading and the table containing the actual listing. # # For Mozilla, we extract this information from the README file if # it exists. If the file is short then just print the whole thing. @@ -305,22 +294,22 @@ sub dirdesc { my ($path, $releaseid) = @_; my $readh; - if ($readh = $files->getfilehandle($path . "README.txt", $releaseid)) { - return descreadme($path, "README.txt", $readh); + if ($readh = $files->getfilehandle($path . 'README.txt', $releaseid)) { + return descreadme($path, 'README.txt', $readh); } - if ($readh = $files->getfilehandle($path . "README", $releaseid)) { - return descreadme($path, "README", $readh); + if ($readh = $files->getfilehandle($path . 'README', $releaseid)) { + return descreadme($path, 'README', $readh); } - if ($readh = $files->getfilehandle($path . "README.html", $releaseid)) { - return descreadmehtml($path, "README.html", $readh); + if ($readh = $files->getfilehandle($path . 'README.html', $releaseid)) { + return descreadmehtml($path, 'README.html', $readh); } - return " "; + return ' '; } sub descreadmehtml { my ($dir, $file, $desc) = @_; - my $string = ""; + my $string = ''; undef $/; $string = <$desc>; @@ -329,7 +318,7 @@ # if the README is 0 length then give up if (!$string) { - return; + return ' '; } # check if there's a short desc nested inside the long desc. If not, do @@ -337,11 +326,10 @@ # spans within the description. my $long; if ($string =~ - /<span class=["']?lxrlongdesc['"]?>(.*?<span class=["']?lxrshortdesc['"]?>.*?<\/span>.*?)<\/span>/is - ) - { + m/<span class=["']?lxrlongdesc['"]?>(.*?<span class=["']?lxrshortdesc['"]?>.*?<\/span>.*?)<\/span>/is + ) { $long = $1; - if (!($long =~ /<span.*?\<span/is)) { + if ($long !~ m/<span.*?\<span/is) { return ( "<div class='desctext'>$long</div>\n<p>\nSEE ALSO: " . fileref($file, '', $dir . $file) . "</p>\n" @@ -349,19 +337,20 @@ } } elsif ($string =~ /<span class=["']?lxrlongdesc['"]?>(.*?)<\/span>/is) { $long = $1; - if (!($long =~ /\<span/is)) { + if ($long !~ m/\<span/is) { return ( "<div class='desctext lxrlongdesc'>$long</div>\n<p>\nSEE ALSO: " . fileref($file, '', $dir . $file) . "</p>\n" ); } } + return ' '; } sub descreadme { my ($dir, $file, $desc) = @_; - my $string = ""; + my $string = ''; # $string =~ s#(</?([^>^\s]+[^>]*)>.*$)#($2~/B|A|IMG|FONT|BR|EM|I|TT/i)?$1:""#sg; my $n; @@ -379,7 +368,7 @@ # if the README is 0 length then give up if (!$string) { - return; + return ' '; } # strip the emacs tab line @@ -408,7 +397,9 @@ if ($count <= $maxlines) { $string = markupstring($string, $dir); $string = convertwhitespace($string); - return "<div class='desctext'><p class=\"lxrdesc\">$string</p></div>\n"; + return "<div class='desctext'><p class='lxrdesc'>\n" + . $string + . "\n</p></div>"; } else { # grab the first n paragraphs, with n decreasing until the @@ -445,8 +436,8 @@ # since not all of the README is displayed here, # add a link to it. chomp($string); - if ($string =~ /SEE ALSO/) { - $string = $string . ", "; + if (-1 != index($string, 'SEE ALSO')) { + $string = $string . ', '; } else { $string = $string . "</p>\n\n<p>SEE ALSO: "; } @@ -460,7 +451,9 @@ $string =~ s/\s*\n$//gs; chomp($string); - return "<div class='desctext'><p class=\"lxrdesc\">$string</p></div>\n"; + return "<div class='desctext'><p class='lxrdesc'>\n" + . $string + . "\n</p></div>"; } } @@ -472,11 +465,12 @@ # handle ascii bulleted lists # $string =~ s/<p>\n\s+o\s/<p>\n\ \;\ \;o /sg; - $string =~ s/\n\s+o\s/ \;\n<br>\ \;\ \;o /sg; + $string =~ s/\n\s+o\s/\n<br> o /sg; - #find paragraph breaks and replace with <p> ... </p> + #find paragraph breaks and replace by <br> # $string =~ s/\n\s*\n/<br><br>\n/sg; - $string =~ s/(([\S\t ]*?\n)+?)[\t ]*(\n|$)/$1<br>\n/sg; +# $string =~ s/(([\S\t ]*?\n)+?)[\t ]*(\n|$)/$1<br>\n/sg; + $string =~ s/\n\s*\n/\n<br>\n/sg; return ($string); } |