gecko-dev/webtools/lxr/source
1999-11-23 21:59:13 +00:00

297 lines
7.4 KiB
Perl
Executable File

#!/usr/bonsaitools/bin/perl
# $Id: source,v 1.15 1999/11/23 21:59:13 endico%mozilla.org 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 Local;
use lib 'lib/';
use SimpleParse;
use LXR::Common;
use LXR::Config;
use File::Basename;
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 =~ /^.*\.(idl|cpp?|cc|java)$/) {
# 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";
my $virtpath = $Path->{'virt'};
my $realpath = $Path->{'real'};
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, '..');
}
# print the description of the current directory
dirdesc($Path->{'virt'});
#print the listing itself
print(&expandtemplate($template,
('files', \&direxpand)));
}
sub printfile {
my $string;
unless ($Path->{'file'}) {
&printdir;
} else {
if (open(SRCFILE, $Path->{'realf'})) {
if (($Path->{'file'} =~ /\.(html)$/)) {
print <SRCFILE>;
} elsif ($Path->{'file'} =~ /README$/) {
print("<PRE>");
while(<SRCFILE>) {
$string = $string . $_;
}
print(markupstring($string, $Path->{'virt'}));
print("</PRE>");
} else {
if (($Path->{'file'} =~ /nsI\w*\.idl$/)) {
my $base = basename($Path->{'file'}, ".idl");
my $dir = $Path->{'virt'};
$dir =~ s#([^/]+)(.*)#$1#;
print("<CENTER>\n");
print("<IMG ALIGN=CENTER BORDER=\"0\" SRC=\"http://unstable.elemental.com/mozilla/build/latest/mozilla" . $dir . "/dox/class_" . $base . ".gif\">\n");
print("<BR>");
print("<A HREF=\"http://unstable.elemental.com/mozilla/build/latest/mozilla" . $dir . "/dox/class_" . $base . ".html\">\n");
print($base . "Interface Reference" . "</A>\n");
print("</CENTER>\n");
}
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');
}
}