pjs/webtools/lxr/source

#!/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) ;