Perl语言演进史：从文本处理工具到系统管理利器

# Perl 1.0 风格代码示例
while (<>) {
    chop;  # 移除行尾换行符 (后来改为 chomp)
    print $_ if /pattern/;  # 默认变量 $_ 和正则匹配
}

# 数组引用
my @array = (1, 2, 3);
my $ref = \@array;
print $ref->[0];  # 访问: 1

# 哈希引用
my %hash = (name => 'Perl', year => 1994);
my $href = \%hash;
print $href->{name};  # 访问: Perl

# 嵌套数据结构
my $data = {
    users => [
        {name => 'Alice', age => 30},
        {name => 'Bob', age => 25}
    ]
};

package Animal;

sub new {
    my ($class, %args) = @_;
    return bless \%args, $class;
}

sub speak {
    my $self = shift;
    print "I am ", $self->{name}, "\n";
}

1;  # 模块必须以真值结尾

# 非贪婪匹配
$_ = "<tag>content</tag>";
/>(.*?)</;  # 匹配 "content"

# 多行模式、扩展正则
if (m{\b\w+@\w+\.\w+}x) {
    print "Found email\n";
}

# 安装模块 - 这种方式至今未变
cpan install DBI
cpan install LWP::UserAgent

use utf8;
my $utf8_text = "你好，世界";  # 源代码使用 UTF-8
use open ':std', ':encoding(UTF-8)';  # 标准流使用 UTF-8

use feature 'say';  # 自动换行的 print
say "Hello, World";  # 等同于 print "Hello, World\n";

use feature 'state';  # C 风格的静态变量
sub counter {
    state $count = 0;
    return ++$count;
}

# 智能匹配 (后来有所调整)
if ($x ~~ @array) {  # $x 是否在 @array 中？
    say "Found!";
}

# 5.22: 位操作符更严格
use feature 'bitwise';  # 明确区分数值和字符串位操作

# 5.26: 移除当前目录 . 从 @INC
# 这是为了防止目录遍历攻击

# 5.30: 更安全的 eval
# 限制 eval 的某些危险用法

# Perl 5.38+ 实验性 class 关键字
use feature 'class';
use strict;
use warnings;

class Point {
    field $x :param;  # 构造函数参数
    field $y :param = 0;  # 带默认值
    
    method move($dx, $dy) {
        $x += $dx;
        $y += $dy;
    }
    
    method describe {
        return "Point($x, $y)";
    }
}

my $p = Point->new(x => 10);
$p->move(5, 3);
say $p->describe;  # Point(15, 3)

# 5.36+: 稳定的函数签名
use feature 'signatures';

sub greet($name, $greeting = "Hello") {
    say "$greeting, $name!";
}

greet("Alice");        # Hello, Alice!
greet("Bob", "Hi");    # Hi, Bob!

# 5.36+: try/catch/finally
use feature 'try';

try {
    risky_operation();
}
catch ($e) {
    warn "Error: $e";
}
finally {
    cleanup();
}

# my - 词法作用域（推荐）
my $lexical = "I am private";
{
    my $lexical = "Inner scope";
    say $lexical;  # Inner scope
}
say $lexical;  # I am private

# our - 包全局变量
our $global = "I am shared";
{
    our $global = "Modified";
    say $global;  # Modified
}
say $global;  # Modified

# local - 临时改变全局变量值
our $OLD = "original";
say $OLD;  # original
{
    local $OLD = "temporary";
    say $OLD;  # temporary
}
say $OLD;  # original (恢复)

# grep - 列表过滤
my @numbers = 1..100;
my @odd = grep { $_ % 2 } @numbers;  # 筛选奇数
my @large = grep { $_ > 50 } @numbers;

# 标量上下文获取计数
my $count = grep { /perl/i } @files;

# map - 列表转换
my @squares = map { $_ * $_ } @numbers;
my @formatted = map { sprintf("%04d", $_) } @numbers;

# 嵌套使用
my @result = grep { $_ > 0 } map { $_ - 50 } @numbers;

# sort - 灵活排序
my @sorted = sort @strings;  # 默认 ASCII 排序
my @num_sorted = sort { $a <=> $b } @numbers;  # 数值升序
my @desc = sort { $b <=> $a } @numbers;  # 数值降序
my @by_length = sort { length($a) <=> length($b) } @strings;

# 基础匹配
$text =~ /pattern/;        # 匹配
$text =~ s/old/new/;      # 替换
$text =~ tr/a-z/A-Z/;     # 转换

# 获取所有匹配
my @words = /(\w+)/g;  # 全局匹配，返回列表

# 位置相关
/\G.../g;  # 从上一次匹配结束位置继续
pos($text);  # 获取/设置匹配位置

# 命名捕获 (5.10+)
/(?<name>\w+)/;
say $+{name};  # 访问捕获组

# 递归正则 (5.10+)
$regex = qr{(??{ $regex })};  # 匹配嵌套结构

# 数组引用
my $array_ref = [1, 2, 3];  # 匿名数组
my $copy = \@existing_array;  # 引用现有数组

# 哈希引用
my $hash_ref = { key => 'value' };  # 匿名哈希

# 嵌套结构
my $data = {
    users => [
        {id => 1, name => 'Alice'},
        {id => 2, name => 'Bob'}
    ],
    metadata => {
        total => 2,
        page => 1
    }
};

# 访问嵌套数据
say $data->{users}[0]{name};  # Alice

