Pod2wiki.pl

来自 ChinaUnix Wiki

package MyParser;
use base qw(Pod::Parser);
use Data::Dumper;

sub command { 
    my ($parser, $command, $paragraph, $line_num) = @_;
    my $out_fh = $parser->output_handle();
    my $expansion = $parser->interpolate($paragraph, $line_num);

    ## Interpret the command and its text; sample actions might be:
    if ( $command =~ /^head(\d+)/ ) {
        1 while chomp $expansion;
        print $out_fh '='x$1, $expansion, '='x$1, "\n";
    }
    elsif( $command eq 'encoding') {
    }
    elsif( $command eq 'back' ){
        print $out_fh "\n";
    }
    elsif( $command eq 'item' ){
        if ( $expansion =~ /^(\d+)/ ){
            print $out_fh "#$'";
        }
        else{
            $expansion =~ s/^\*//;
            1 while chomp $expansion;
            print $out_fh "*$expansion";
        }
    }
    elsif( $command eq 'over' ){
        print $out_fh "\n";
    }
    else{
        print "$command\n";
    }
    ## ... other commands and their actions
}

sub verbatim { 
    my ($parser, $paragraph, $line_num) = @_;
    ## Format verbatim paragraph; sample actions might be:
    my $out_fh = $parser->output_handle();
    print $out_fh "$paragraph";
}

sub textblock { 
    my ($parser, $paragraph, $line_num) = @_;
    ## Translate/Format this block of text; sample actions might be:
    my $out_fh = $parser->output_handle();
    my $expansion = $parser->interpolate($paragraph, $line_num);
    print $out_fh $expansion;
}

sub interior_sequence { 
    my ($parser, $seq_command, $seq_argument) = @_;
    ## Expand an interior sequence; sample actions might be:
    my %escapeCode = (
        'lt' => '<',
        'gt' => '>',
        'sol' => '/',
    );

    return "$seq_argument"     if ($seq_command eq 'B');
    return "$seq_argument"  if ($seq_command eq 'X');
    return "$seq_argument"     if ($seq_command eq 'C');
    return "$seq_argument"  if ($seq_command eq 'I');
    return "$seq_argument"  if ($seq_command eq 'F');
#    return "$seq_argument"  if ($seq_command eq 'L');
    if ($seq_command eq 'L'){
        if ( $seq_argument =~ m{(.*)(:?/("?)(.*)\2)?} ){
            if ( $1 ne  ){
                if ( $3 ne  ){        # L<name/"section"> or L<name/section>
                    return "$1";
                }
                else{                   # L<name> or L<url>
                    my $link = $1;
                    if ( $link =~ /^(http|ftp|https):/i ){     # L<scheme:...>
                        return "[$link $link]";
                    }
                    else{               # L<name>
                        return "$link";
                    }
                }
            }
            else{                       # L</section> or L</"section">
                return "#$3";
            }
        }
        elsif ( $seq_argument =~ m{(.*)\|(.*)(:?/("?)(.*)\3)?} ){
            if ( $2 ne  ){
                if ( $4 ne  ){
                    return "$1";
                }
                else{
                    return "$1";
                }
            }
            else{
                return "$1";
            }
        }
        elsif( $seq_argument =~ m{:} ){
            return "$seq_argument $seq_argument";
        }
    }
#    print "[$seq_argument]\n"  if ($seq_command eq 'E' && (!exists $escapeCode{$seq_argument}) );
    return "[$seq_argument]"  if ($seq_command eq 'E' );
    return "$seq_argument";
    ## ... other sequence commands and their resulting text
}

package main;

## Create a parser object and have it parse file whose name was
## given on the command-line (use STDIN if no files were given).
$parser = new MyParser();
$parser->parse_from_filehandle(\*STDIN)  if (@ARGV == 0);
#for (@ARGV) { $parser->parse_from_file($_); }
for (<$ARGV[0]>) { $parser->parse_from_file($_); }


print "\n";
while(<>){
    next if /^=encoding/;
    s/^\s*=head(\d+)(.*)/'='x$1 . " $2 " . '='x$1/e;
    s/B<([^>]+)>/$1/g;
    s/I<([^>]+)>/$1/g;
    print;
}