wwdocs2html

#!/usr/bin/perl -sT
################################################################################
# WeBWorK Online Homework Delivery System
# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
# $CVSHeader: admintools/wwdocs2html,v 1.2 2006/05/31 22:59:33 sh002i Exp $
# 
# This program is free software; you can redistribute it and/or modify it under
# the terms of either: (a) the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any later
# version, or (b) the "Artistic License" which comes with this package.
# 
# 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 either the GNU General Public License or the
# Artistic License for more details.
################################################################################

=head1 NAME

wwdocs2html - make WeBWorK documentation viewable over the web

=cut

use strict;
use warnings;

$ENV{PATH} = "";
$ENV{ENV} = "";

our $CHECKOUT_DIR = "/webwork/docs2html";
our $DOC_DIR = "/webwork/www/main/doc/cvs";

our @FILETYPES = (
	# files in all caps are usually text files
	#[ qr#/[A-Z]+$# => "copy" ],
	
	# files inside /doc are copied, regardless of type
	[ qr#/doc/# => "copy" ],
	
	# copy files some extensions
	[ qr#\.html?$# => "copy" ],
	[ qr#\.te?xt$# => "copy" ],
	#[ qr#\.conf.dist$# => "copy" ],
	#[ qr#\.apache-config.dist$# => "copy" ],
	
	# get pod from files with extensions pm, pl, plx
	[ qr#\.(pm|plx?)$# => "pod" ],
	
	# get pod from files in bin or libexec with no extension (usually perl binaries)
	[ qr#/(bin|libexec)/[^/\.]+$# => "pod" ],
);

our %TRANSLATORS = (
	copy => \&copy,
	pod => \&pod,
);

our $CP = "/bin/cp";
our $MKDIR = "/bin/mkdir";
our $FIND = "/usr/bin/find";
our $CVS = "/usr/bin/cvs";
our $POD2HTML = "/usr/local/bin/pod2html";

our $v; # for verbose switch

my @dirs;

if (@ARGV) {
	@dirs = map "$CHECKOUT_DIR/$_", @ARGV;
} else {
	@dirs = glob("$CHECKOUT_DIR/*");
}

foreach my $dir (@dirs) {
	next unless -d $dir;
	if ($dir =~ m/^([^\!\$\^\&\*\(\)\~\[\]\|\{\}\'\"\;\<\>\?]+)$/) {
		print "\n-----> $dir <-----\n\n" if $v;
		update_cvs($1);
		process_dir($1);
	} else {
		warn "'$dir' insecure.\n";
	}
}

sub update_cvs {
	my ($dir) = @_;
	
	system "cd \"$dir\" && $CVS -q update -dP" and die "cvs failed: $!\n";
}

sub process_dir {
	my ($dir) = @_;
	
	my @files;
	
	my @source_files = `$FIND "$dir" -type d -name "CVS" -prune -o -type f -print`;
	foreach my $source_file (@source_files) {
		chomp $source_file;
		# untaint $source_file. (we're not passing it to a shell ever, so we
		# don't have to be particularly careful about it.)
		($source_file) = $source_file =~ /^(.*)$/;
		FILETYPE: foreach my $filetype (@FILETYPES) {
			my ($match, $translator) = @$filetype;
			my ($match_string) = $source_file =~ /^$CHECKOUT_DIR(.*)$/;
			if ($match_string =~ m/$match/) {
				my $dest_file = "$source_file";
				$dest_file =~ s/^$CHECKOUT_DIR/$DOC_DIR/;
				
				my ($dest_dir) = $dest_file =~ m|^(/.*)/|;
				system $MKDIR, "-p", $dest_dir;
				
				$TRANSLATORS{$translator}->($source_file, $dest_file);
				last FILETYPE;
			}
		}
	}
}

sub copy {
	my ($source_file, $dest_file) = @_;
	
	return if -e $dest_file and (stat $dest_file)[9] >= (stat $source_file)[9];
	print "copy $source_file\n"if $v;
	system $CP, $source_file, $dest_file and die "copy failed: $!\n";
}

sub pod {
	my ($source_file, $dest_file) = @_;
	$dest_file .= ".html";
	
	return if -e $dest_file and (stat $dest_file)[9] >= (stat $source_file)[9];
	print "pod $source_file\n"if $v;
	system $POD2HTML,
		"--htmlroot=$DOC_DIR",
		"--podroot=$CHECKOUT_DIR",
		"--infile=$source_file",
		"--outfile=$dest_file"
			and die "pod failed: $!\n";
}

__END__

# set this to the URL of the htdocs/doc directory.
use constant DOC_BASE => "/webwork2_files/doc";
# FIXME: this should probably be read from global.conf.

sub main(@) {
	my $force = @_ && $_[0] eq "-f";
	
	my $lib = "$FindBin::Bin/../lib";
	my $htdocs = "$FindBin::Bin/../htdocs";
	my $doc = "$htdocs/doc";
	my $htmlroot = DOC_BASE;
	
	my @modules = `find $lib -name "*.pm"`;
	foreach my $module (@modules) {
		chomp $module;
		
		my $docfile = $module;
		$docfile =~ s/^$lib/$doc/;
		$docfile =~ s/\.pm$/.html/;
		
		next if not $force and -e $docfile and (stat $docfile)[9] >= (stat $module)[9];
		
		my ($docdir) = $docfile =~ m|^(.*)/|;
		unless (-e $docdir) {
			print "creating missing directory $docdir\n";
			system "mkdir -p $docdir"
				and die "mkdir failed: $!\n";
		}
		
		print "generating documentation for module $module\n";
		system "pod2html --htmlroot=$htmlroot --podroot=$lib --infile=$module --outfile=$docfile"
			and die "pod2html failed: $!\n";
	}
}

main(@ARGV);