use utf8;
use Encode;
use IO::Handle;
STDOUT->autoflush(1);

my $file = encode('gbk', "Perl进阶-基础.md");
open my $fh, "<:utf8", $file or die "$!";

my %lang_fmt = (
    'perl' => 'pl',
    'python' => 'py',
    'c' => 'c',
    'cpp' => 'cpp',
    'ruby' => 'rb',
);

my @topics;
my $lang;
my $indent = 0;

while ( my $line = <$fh> )
{
    #代码块
    if ($line=~/\`{3}(\w+)$/)
    {
        $lang = lc($1);
        $line=~s/\`{3}(\w+)/\[code\]/;
        $line=~s/perl/bash/;
    }
    elsif ($line=~/\`{3}$/)   #inline code
    {
        $line=~s/\`{3}\r?\n$/\[\/code\]/;
    }
    elsif ($line=~/^\s*#[^#]/)    #一级标题 
    {
        $line=~s/^\s*#(.*)$/\[b\]\[size=5\]$1\[\/size\]\[\/b\]\n\[list\]\[list\]/;
        $line = "[/list]"x2 . "\n".$line if ($indent == 1);
        $line = "[/list]"x4 ."\n".$line if ($indent == 2);
        $indent = 1;
    }
    elsif ($line=~/^\s*##[^#]/)    #二级标题 
    {
        $line=~/^\s*##(.*)$/;
        $line=~s/^\s*##(.*)$/\[b\]$1\[\/b\]\n\[list\]\[list\]/;
        $line = "[/list]"x2 ."\n".$line if ($indent >= 2);
        $indent = 2;
    }
    elsif ($line=~/\*{2}[^*]/)    #粗体 (原文书写同一段文字最好不要断行)
    {
        $line=~s/\*{2}(.*)\*{2}/\[b\]$1\[\/b\]/;
    }
    elsif ($line=~/\*[^*]/)    #倾体 (原文书写同一段文字最好不要断行)
    {
        $line=~s/\*(.*)\*/\[i\]$1\[\/i\]/;
    }

    $line=~s/\s*`(.*)`\s*$/\[code\]$1\[\/code\]\n/;

    push @topics, $line;
}

my $all = join("", @topics);

$all =~s/(\r?\n)+$//;
if ( $all=~/\[list\]/ )
{
    $all .= '[/list]';
}

print encode('gbk', $all);

print "\n";

close $fh;
复制代码

",", sort，reverse，push, pop, shift, unshift, grep, map

使用 grep 过滤列表


grep 的使用可以分为表达式形式和 block 形式

筛选大于10的数并保存到另一个数组：

my @input_numbers = (1, 2, 4, 8, 16, 32, 64);
my @bigger_than_10 = grep $_ > 10, @input_numbers;
复制代码

结果为 16, 32, 64

通过隐式引用来筛选末尾含有4的数字：

my @end_in_4 = grep /4$/, @input_numbers;
复制代码

如果测试表达式较为复杂，可以写在一个子例程中，然后通过 grep 调用。
在一组数字中，提取个位十位... 相加 %2 余 1 的项：

my @odd_digit_sum = grep digit_sum_is_odd($_), @input_numbers;

sub digit_sum_is_odd {
    my $input = shift;
    my @digits = split //, $input; # Assume no nondigit characters
    my $sum;
    $sum += $_ for @digits;
    return $sum % 2;
}
复制代码

块形式（相比调用子例程的形式，少了 return。在这里使用 return 将退出 grep ）：

my @odd_digit_sum = grep {
    my $sum;
    $sum += $_ for split //;
    $sum % 2;
} @input_numbers;
复制代码


使用 map 转换列表


类似 grep ，但 map 用于转换而不是筛选

my @input_numbers = (1, 2, 4, 8, 16, 32, 64);
my @result = map $_ + 100, @input_numbers;
复制代码

以及 map 没有规定对于每一项只返回一个值

my @result = map { $_, 3 * $_ } @input_numbers;
复制代码

借此可以快速从一个列表生成一组哈希映射，以便于做字典判断

my %hash = map { $_, 1 } @castaways;

my $person = 'Gilligan';
    if( $hash{$person} ) {
    print "$person is a castaway.\n";
}
复制代码

捕获错误


示例：

my $average = $total / $count; # divide by zero?
print "okay\n" unless /$match/; # illegal pattern?

open MINNOW, '>', 'ship.txt'
    or die "Can't create 'ship.txt': $!"; # user?defined die?

implement($_) foreach @rescue_scheme; # die inside sub?
复制代码

其中每一行都有可能出错导致程序崩溃，但在实际应用中并不意味着应该结束整个程序，Perl 通过 eval 实现错误捕获：

eval { $average = $total / $count } ;
print "Continuing after error: $@" if $@;
复制代码

当 eval 代码块运行出错时，错误信息保存到 $@，eval 之后的代码继续运行。注意 eval 不是结构语句，末尾必须加分号。

eval 语句块也可以像函数一样 return，如果出错，返回空值（在标量环境返回 undef，在数组环境返回空列表）。现在可以安全地处理零除错误：

my $average = eval { $total / $count };
复制代码

$average 要么是"商"要么是"undef"。

注意
Perl 允许 eval 镶嵌使用。
eval 可以捕获一般的错误，但无法处理结束进程、内存溢出等情况

Try::Tiny

use Try::Tiny;
my $average = try { $total / $count } catch { "NaN" };
复制代码


执行动态生成的代码


eval 除了代码块的形式，还有一种字符串形式。在运行时编译运行某段字符串内的代码。这将带来一定风险，或许会执行带有攻击性的代码。
一个简短的示例：

    eval '$sum = 2 + 2';
    print "The sum is $sum\n";
复制代码

因为 eval 能够返回最后一句代码的结果，所以不必将赋值放在待执行的字符串中

foreach my $operator ( qw(+ ? * /) ) {
    my $result = eval "2 $operator 2";
    print "2 $operator 2 is $result\n";
}
复制代码

和代码块形式一样，如果执行错误，有关信息将保留到 $@：

print 'The quotient is ', eval '5 /', "\n";
warn $@ if $@;
复制代码

>The quotient is
>syntax error at (eval 1) line 2, at EOF

提醒
请谨慎使用 eval 执行字符串代码的形式，尽可能使用其他方法达到目的。在11章将介绍如何加载外部文件代码并执行，并使用更好的方法。

do 是 Perl 语言中一个强有力但容易被忽视的工具，用于将多个表达式组织到一个代码块中，
并像子例程一样返回最后执行的结果。

使用 do 语句块简化赋值判断


假设要为 $bowler 赋值，但是分为三种条件，需要写出多个 $bowler：

my $bowler;
if( ...some condition... ) {
    $bowler = 'Mary Ann';
}
elsif( ... some condition ... ) {
    $bowler = 'Ginger';
}
else {
    $bowler = 'The Professor';
}
复制代码

如果改为 do 语句块的形式，只需要一个 $bowler

my $bowler = do {
    if( ... some condition ... )     { 'Mary Ann' }
    elsif( ... some condition ... )  { 'Ginger' }
    else                             { 'The Professor' }
};
复制代码


一次读取文件


do 能够创建一个包围作用域，当我们要一次读取整个文件内容到变量中，可以通过 do block 私有作用域，为 $/ 和 @ARGV 创建私有副本，从而能够使用 <> 句柄读取 $filename 参数的文件内容

$filename = __FILE__;

my $file_contents = do {
    local $/;
    local @ARGV = ( $filename );
    <>;
};

print $file_contents;
复制代码


加载运行其他脚本代码


类似 eval，do 也有将字符串作为参数的形式，当传递的是字符串而非代码块时，do 假设传入的是文件，并从文件中读取代码编译执行：

do "slurp.pl";
复制代码

类似于 `eval "type slurp.pl";` 区别参考 perldoc -f do
缺点在于：即使执行的代码发生错误，程序仍会继续运行。并且即使是加载运行过的文件，仍会再次执行（对比 require）。基于这些原因，很少人使用 do 语句

我们知道，使用 use 加载模块，以及 use 语句在编译时运行。其实还可以通过 require 在运行时加载模块：

require List::Util;
复制代码

use List::Util 的实质是在 BEGIN 块中执行 require 以及 该模块的 import() 方法;

BEGIN {
    require List::Util;
    List::Util->import( ... );
}
复制代码

通常 use 使用模块名的形式，而 require 还可以用文件名作为参数，导入文件：

require $filename;
复制代码

require 能够记住已经加载过的文件，对于重复的加载将不会再执行 ( 对比 do )。更多内容参考 12 章 - Creating Your Own Perl Distribution

[Finished in 0.1s]

---

作者: PerlMonk    时间: 2017-4-18 20:20

本帖最后由 PerlMonk 于 2017-4-18 21:57 编辑

管理复杂数据结构


使用调试器查看数据结构


参考 PerlDebug

示例代码：


my %total_bytes;
while (<DATA>) {
    my ($source, $destination, $bytes) = split;
    $total_bytes{$source}{$destination} += $bytes;
}

for my $source (sort keys %total_bytes) {
    for my $destination (sort keys %{ $total_bytes{$source} }) {
        print "$source => $destination:",
        " $total_bytes{$source}{$destination} bytes\n";
    }
    print "\n";
}

__DATA__
professor.hut gilligan.crew.hut 1250
professor.hut lovey.howell.hut 910
thurston.howell.hut lovey.howell.hut 1250
professor.hut lovey.howell.hut 450
ginger.girl.hut professor.hut 1218
ginger.girl.hut maryann.girl.hut 199
复制代码


操作示例：



perl -d bytecounts.pl Loading DB routines from perl5db.pl version 1.37 Editor support available. Enter h or 'h h' for help, or 'perldoc perldebug' for more help. main::(bytecounts.pl:1):        my %total_bytes;    DB<1> s main::(bytecounts.pl:2):        while (<DATA>) {    DB<1> s main::(bytecounts.pl:3):            my ($source, $destination, $bytes) = split;    DB<1> s main::(bytecounts.pl:4):            $total_bytes{$source}{$destination} += $bytes;    DB<1> x $source, $destination, $bytes 0  'professor.hut' 1  'gilligan.crew.hut' 2  1250


在 perlDB 控制台中输入 s 执行下一句，x 后附加变量名显示对应变量的状态
也可以直接输入代码，查看数组：`x @array`， 查看哈希字典：`x \%hash`



DB<8> @a = (1 .. 3);    DB<9> x @a 0  1 1  2 2  3




DB<10> %h = qw/a 1 b 2 c 3/;    DB<12> x \%h 0  HASH(0x2ac9e2c)     'a' => 1     'b' => 2     'c' => 3


也可以在 x 后面使用列表、哈希操作符（sort, keys, values ... ）



DB<31> %h = qw(a b c d e f);    DB<34> x sort keys %h 0  'a' 1  'c' 2  'e'


一些总结

s [函数名] 进入函数并逐步运行，提示符从 `DB<>` 变为 `DB<<>>`
n [函数名] 执行函数，并且一次执行完。
b [line|event|sub] 添加断点。
B [line|*] 删除断点
w [expr] 监视变量，受监视的变量在变化时将显示到终端，`w $var`
W [expr|*] 删除变量监视器
p 同 print
S [[!]pat] 枚举当前加载的所有子例程名单，可以设置过滤、排除，例：



DB<24> S main   main::BEGIN   main::dumpValue   main::dumpvar   main::test


y 查看当前脚本的变量列表和对应的值
c [n] 连续执行代码直到某一行，如果不带参数，会结束当前循环或者脚本。
a [ln]+[cmd] 在某行之前执行命令，例 `a 8 print "$var\n"` ，实测有时候没有效果，最好先为该行设置断点
A [ln|*] 删除命令



使用 Data::Dumper 打印/导出复杂数据结构





use Data::Dumper;
print Dumper(\%total_bytes);
复制代码




$VAR1 = {            'thurston.howell.hut' => {                                       'lovey.howell.hut' => 1250                                     },            'ginger.girl.hut' => {                                   'maryann.girl.hut' => 199,                                   'professor.hut' => 1218                                 },            'professor.hut' => {                                 'gilligan.crew.hut' => 1250,                                 'lovey.howell.hut' => 1360                               }          };


来看另一段代码，@data1 , @data2 互相包含对方的引用，Data::Dumper 能够正确打印他们的结构 注意这里给 Dumper 传入两个数组引用：



use Data::Dumper;
$Data::Dumper::Purity = 1; # 声明打印的数据可能出现自引用的情况
my @data1 = qw(one won);
my @data2 = qw(two too to);
push @data2, \@data1;
push @data1, \@data2;
print Dumper(\@data1, \@data2);
复制代码




$VAR1 = [            'one',            'won',            [              'two',              'too',              'to',              []            ]          ]; $VAR1->[2][3] = $VAR1; $VAR2 = $VAR1->[2];


如果使用 Perl Debugger



DB<2> x \@data1, \@data2 0  ARRAY(0x24a4e84)     0  'one'     1  'won'     2  ARRAY(0x47f324)        0  'two'        1  'too'        2  'to'        3  ARRAY(0x24a4e84)           -> REUSED_ADDRESS 1  ARRAY(0x47f324)     -> REUSED_ADDRESS


Data::Dump
如果不介意数据的建，可以考虑使用 Data::Dump，输出相对简洁：


use Data::Dump qw(dump);
dump( \%total_bytes );
复制代码




{    "ginger.girl.hut"     => { "maryann.girl.hut" => 199, "professor.hut" => > 1218 },    "professor.hut"       => { "gilligan.crew.hut" => 1250, "lovey.howell.hut" > => 1360 },    "thurston.howell.hut" => { "lovey.howell.hut" => 1250 }, }


Data::Printer
这个模块在 ActivePerl V5.16 ppm 安装失败，但是可以从CPAN下载安装，同时需要安装 Sort::Naturally, Clone::PP



use Data::Printer;
p( %total_bytes );
复制代码




{      ginger.girl.hut       {          maryann.girl.hut   199,          professor.hut      1218      },      professor.hut         {          gilligan.crew.hut   1250,          lovey.howell.hut    1360      },      thurston.howell.hut   {          lovey.howell.hut   1250      } }





使用 Storeable 模块存储复杂数据结构




YAML




JSON




对数据的间接操作，通过  grep 和 map


[Finished in 0.1s]





---

欢迎光临 批处理之家 (http://www.bathome.net/)

Powered by Discuz! 7.2