Log Message:
-----------
generate a top-level index file listing all PODs
Modified Files:
--------------
admintools:
ww-make-docs
Revision Data
-------------
Index: ww-make-docs
===================================================================
RCS file: /webwork/cvs/system/admintools/ww-make-docs,v
retrieving revision 1.3
retrieving revision 1.4
diff -Lww-make-docs -Lww-make-docs -u -r1.3 -r1.4
--- ww-make-docs
+++ ww-make-docs
@@ -5,75 +5,176 @@
package WeBWorK::Utils::HTMLDocs;
-use Pod::Find qw(pod_find);
+use File::Find;
+use IO::File;
+use Pod::Find qw(pod_find simplify_name);
use Pod::Html;
+use POSIX qw(strftime);
+use Data::Dumper;
+
+our @sections = (
+ bin => "Scripts",
+ conf => "Config Files",
+ doc => "Documentation",
+ lib => "Libraries",
+ macros => "Macros",
+);
sub new {
- my $invocant = shift;
+ my ($invocant, %o) = @_;
my $class = ref $invocant || $invocant;
- return bless { @_ }, $class;
+
+ my @section_list = exists $o{sections} ? @{$o{sections}} : @sections;
+ my $section_hash = {@section_list};
+ my $section_order = [ map { $section_list[2*$_] } 0..$#section_list/2 ];
+ delete $o{sections};
+
+ my $self = {
+ %o,
+ idx => {},
+ section_hash => $section_hash,
+ section_order => $section_order,
+ };
+ #print Dumper($self);
+ return bless $self, $class;
}
sub convert_pods {
my $self = shift;
my $source_root = $self->{source_root};
- my $subdirs = do {
+ my $dest_root = $self->{dest_root};
+ my @subdirs = do {
my $dh;
opendir $dh, $source_root;
- join ':',
- grep { not (/^\./ or /^(CVS|.svn)$/) and -d "$source_root/$_" }
- readdir $dh;
- };
+ grep { not (/^\./ or /^(CVS|.svn)$/) and -d "$source_root/$_" }
+ readdir $dh;
+ };
+ my $subdirs = join(':', @subdirs);
my %pods = pod_find({}, $source_root);
while (my ($pod_path, $pod_name) = each %pods) {
$self->process_pod($subdirs, $pod_path, $pod_name);
}
+ $self->write_index("$dest_root/index.html");
}
sub process_pod {
- my ($self, $subdirs, $pod_path, $pod_name) = @_;
+ my ($self, $subdirs, $pod_path) = @_;
my $source_root = $self->{source_root};
my $dest_root = $self->{dest_root};
my $dest_url = $self->{dest_url};
+ my $pod_name;
+
my ($subdir, $filename) = $pod_path =~ m|^$source_root/(?:(.*)/)?(.*)$|;
- if ($filename =~ /\.pl$/) {
+ my $subdir_rest;
+ if (defined $subdir and $subdir =~ m|/|) {
+ ($subdir_rest) = $subdir =~ m|^[^/]*/(.*)|;
+ }
+ if ($filename =~ /\.plx?$/ or $filename !~ /\./) {
+ $pod_name = $filename;
$filename .= '.html';
} elsif ($filename =~ /\.pod$/) {
+ $pod_name = $filename;
+ $pod_name =~ s/\.pod$//;
$filename =~ s/\.pod$/.html/;
} elsif ($filename =~ /\.pm$/) {
+ $pod_name = defined $subdir_rest ? "$subdir_rest/" : "";
+ $pod_name .= $filename;
+ $pod_name =~ s/\.pm$//;
+ $pod_name =~ s|/+|::|g;
$filename =~ s/\.pm$/.html/;
}
my $html_dir = defined $subdir ? "$dest_root/$subdir" : $dest_root;
my $html_path = "$html_dir/$filename";
+ my $html_rel_path = defined $subdir ? "$subdir/$filename" : $filename;
- #print "$pod_path -- $pod_name\n";
- #print " subdir=$subdir\n";
- #print " html_dir=$html_dir\n";
- #print " html_path=$html_path\n";
+ #print "$pod_path - $pod_name\n";
+ $self->update_index($subdir, $html_rel_path, $pod_name);
+ do_mkdir($html_dir);
+ do_pod2html(
+ subdirs => $subdirs,
+ source_root => $source_root,
+ dest_root => $dest_root,
+ dest_url => $dest_url,
+ pod_path => $pod_path,
+ html_path => $html_path,
+ );
+}
+
+sub update_index {
+ my ($self, $subdir, $html_rel_path, $pod_name) = @_;
+ $subdir =~ s|/.*$||;
+ my $idx = $self->{idx};
+ my $sections = $self->{section_hash};
+ if (exists $sections->{$subdir}) {
+ push @{$idx->{$subdir}}, [ $html_rel_path, $pod_name ];
+ } else {
+ warn "no section for subdir '$subdir'\n";
+ }
+}
+
+sub write_index {
+ my ($self, $out_path) = @_;
+ my $idx = $self->{idx};
+ my $sections = $self->{section_hash};
+ my $section_order = $self->{section_order};
+ my $source_root = $self->{source_root};
+ $source_root =~ s|^.*/||;
+
+ #print Dumper($idx);
+
+ my $header = "<html><head><title>Index $source_root</title></head><body>\n";
+ my $content_start = "<h1>Index for $source_root</h1><ul>\n";
+ my $content = "";
+
+ foreach my $section (@$section_order) {
+ next unless defined $idx->{$section};
+ my $section_name = $sections->{$section};
+ $content_start .= "<li><a href=\"#$section\">$section_name</a></li>\n";
+ my @files = sort @{$idx->{$section}};
+ $content .= "<h2><a name=\"$section\">$section_name</a></h2><ul>\n";
+ foreach my $file (sort { $a->[1] cmp $b->[1] } @files) {
+ my ($path, $name) = @$file;
+ $content .= "<li><a href=\"$path\">$name</a></li>\n";
+ }
+ $content .= "</ul><hr/>\n";
+ }
- system '/bin/mkdir', '-p', $html_dir;
+ $content_start .= "</ul><hr/>\n";
+ my $date = strftime "%a %b %e %H:%M:%S %Z %Y", localtime;
+ my $content_end = "<p>Generated $date</p>\n";
+ my $footer = "</body></html>\n";
+
+ my $fh = new IO::File($out_path, 'w') or die "Failed to open index '$out_path' for writing: $!\n";
+ print $fh $header, $content_start, $content, $content_end, $footer;
+}
+
+sub do_mkdir {
+ my $dir = shift;
+ system '/bin/mkdir', '-p', $dir;
if ($?) {
my $exit = $? >> 8;
my $signal = $? & 127;
my $core = $? & 128;
- die "/bin/mkdir -p $html_dir failed (exit=$exit signal=$signal core=$core)\n";
+ die "/bin/mkdir -p $dir failed (exit=$exit signal=$signal core=$core)\n";
}
-
- #print join(" ",
- pod2html(
- defined $subdirs && length $subdirs ? "--podpath=$subdirs" : (),
- "--podroot=$source_root",
- "--htmldir=$dest_root",
- defined $dest_url && length $dest_url ? "--htmlroot=$dest_url" : (),
- "--infile=$pod_path",
- "--outfile=$html_path",
+}
+
+sub do_pod2html {
+ my %o = @_;
+ my @args = (
+ defined $o{subdirs} && length $o{subdirs} ? "--podpath=$o{subdirs}" : (),
+ "--podroot=$o{source_root}",
+ "--htmldir=$o{dest_root}",
+ defined $o{dest_url} && length $o{dest_url} ? "--htmlroot=$o{dest_url}" : (),
+ "--infile=$o{pod_path}",
+ "--outfile=$o{html_path}",
'--recurse',
'--header',
);
- #), "\n";
- #exit;
+ #print join(" ", 'pod2html', @args), "\n";
+ pod2html(@args);
}
package main;
|
