View of /trunk/admintools/wwdocs2html

    1 #!/usr/bin/perl -sT
    2 ################################################################################
    3 # WeBWorK Online Homework Delivery System
    4 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
    5 # $CVSHeader: admintools/wwdocs2html,v 1.1 2006/01/31 18:28:56 sh002i Exp $
    6 # 
    7 # This program is free software; you can redistribute it and/or modify it under
    8 # the terms of either: (a) the GNU General Public License as published by the
    9 # Free Software Foundation; either version 2, or (at your option) any later
   10 # version, or (b) the "Artistic License" which comes with this package.
   11 # 
   12 # This program is distributed in the hope that it will be useful, but WITHOUT
   13 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   14 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   15 # Artistic License for more details.
   16 ################################################################################
   17 
   18 =head1 NAME
   19 
   20 wwdocs2html - make WeBWorK documentation viewable over the web
   21 
   22 =cut
   23 
   24 use strict;
   25 use warnings;
   26 
   27 $ENV{PATH} = "";
   28 $ENV{ENV} = "";
   29 
   30 our $CHECKOUT_DIR = "/webwork/docs2html";
   31 our $DOC_DIR = "/webwork/www/main/doc/cvs";
   32 
   33 our @FILETYPES = (
   34 	# files in all caps are usually text files
   35 	#[ qr#/[A-Z]+$# => "copy" ],
   36 	
   37 	# files inside /doc are copied, regardless of type
   38 	[ qr#/doc/# => "copy" ],
   39 	
   40 	# copy files some extensions
   41 	[ qr#\.html?$# => "copy" ],
   42 	[ qr#\.te?xt$# => "copy" ],
   43 	#[ qr#\.conf.dist$# => "copy" ],
   44 	#[ qr#\.apache-config.dist$# => "copy" ],
   45 	
   46 	# get pod from files with extensions pm, pl, plx
   47 	[ qr#\.(pm|plx?)$# => "pod" ],
   48 	
   49 	# get pod from files in bin or libexec with no extension (usually perl binaries)
   50 	[ qr#/(bin|libexec)/[^/\.]+$# => "pod" ],
   51 );
   52 
   53 our %TRANSLATORS = (
   54 	copy => \&copy,
   55 	pod => \&pod,
   56 );
   57 
   58 our $CP = "/bin/cp";
   59 our $MKDIR = "/bin/mkdir";
   60 our $FIND = "/usr/bin/find";
   61 our $CVS = "/usr/bin/cvs";
   62 our $POD2HTML = "/usr/local/bin/pod2html";
   63 
   64 our $v; # for verbose switch
   65 
   66 my @dirs;
   67 
   68 if (@ARGV) {
   69 	@dirs = map "$CHECKOUT_DIR/$_", @ARGV;
   70 } else {
   71 	@dirs = glob("$CHECKOUT_DIR/*");
   72 }
   73 
   74 foreach my $dir (@dirs) {
   75 	if ($dir =~ m/^([^\!\$\^\&\*\(\)\~\[\]\|\{\}\'\"\;\<\>\?]+)$/) {
   76 		print "\n-----> $dir <-----\n\n" if $v;
   77 		update_cvs($1);
   78 		process_dir($1);
   79 	} else {
   80 		warn "'$dir' insecure.\n";
   81 	}
   82 }
   83 
   84 sub update_cvs {
   85 	my ($dir) = @_;
   86 	
   87 	system "cd \"$dir\" && $CVS -q update -d" and die "cvs failed: $!\n";
   88 }
   89 
   90 sub process_dir {
   91 	my ($dir) = @_;
   92 	
   93 	my @files;
   94 	
   95 	my @source_files = `$FIND "$dir" -type d -name "CVS" -prune -o -type f -print`;
   96 	foreach my $source_file (@source_files) {
   97 		chomp $source_file;
   98 		# untaint $source_file. (we're not passing it to a shell ever, so we
   99 		# don't have to be particularly careful about it.)
  100 		($source_file) = $source_file =~ /^(.*)$/;
  101 		FILETYPE: foreach my $filetype (@FILETYPES) {
  102 			my ($match, $translator) = @$filetype;
  103 			my ($match_string) = $source_file =~ /^$CHECKOUT_DIR(.*)$/;
  104 			if ($match_string =~ m/$match/) {
  105 				my $dest_file = "$source_file";
  106 				$dest_file =~ s/^$CHECKOUT_DIR/$DOC_DIR/;
  107 				
  108 				my ($dest_dir) = $dest_file =~ m|^(/.*)/|;
  109 				system $MKDIR, "-p", $dest_dir;
  110 				
  111 				$TRANSLATORS{$translator}->($source_file, $dest_file);
  112 				last FILETYPE;
  113 			}
  114 		}
  115 	}
  116 }
  117 
  118 sub copy {
  119 	my ($source_file, $dest_file) = @_;
  120 	
  121 	return if -e $dest_file and (stat $dest_file)[9] >= (stat $source_file)[9];
  122 	print "copy $source_file\n"if $v;
  123 	system $CP, $source_file, $dest_file and die "copy failed: $!\n";
  124 }
  125 
  126 sub pod {
  127 	my ($source_file, $dest_file) = @_;
  128 	$dest_file .= ".html";
  129 	
  130 	return if -e $dest_file and (stat $dest_file)[9] >= (stat $source_file)[9];
  131 	print "pod $source_file\n"if $v;
  132 	system $POD2HTML,
  133 		"--htmlroot=$DOC_DIR",
  134 		"--podroot=$CHECKOUT_DIR",
  135 		"--infile=$source_file",
  136 		"--outfile=$dest_file"
  137 			and die "pod failed: $!\n";
  138 }
  139 
  140 __END__
  141 
  142 # set this to the URL of the htdocs/doc directory.
  143 use constant DOC_BASE => "/webwork2_files/doc";
  144 # FIXME: this should probably be read from global.conf.
  145 
  146 sub main(@) {
  147 	my $force = @_ && $_[0] eq "-f";
  148 	
  149 	my $lib = "$FindBin::Bin/../lib";
  150 	my $htdocs = "$FindBin::Bin/../htdocs";
  151 	my $doc = "$htdocs/doc";
  152 	my $htmlroot = DOC_BASE;
  153 	
  154 	my @modules = `find $lib -name "*.pm"`;
  155 	foreach my $module (@modules) {
  156 		chomp $module;
  157 		
  158 		my $docfile = $module;
  159 		$docfile =~ s/^$lib/$doc/;
  160 		$docfile =~ s/\.pm$/.html/;
  161 		
  162 		next if not $force and -e $docfile and (stat $docfile)[9] >= (stat $module)[9];
  163 		
  164 		my ($docdir) = $docfile =~ m|^(.*)/|;
  165 		unless (-e $docdir) {
  166 			print "creating missing directory $docdir\n";
  167 			system "mkdir -p $docdir"
  168 				and die "mkdir failed: $!\n";
  169 		}
  170 		
  171 		print "generating documentation for module $module\n";
  172 		system "pod2html --htmlroot=$htmlroot --podroot=$lib --infile=$module --outfile=$docfile"
  173 			and die "pod2html failed: $!\n";
  174 	}
  175 }
  176 
  177 main(@ARGV);