#!/usr/bonsaitools/bin/perl # $Id: source,v 1.17 2006/02/02 12:14:33 timeless%mozdev.org Exp $ # source -- Present sourcecode as html, complete with references # # Arne Georg Gleditsch # Per Kristian Gjermshus # # # 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("", $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("", $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 = "\n"; if ($Conf->htmldir) { unless (open(TEMPL, $Conf->htmldir)) { &warning("Template ".$Conf->htmldir." does not exist."); } else { $save = $/; undef($/); $template = ; $/ = $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("

\nThis directory does not exist.\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 = ; $/ = $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 ; } elsif ($Path->{'file'} =~ /README$/i) { print("

");
		while() {
            	    $string = $string . $_;
        	}
                print(markupstring($string, $Path->{'virt'}));
		print("
"); } else { if (($Path->{'file'} =~ /nsI\w*\.idl$/)) { my $base = basename($Path->{'file'}, ".idl"); my $dir = $Path->{'virt'}; $dir =~ s#([^/]+)(.*)#$1#; my $doxRoot = "http://unstable.elemental.com/mozilla/build/latest/mozilla/" . $dir . "/dox/"; print("

Inheritance diagram for " . $base . ":

\n"); print("

\n"); print("\"Inheritance\n"); print("

\n"); print("

Collaboration diagram for " . $base . ":

\n"); print("

\n"); print("\"Collaboration\n"); print("

\n"); print("

\n"); print("[ \n"); print("" . $base . " Interface Reference |"); print(" Graph Legend ]\n"); print("

\n"); } print("
");
		&markupfile(\*SRCFILE, $Path->{'virt'}, $Path->{'file'},
                             sub { print shift });
		print("
"); } close(SRCFILE); } else { print("

\nThis file does not exist.\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'); } }