[Perl]Markdown 标题按级别转论坛缩进 (BBCode)

There's more than one way to do it!
https://metacpan.org http://perlmonks.org
头像
523066680
Administrator
Administrator
帖子: 333
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 29 times
Been thanked: 22 times
联系:

[Perl]Markdown 标题按级别转论坛缩进 (BBCode)

帖子 #1 523066680 » 2017年05月11日 20:46

Code: [全选] [展开/收缩] [Download] (Untitled.pl)
  1. =info
  2.     Markdown Title 分级缩进,生成 BBCode
  3.     523066680@163.com / Code-By.Org
  4.     2017-05-12
  5. =cut
  6.  
  7. use Encode;
  8. use IO::Handle(1);
  9. STDOUT->autoflush(1);
  10.  
  11. my @arr;
  12. load("src.md", \@arr);
  13.  
  14. our @sizes = ( 100, 120, 140, 160, 180, 200 );
  15. reset_sizes( \@sizes, \@arr );   #根据实际层级重设列表
  16. format_title(\@arr);             #转论坛格式
  17.  
  18. my $all = join("\n", @arr);
  19. print encode('gbk', decode("utf8", $all));
  20.  
  21. sub format_title
  22. {
  23.     my $arr = shift;
  24.     my $prev;
  25.     my $curv;
  26.     my $crlf;
  27.  
  28.     for my $i ( 0 .. $#$arr )
  29.     {
  30.         $arr->[$i] =~s/(\r?\n)$//;
  31.         $crlf = $1;
  32.         if ( $arr->[$i]=~s/^(#+)// )
  33.         {
  34.             $curv = length($1);
  35.             $size = $sizes[$curv-1]; #下标从 0 开始
  36.             $arr->[$i] = "[size=$size][b]" .$arr->[$i] ."[/b][/size]";
  37.             $arr->[$i] .= "[list]";
  38.  
  39.             if ( $prev )
  40.             {
  41.                 if ( $curv <= $prev )
  42.                 {
  43.                     $arr->[$i] = "[/list]"x($prev - $curv + 1) .$arr->[$i];
  44.                 }
  45.                 elsif ( $curv > $prev ) { }
  46.             }
  47.  
  48.             $prev = $curv;
  49.         }
  50.  
  51.         # #遇到下一个标题时添加换行
  52.         # if ( $i < $#$arr
  53.         #     and $arr->[$i+1]=~/^\#/
  54.         #     and (not $arr->[$i] =~/^$/) )
  55.         # {
  56.         #     $arr->[$i] .= $crlf;
  57.         # }
  58.     }
  59.  
  60.     #缩进结束
  61.     $arr->[-1] .= '[/list]'x$prev if ( $prev > 0 );
  62. }
  63.  
  64. sub reset_sizes
  65. {
  66.     my ($sizes, $arr) = @_;
  67.     my $max = 0;
  68.     grep { /^(#+)/; $max = length($1) if (length($1) > $max) } @$arr;
  69.     @$sizes = reverse @{$sizes}[ 0 .. $max-1 ];
  70. }
  71.  
  72. sub load
  73. {
  74.     my ($f, $ref) = @_;
  75.     local $/=undef;
  76.     open READ,"<:", $f or warn "$!";
  77.     @$ref = <READ>;
  78.     close READ;
  79. }


原文:
Code: [全选] [展开/收缩] [Download] (Untitled.txt)
  1. #T1
  2. abc
  3. ##T20
  4. abc
  5. ##T21
  6. def
  7. ###T3
  8. abc
  9. abc
  10. #T1
  11. test
  12. ##T2
  13. abc
  14. #T1
  15. abc

生成:

Code: [全选] [展开/收缩] [Download] (Untitled.txt)
  1. [size=140][b]T1[/b][/size][list]
  2. abc
  3. [size=120][b]T20[/b][/size][list]
  4. abc
  5. [/list][size=120][b]T21[/b][/size][list]
  6. def
  7. [size=100][b]T3[/b][/size][list]
  8. abc
  9. abc
  10. [/list][/list][/list][size=140][b]T1[/b][/size][list]
  11. test
  12. [size=120][b]T2[/b][/size][list]
  13. abc
  14. [/list][/list][size=140][b]T1[/b][/size][list]
  15. abc[/list][Finished in 0.1s]


效果:
T1
    abc
    T20
      abc
    T21
      def
      T3
        abc
        abc
T1
    test
    T2
      abc
T1
    abc
[Finished in 0.1s]

回到 “Perl”

在线用户

用户浏览此论坛: 没有注册用户 和 1 访客