# 三参数 open (推荐)
open my $fh, '<', 'input.txt' or die "Cannot open: $!";

# 逐行读取
while (my $line = <$fh>) {
    chomp $line;  # 移除行尾换行
    process($line);
}
close $fh;

# 一次性读取
open my $fh, '<', 'file.txt' or die $!;
my @lines = <$fh>;
close $fh;

# 钻石操作符 - 处理所有输入
while (<>) {
    chomp;
    print ucfirst, "\n";
}

# 常用参数说明
# -e  执行代码
# -n  逐行读取（不自动打印）
# -p  逐行读取（自动打印）
# -i  原地编辑
# -l  自动处理换行
# -a  自动分割到 @F
# -F  指定分隔符

# 删除空行
perl -ne 'print unless /^$/' file.txt

# 全局替换（原地编辑）
perl -pi -e 's/old/new/g' file.txt

# 提取第一列（类似 awk）
perl -lane 'print $F[0]' data.csv

# 添加行号
perl -ne 'print "$.: $_"' file.txt

# 计算列总和
perl -lane '$sum += $F[0]; END { print $sum }' numbers.txt

# 查找重复行
perl -ne 'print if $a{$_}++' file.txt

# 唯一行
perl -ne 'print unless $a{$_}++' file.txt

package Animal;
use strict;
use warnings;

sub new {
    my ($class, %args) = @_;
    my $self = bless { %args }, $class;
    return $self;
}

sub name {
    my ($self, $new_name) = @_;
    $self->{name} = $new_name if defined $new_name;
    return $self->{name};
}

sub speak {
    my $self = shift;
    print $self->name, " makes a sound\n";
}

1;

package Point;
use Moose;  # 或 Mouse（更轻量）

has 'x' => (is => 'rw', isa => 'Num', default => 0);
has 'y' => (is => 'rw', isa => 'Num', default => 0);

method move($dx, $dy) {
    $self->x($self->x + $dx);
    $self->y($self->y + $dy);
}

__PACKAGE__->meta->make_immutable;

use v5.38;
use feature 'class';

class Point3D :isa(Point) {
    field $z :param = 0;
    
    method move($dx, $dy, $dz = 0) {
        $self->SUPER::move($dx, $dy);
        $z += $dz;
    }
    
    method describe {
        return "Point3D(" . $self->x . ", " . $self->y . ", $z)";
    }
}

#!/usr/bin/perl
use strict;
use warnings;

# 监控系统负载
open my $fh, '<', '/proc/loadavg' or die $!;
my $load = <$fh>;
close $fh;

my ($avg1, $avg5, $avg15) = split ' ', $load;

if ($avg1 > 4.0) {
    system("mail -s 'High load: $avg1' admin@example.com < /dev/null");
}

# 批量处理文件
foreach my $file (glob '*.log') {
    my $new_name = $file;
    $new_name =~ s/\.log$/.txt/;
    rename $file, $new_name or warn "Failed to rename $file: $!";
}

# 日志分析
use strict;
use warnings;

my %status_codes;

while (<>) {
    if (m{HTTP/1\.[01]" (\d{3})}) {
        $status_codes{$1}++;
    }
}

foreach my $code (sort keys %status_codes) {
    printf "%s: %d\n", $code, $status_codes{$code};
}

# CSV 处理
use Text::CSV;

my $csv = Text::CSV->new({ binary => 1, auto_diag => 1 });
open my $fh, '<:encoding(utf8)', 'data.csv' or die $!;

while (my $row = $csv->getline($fh)) {
    my ($name, $email, $age) = @$row;
    process_record($name, $email, $age);
}
close $fh;

# 使用 LWP 进行 HTTP 请求
use LWP::UserAgent;

my $ua = LWP::UserAgent->new(timeout => 10);
my $response = $ua->get('https://api.example.com/data');

if ($response->is_success) {
    my $data = decode_json($response->decoded_content);
    process_api_response($data);
}

# 简单的 Web 服务 (Mojolicious)
use Mojolicious::Lite;

get '/' => sub {
    my $c = shift;
    $c->render(text => 'Hello, World!');
};

get '/user/:name' => sub {
    my $c = shift;
    my $name = $c->param('name');
    $c->render(json => { name => $name, status => 'active' });
};

app->start;

use DBI;

my $dbh = DBI->connect(
    "dbi:SQLite:dbname=mydb.sqlite",
    "", "",
    { RaiseError => 1, AutoCommit => 1 }
);

# 查询
my $sth = $dbh->prepare("SELECT * FROM users WHERE age > ?");
$sth->execute(18);

while (my $row = $sth->fetchrow_hashref) {
    say "$row->{name}: $row->{email}";
}

# 插入
$dbh->do("INSERT INTO users (name, email) VALUES (?, ?)", 
         undef, "Alice", "alice@example.com");

$dbh->disconnect;

# 现代 Perl 代码示例
use v5.40;  # 使用最新特性
use strict;
use warnings;
use feature 'class';

class Application {
    use Path::Tiny;
    use JSON::PP;
    
    field $config_path :param;
    field $config = undef;
    
    method load_config {
        my $content = path($config_path)->slurp_utf8;
        $config = decode_json($content);
        return $self;
    }
    
    method run {
        try {
            $self->load_config;
            say "Config loaded: ", $config->{name};
        }
        catch ($e) {
            die "Failed to start: $e";
        }
    }
}

my $app = Application->new(config_path => 'config.json');
$app->run;