package PPT::Util; # $Id: Util.pm,v 1.2 2004/08/05 14:24:55 cwest Exp $ use strict; #BEGIN{sub Pod::Simple::DEBUG () {10} } use base qw[Exporter]; use Config::General; use IO::All; use Pod::Simple::HTML; use Carp; use FindBin; use CGI qw[:all]; use Template; use vars qw[@EXPORT $BASE $CONFIG $HTML $SRC $V7DOC $HTMLSRC $TT $TTWRAPPER $TEMPLATE $BIN $CFG $README]; @EXPORT = qw[config_read config_cmds create_cmd_doc copy_cmd_src create_cmd_index copy_v7doc clean_html_dir generate_what generate_table generate_page clean_bin_dir copy_dist_contrib]; $BASE = "$FindBin::Bin/.."; # relative to $dist/util $CONFIG = "$BASE/data/index.cfg"; $HTML = "$BASE/html"; $SRC = "$BASE/src"; $V7DOC = "$BASE/data/v7doc"; $HTMLSRC = "$BASE/html-src"; $TT = "$BASE/data/tt"; $TTWRAPPER = "$TT/wrapper.tt"; $BIN = "$BASE/bin"; $README = "$BASE/README"; do $README; # evil trick for easy version numbering $TEMPLATE = Template->new({ PROCESS => $TTWRAPPER, OUTPUT_PATH => $HTML, ABSOLUTE => 1, VARIABLES => { version => __PACKAGE__->VERSION }, }); sub config_read { my $config = shift || $CONFIG; $CFG = { ParseConfig( -ConfigFile => $config, -LowerCaseNames => 1, -AutoTrue => 1, ) } } sub config_cmds { my $class = shift; config_read unless $CFG; my @cmds; foreach ( keys %{$CFG->{command}} ) { push @cmds, $_ if ($class ? ($CFG->{command}->{$_}->{class} eq $class) : 1); } return @cmds; } sub _cmd_contrib { my $cmd = shift; croak "Requires command" unless $cmd; config_read unless $CFG; my $contribs = $CFG->{command}->{$cmd}->{contrib}; my @contrib = (); @contrib = ref($contribs) eq 'ARRAY' ? @{$contribs} : $contribs if $contribs; my ($basename) = $cmd =~ /(.+)\.\d+/; return (\@contrib, $basename); } sub create_cmd_doc { my ($contrib, $basename) = &_cmd_contrib; return unless @{$contrib}; foreach ( @{$contrib} ) { mkdir "$HTML/commands/$basename"; my $parse = Pod::Simple::HTML->new; my $out = ''; $parse->output_string(\$out); my $res; if ( -e "$SRC/$basename/$basename.pod" ) { $res = $parse->parse_file("$SRC/$basename/$basename.pod"); } else { $res = $parse->parse_file("$SRC/$basename/$_->{name}"); } io("$HTML/commands/$basename/$_->{name}.html")->print($out) if $res; } } sub copy_cmd_src { my ($contrib, $basename) = &_cmd_contrib; return unless @{$contrib}; foreach ( @{$contrib} ) { mkdir "$HTML/commands/$basename"; io("$SRC/$basename/$_->{name}") > io("$HTML/commands/$basename/$_->{name}"); if ( $_->{support} ) { io("$SRC/$basename/$_") > io("$HTML/commands/$basename/$_") for split m/\s+/, $_->{support}; } } } sub copy_v7doc { my $cmd = shift; croak "Requires command" unless $cmd; config_read unless $CFG; my ($basename) = $cmd =~ /(.+)\.\d+/; mkdir "$HTML/commands/$basename"; io("$V7DOC/$cmd") > io("$HTML/commands/$basename/$cmd") if -e "$V7DOC/$cmd"; } sub create_cmd_index { my ($contrib, $basename) = _cmd_contrib(@_); my ($section) = $_[0] =~ /(\d+)$/; foreach ( @{$contrib} ) { $_->{manpage} = (-s "$HTML/commands/$basename/$_->{name}.html" ? 1 : 0); } $TEMPLATE->process("$TT/command.tt", { command => $basename, contrib => $contrib, v7 => (-e "$V7DOC/$_[0]" ? $_[0] : undef ), name => $_[0], }, "commands/$basename/index.html") || die $TEMPLATE->error; } sub clean_html_dir { `find $HTML/commands/* -type f | grep -v CVS | xargs rm`; # I know, it's cheap. `rm $HTML/*.html`; } sub clean_bin_dir { `rm $BIN/*`; } sub _make_cmd_links { my @cmds = @_; my %list; foreach ( @cmds ) { my ($base) = $_ =~ /(.+)\.\d+$/; $list{$base} = @{(_cmd_contrib($_))[0]} ? 1 : 0; } %list; } sub generate_what { my %commands = _make_cmd_links( sort {$a cmp $b} config_cmds('command') ); my %games = _make_cmd_links( sort {$a cmp $b} config_cmds('game') ); $TEMPLATE->process("$TT/what.tt", { commands => \%commands, games => \%games }, "what.html") || die $TEMPLATE->error; } sub generate_table { my @commands = sort {$a cmp $b} config_cmds; my @rows; foreach (@commands) { my ($contrib, $base) = _cmd_contrib($_); my @row = ($base); push @row, $CFG->{command}->{$_}->{class}; push @row, [map $_->{author}, @{$contrib}]; push @row, [map $_->{date}, @{$contrib}]; push @row, @{$contrib} ? 'done' : 'missing'; push @row, (grep{-e "$HTML/commands/$base/$_->{name}.html"}@{$contrib}) ? 'done' : 'missing'; my @tests; foreach my $c ( @{$contrib} ) { $_ = $c; if ( $_->{test} ) { my @test = ref($_->{test}) eq 'HASH' ? $_->{test} : @{$_->{test}}; $_->{command} = $c->{name} for @test; push @tests, @test; } } push @row, \@tests; push @rows, \@row; } $TEMPLATE->process("$TT/doneness.tt", { commands => \@rows }, 'doneness.html') || die $TEMPLATE->error; } sub generate_page { my $page_name = shift; my $original = "$HTMLSRC/$page_name"; $TEMPLATE->process($original, {}, $page_name) || die $TEMPLATE->error; } sub copy_dist_contrib { my ($contrib, $basename) = _cmd_contrib(@_); return unless @{$contrib}; my $dist; if ( @{$contrib} > 1 ) { foreach ( @{$contrib} ) { $dist = $_->{name} and last if $_->{dist} && $_->{dist} == 1; } } else { $dist = $contrib->[0]->{name} unless exists $contrib->[0]->{dist} && $contrib->[0]->{dist} == 0; } return unless $dist; $dist = "$SRC/$basename/$dist"; io($dist) > io("$BIN/$basename"); chmod 0755, "$BIN/$basename"; } 1;