复制代码
- =info
- Markdown 部分格式转 BBCode + 代码块着色
- 523066680@163.com / Code-By.Org
- 2017-05
- V2.0 更新循环方案
- =cut
- use strict;
- use Encode;
- use IO::Handle(1);
- STDOUT->autoflush(1);
- our $highlight = 'D:/Lib/highlight-3.36-x64/highlight.exe';
- my $file = encode('gbk', decode('utf8', "D:/Sync/Perl/教学翻译、整理/Perl One-Liners.md"));
- #my $file = encode('gbk', decode('utf8', "sample.md"));
- my @arr;
- load($file, \@arr);
- our @sizes = ( 2,3,4,5,6,7,8 ); #标题字体大小
- reset_sizes( \@sizes, \@arr ); #根据实际层级重设列表
- format_bbcode(\@arr); #转论坛格式
- my $all = join("\n", @arr);
- our $table = '[list][table=60%, #f8f8f8][tr][td][font=consolas][size=2]';
- our $table_tail = '[/size][/font][/b][/td][/tr][/table][/list]';
- format_codeblock(\$all);
- format_inline(\$all);
- #bathome 的缩进不够明显,加倍
- $all=~s/(\[list\])/$1$1/g;
- $all=~s/(\[\/list\])/$1$1/g;
- # table 后面不需要再换行
- $all=~s{(\Q[/table]\E.*?\n)\n}{$1}sgi;
- print encode('gbk', decode("utf8", $all));
- sub format_bbcode
- {
- my $arr = shift;
- my $prev;
- my $curv;
- my $crlf;
- my $size;
- for my $i ( 0 .. $#$arr )
- {
- $arr->[$i] =~s/(\r?\n)$//;
- $crlf = $1;
- if ( $arr->[$i]=~s/^(#+)// )
- {
- $curv = length($1);
- $size = $sizes[$curv-1]; #下标从 0 开始
- $arr->[$i] = "[size=$size][b]" .$arr->[$i] ."[/b][/size]";
- $arr->[$i] .= "[list]";
- if ( $prev )
- {
- if ( $curv <= $prev )
- {
- $arr->[$i] = "[/list]"x($prev - $curv + 1) .$arr->[$i];
- }
- elsif ( $curv > $prev ) { }
- }
- $prev = $curv;
- }
- #遇到下一个标题时添加换行
- if ( $i < $#$arr
- and $arr->[$i+1]=~/^\#/
- and ($arr->[$i] ne "") )
- {
- $arr->[$i] .= "\n";
- }
- #单行代码和代码块前面补充空行
- if ( ($i > 0)
- and ($arr->[$i] =~/^\s*`/)
- and ($arr->[$i-1] ne "")
- and (not $arr->[$i-1]=~/\n$/)
- and (not $arr->[$i-1]=~/\[list\]/)
- )
- {
- $arr->[$i-1] .= "\n";
- }
- format_inline( \$arr->[$i] );
- format_else(\$arr->[$i]);
- }
- #缩进结束
- $arr->[-1] .= '[/list]'x$prev if ( $prev > 0 );
- }
- sub format_codeblock
- {
- our $highlight;
- my $all = shift;
- my $bbcode;
- while ($$all =~/```(\w+)?\r?\n(.*?)\r?\n```/s)
- {
- writeFile( "temp.txt", \$2 );
- if (defined $1)
- { `$highlight -K3 -S$1 -OBBCode --no-trailing-nl -ssourceforge ./temp.txt -o bbcode.txt`; }
- else
- { `$highlight -K3 -OBBCode --no-trailing-nl -ssourceforge ./temp.txt -o bbcode.txt`; }
- read_slurp( "bbcode.txt", \$bbcode );
- $bbcode = $table .'[font=consolas]' .$bbcode .'[/font]' .$table_tail;
- $$all =~s/```(\w+)?\r?\n(.*?)```/$bbcode/s;
- }
- }
- sub format_inline
- {
- our $highlight;
- my $line = shift;
- my ($head, $tail ) = ('[font=consolas][b]', '[/b][/font]');
- my $inline_code;
- if ($$line=~/^\s*`[^"]+("|')(.+)("|')/)
- {
- writeFile( "temp.txt", \$2 );
- `$highlight -K3 -Sperl -OBBCode --no-trailing-nl -ssourceforge ./temp.txt -o bbcode.txt`;
- read_slurp( "bbcode.txt", \$inline_code );
- $$line=~s/^\s*`([^"]+)("|')(.+)("|')(.*)`/$head$1$2${inline_code}$4$5${tail}/;
- }
- }
- sub format_else
- {
- my $line = shift;
- #粗体
- $$line=~s/\*{2}(.*?)\*{2}/\[b\]$1\[\/b\]/g;
- #斜体
- $$line=~s/\*(.*?)\*/\[i\]$1\[\/i\]/g;
- #链接
- $$line=~s/\[([^\]]+)\]\((.*?)\)/\[url=$2\]$1\[\/url\]/g;
- }
- sub reset_sizes
- {
- my ($sizes, $arr) = @_;
- my $max = 0;
- grep { /^(#+)/; $max = length($1) if (length($1) > $max) } @$arr;
- @$sizes = reverse @{$sizes}[ 0 .. $max-1 ];
- }
- sub writeFile
- {
- my ($f, $ref) = @_;
- open WRT, ">:raw", $f or warn "$!";
- print WRT $$ref;
- close WRT;
- }
- sub read_slurp
- {
- my ($f, $ref) = @_;
- local $/ = undef;
- open READ,"<:raw:crlf", $f or warn "$!";
- $$ref = <READ>;
- close READ;
- }
- sub load
- {
- my ($f, $ref) = @_;
- open READ,"<:raw", $f or warn "$!";
- @$ref = <READ>;
- close READ;
- }
示例:复制代码
- -I, --include-style 在HTML文件中保留CSS样式表(不生成CSS文件)
- -k, --font=<font> 设置字体
- -K, --font-size=<num?> 设置字号
- -l, --line-numbers 带行号
- -m, --line-number-start=<cnt> 行号起始值
- -s, --style=<style> 指定字体
- -t, --replace-tabs=<num> 将 tab 替换为指定数量的空格
- -u, --encoding=<enc> 指定输入输出的编码类型
- --inline-css 将 css style 属性嵌入 <span> 标签,而不是独立列出
复制代码
- highlight -K2 -Sperl -OBBCode -ssourceforge ./temp.pl -o BBCode.txt
use IO::Handle; STDOUT->autoflush(1); my @order = func( 1 ); permute([qw/a b c d e f/], \@order); sub func { my $n = shift; my $div = 1; my @odo; while ( $n != 0 ) { $mod = $n % $div; $n = int($n/$div); unshift @odo, $mod; $div++; } return @odo; } sub permute { my ($ele, $ord) = @_; my $get; my @result; for my $idx ( @$ord ) { $get = splice( @$ele, $idx, 1 ); push @result, $get; } while ( @$ele ) { push @result, shift @$ele; } print @result; } |
#T1
abc
##T20
abc
##T21
def
###T3
abc
abc
#T1
test
##T2
abc
#T1
abc
复制代码
- [font=consolas][/font]
欢迎光临 批处理之家 (http://bathome.net./) | Powered by Discuz! 7.2 |