mirror of
https://github.com/mozilla/gecko-dev.git
synced 2024-11-02 15:15:23 +00:00
60ff38a615
yet another attempt at adding descriptions to directory listings. This time use the following search criterion for rcs variables which hopefully won't confuse cvs. /Id: $filename/ mozilla/README directory was confusing lxr. Added a check that README is a regular file before its displayed in the directory listing.
368 lines
8.5 KiB
Perl
Executable File
368 lines
8.5 KiB
Perl
Executable File
#!/usr/bonsaitools/bin/perl
|
|
# $Id: source,v 1.10 1998/06/23 01:01:11 jwz Exp $
|
|
|
|
# source -- Present sourcecode as html, complete with references
|
|
#
|
|
# 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.
|
|
|
|
######################################################################
|
|
|
|
use lib 'lib/';
|
|
use SimpleParse;
|
|
use LXR::Common;
|
|
use LXR::Config;
|
|
|
|
|
|
# dme: Search the beginning of a source file for a short description
|
|
# to be displayed in directory listings. Not all files have
|
|
# them and the ones that do use different formats so there are
|
|
# lots of ways to end up with junk. The basic format is: a file
|
|
# name possibly followed by a colon or dash(es) with whitespace
|
|
# strewn in followed by the description and maybe some stray comment
|
|
# characters. Don't be confused by #includes or rcs comments
|
|
# at the beginning of the file.
|
|
# -dme
|
|
sub fdescexpand {
|
|
my $linecount=0;
|
|
local $desc= "";
|
|
|
|
#ignore files that aren't source code
|
|
if (!(
|
|
($filename =~ /\.c$/) |
|
|
($filename =~ /\.h$/) |
|
|
($filename =~ /\.cc$/) |
|
|
($filename =~ /\.cp$/) |
|
|
($filename =~ /\.cpp$/) |
|
|
($filename =~ /\.java$/)
|
|
)){
|
|
return("");
|
|
}
|
|
|
|
if (open(FILE, $Path->{'real'}."/".$filename)) {
|
|
while(<FILE>){
|
|
if($linecount++ > 40) {
|
|
last;
|
|
}elsif (/Id: $filename/){
|
|
#ignore cvs headers
|
|
}elsif (/^#/){
|
|
#ignore cpp directives
|
|
}elsif (/$filename\s*- ?-*\s*/i){
|
|
$desc = (split(/ $filename\s*- ?-*\s*/i))[1];
|
|
if ($desc) {last};
|
|
}elsif (/$filename\s*:\s*/i){
|
|
$desc = (split(/ $filename\s*:\s*/i))[1];
|
|
if ($desc) {last};
|
|
}elsif (/$filename\s\s*/i){
|
|
$desc = (split(/ $filename\s\s*/i))[1];
|
|
if ($desc) {last};
|
|
}
|
|
}
|
|
close(FILE);
|
|
}
|
|
if (!($desc)){
|
|
return("");
|
|
}
|
|
|
|
#strip trailing asterisks and "*/"
|
|
$desc =~ s#\*/?\s*$##;
|
|
|
|
#htmlify the comments making links to symbols and files
|
|
$desc = markupstring($desc, $Path->{'virt'});
|
|
|
|
return($desc);
|
|
}
|
|
|
|
sub descexpand {
|
|
|
|
$desc= "";
|
|
if (open(DESC, $Path->{'real'}."/doc/".$filename.".short")) {
|
|
$desc=<DESC>;
|
|
close(DESC);
|
|
}
|
|
return($desc);
|
|
}
|
|
|
|
|
|
sub diricon {
|
|
my $img, $link;
|
|
if ($filename eq '..') {
|
|
$img = "/icons/back.gif";
|
|
$link = $parentdir;
|
|
} else {
|
|
# $img = "/icons/folder.gif";
|
|
$img = "internal-gopher-menu";
|
|
$link = $Path->{'virt'}.$filename;
|
|
}
|
|
return(&fileref("<IMG ALIGN=ABSBOTTOM BORDER=0 SRC=\"$img\">", $link));
|
|
}
|
|
|
|
sub dirname {
|
|
if ($filename eq '..') {
|
|
return(&fileref("Parent directory", $parentdir));
|
|
} else {
|
|
return(&fileref($filename, $Path->{'virt'}.$filename));
|
|
}
|
|
}
|
|
|
|
|
|
sub fileicon {
|
|
my $img;
|
|
|
|
if ($filename =~ /^.*\.[ch]$/) {
|
|
# $img = "/icons/c.gif";
|
|
$img = "internal-gopher-text";
|
|
} elsif ($filename =~ /^.*\.(cpp|cc)$/) {
|
|
# TODO: Find a nice icon for c++ files (KDE?)
|
|
# $img = "/icons/c.gif";
|
|
$img = "internal-gopher-text";
|
|
} else {
|
|
# $img = "/icons/text.gif";
|
|
$img = "internal-gopher-unknown";
|
|
}
|
|
|
|
return(&fileref("<IMG ALIGN=ABSBOTTOM BORDER=0 SRC=\"$img\">",
|
|
$Path->{'virt'}.$filename));
|
|
}
|
|
|
|
|
|
sub filename {
|
|
return(&fileref($filename, $Path->{'virt'}.$filename));
|
|
}
|
|
|
|
|
|
sub filesize {
|
|
my $templ = shift;
|
|
my $s = (-s $Path->{'real'}.$filename);
|
|
my $str;
|
|
if ($s < 1<<10) {
|
|
$str = "$s";
|
|
} else {
|
|
# if ($s < 1<<20) {
|
|
$str = ($s>>10) . "k";
|
|
# } else {
|
|
# $str = ($s>>20) . "M";
|
|
# }
|
|
}
|
|
return(&expandtemplate($templ,
|
|
('bytes', sub {return($str)}),
|
|
('kbytes', sub {return($str)}),
|
|
('mbytes', sub {return($str)})
|
|
));
|
|
}
|
|
|
|
|
|
sub modtime {
|
|
|
|
my $current_time = time;
|
|
my $file_time = (stat($Path->{'real'}.$filename))[9];
|
|
|
|
my @t = gmtime($file_time);
|
|
|
|
my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
|
|
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
|
|
my ($sec, $min, $hour, $mday, $mon, $year) = @t;
|
|
$year += 1900;
|
|
$mon = $months[$mon];
|
|
|
|
my $one_hour = (60 * 60);
|
|
my $six_months = $one_hour * 24 * int(365/2);
|
|
|
|
if ($file_time <= ($current_time - $six_months) ||
|
|
$file_time >= ($current_time + $one_hour)) {
|
|
return sprintf("%s %2d %04d", $mon, $mday, $year);
|
|
} else {
|
|
return sprintf("%s %2d %02d:%02d", $mon, $mday, $hour, $min);
|
|
}
|
|
}
|
|
|
|
sub bgcolor {
|
|
if (!($line % 3)) {
|
|
$color = ($color eq "#EEEEEE")? "#FFFFFF": "#EEEEEE";
|
|
}
|
|
return($color);
|
|
}
|
|
|
|
|
|
sub direxpand {
|
|
my $templ = shift;
|
|
my $direx = '';
|
|
local $line = 0;
|
|
local $filename;
|
|
local $filestat;
|
|
local $color="#FFFFFF";
|
|
|
|
foreach $filename (@dirs) {
|
|
$line++;
|
|
$direx .= &expandtemplate($templ,
|
|
('iconlink', \&diricon),
|
|
('namelink', \&dirname),
|
|
('filesize', sub {return('-')}),
|
|
('modtime', \&modtime),
|
|
('bgcolor', \&bgcolor),
|
|
('description', \&descexpand));
|
|
}
|
|
|
|
foreach $filename (@files) {
|
|
$line++;
|
|
next if $filename =~ /^.*\.[oa]$|^core$|^00-INDEX$/;
|
|
$direx .= &expandtemplate($templ,
|
|
('iconlink', \&fileicon),
|
|
('namelink', \&filename),
|
|
('filesize', \&filesize),
|
|
('modtime', \&modtime),
|
|
('bgcolor', \&bgcolor),
|
|
('description', \&fdescexpand));
|
|
}
|
|
|
|
return($direx);
|
|
}
|
|
|
|
sub printdir {
|
|
my $template;
|
|
my $index;
|
|
local %index;
|
|
local @dirs;
|
|
local @files;
|
|
local $parentdir;
|
|
|
|
|
|
$template = "<ul>\n\$files{\n<li>\$iconlink \$namelink\n}</ul>\n";
|
|
if ($Conf->htmldir) {
|
|
unless (open(TEMPL, $Conf->htmldir)) {
|
|
&warning("Template ".$Conf->htmldir." does not exist.");
|
|
} else {
|
|
$save = $/; undef($/);
|
|
$template = <TEMPL>;
|
|
$/ = $save;
|
|
close(TEMPL);
|
|
}
|
|
}
|
|
|
|
if (opendir(DIR, $Path->{'real'})) {
|
|
foreach $f (sort(grep/^[^\.]/,readdir(DIR))) {
|
|
if ($f eq "CVS") {
|
|
# skip it
|
|
} elsif (-d $Path->{'real'}.$f) {
|
|
push(@dirs,"$f/");
|
|
} else {
|
|
push(@files,$f);
|
|
}
|
|
}
|
|
closedir(DIR);
|
|
} else {
|
|
print("<p align=center>\n<i>This directory does not exist.</i>\n");
|
|
if ($Path->{'real'} =~ m#(.+[^/])[/]*$#) {
|
|
if (-e $1) {
|
|
&warning("Unable to open ".$Path->{'real'});
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
if (-f $Path->{'real'}."00-INDEX") {
|
|
open(INDEX,$Path->{'real'}."00-INDEX") ||
|
|
&warning("Existing \"00-INDEX\" could not be opened.");
|
|
$save = $/; undef($/);
|
|
$index = <INDEX>;
|
|
$/ = $save;
|
|
|
|
%index = $index =~ /\n(\S*)\s*\n\t-\s*([^\n]*)/gs;
|
|
}
|
|
|
|
if ($Path->{'virt'} =~ m#^(.*/)[^/]*/$#) {
|
|
$parentdir = $1;
|
|
unshift(@dirs, '..');
|
|
}
|
|
|
|
if (open(DESC, $Path->{'real'}."/doc/index.html")) {
|
|
print(<DESC>);
|
|
print("\n<p>\n");
|
|
close(DESC);
|
|
}
|
|
|
|
print(&expandtemplate($template,
|
|
('files', \&direxpand)));
|
|
}
|
|
|
|
|
|
sub printfile {
|
|
|
|
unless ($Path->{'file'}) {
|
|
&printdir;
|
|
|
|
if ( (-f $Path->{'real'}.README) &&
|
|
(open(SRCFILE, $Path->{'real'}.README)) ) {
|
|
print("<hr><pre>");
|
|
&markupfile(\*SRCFILE, $Path->{'virt'}, 'README',
|
|
sub { print shift });
|
|
print("</pre>");
|
|
close(SRCFILE);
|
|
}
|
|
|
|
} else {
|
|
if (open(SRCFILE, $Path->{'realf'})) {
|
|
if (($Path->{'file'} =~ /\.(html)$/)) {
|
|
print <SRCFILE>;
|
|
}
|
|
else {
|
|
if(open(DESC, $Path->{'real'}."doc/".$Path->{'file'}.".long")){
|
|
print(<DESC>);
|
|
close(DESC);
|
|
}
|
|
print("<pre>");
|
|
&markupfile(\*SRCFILE, $Path->{'virt'}, $Path->{'file'},
|
|
sub { print shift });
|
|
print("</pre>");
|
|
}
|
|
close(SRCFILE);
|
|
} else {
|
|
print("<p align=center>\n<i>This file does not exist.</i>\n");
|
|
|
|
if (-f $Path->{'real'}.$Path->{'file'}) {
|
|
&warning("Unable to open ".$Path->{'realf'});
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
($Conf, $HTTP, $Path) = &init($0);
|
|
|
|
#if the file is html then don't print a header because the file
|
|
#has its own -dme
|
|
if (!($Path->{'file'} =~ /\.(html)$/)) {
|
|
if ($Path->{'file'}) {
|
|
&makeheader('source');
|
|
} else {
|
|
&makeheader('sourcedir');
|
|
}
|
|
}
|
|
|
|
&printfile;
|
|
|
|
if (!($Path->{'file'} =~ /\.(html)$/)) {
|
|
if ($Path->{'file'}) {
|
|
&makefooter('source');
|
|
} else {
|
|
&makefooter('sourcedir');
|
|
}
|
|
}
|
|
|
|
#$len = length($file);
|
|
#print ("length is: ", $len) ;
|