view release on metacpan or  search on metacpan

util/lib/PPT/Util.pm  view on Meta::CPAN

        -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;
}