Skip to content

Perl 引用

什么是引用?

引用是指向数据结构的指针,允许你创建复杂的数据结构(如数组的数组、哈希的数组等)。

创建引用

标量引用

perl
my $scalar = 42;
my $scalar_ref = \$scalar;

print $scalar;        # 42
print $$scalar_ref;   # 42(解引用)
print ${$scalar_ref}; # 42

数组引用

perl
my @array = (1, 2, 3, 4, 5);
my $array_ref = \@array;

print @array;          # 12345
print @$array_ref;     # 12345(解引用)

# 访问元素
print $array[0];       # 1
print $array_ref->[0]; # 1(使用箭头运算符)
print ${$array_ref}[0]; # 1

哈希引用

perl
my %hash = (name => "Alice", age => 25);
my $hash_ref = \%hash;

print $hash{name};        # Alice
print $hash_ref->{name};  # Alice(使用箭头运算符)
print ${$hash_ref}{name}; # Alice

子程序引用

perl
sub greet {
    my ($name) = @_;
    print "Hello, $name!\n";
}

my $sub_ref = \&greet;
$sub_ref->("World");

匿名数据结构

匿名数组

perl
# 创建匿名数组
my $anon_array = [1, 2, 3, 4, 5];

# 访问元素
print $anon_array->[0];  # 1

# 遍历
foreach my $elem (@$anon_array) {
    print "$elem\n";
}

匿名哈希

perl
# 创建匿名哈希
my $anon_hash = {name => "Alice", age => 25, city => "New York"};

# 访问值
print $anon_hash->{name};  # Alice

# 遍历
while (my ($key, $value) = each %$anon_hash) {
    print "$key: $value\n";
}

匿名子程序

perl
my $anon_sub = sub {
    my ($name) = @_;
    return "Hello, $name!";
};

print $anon_sub->("World");  # Hello, World!

复杂数据结构

数组的数组(二维数组)

perl
# 创建二维数组
my @matrix = (
    [1, 2, 3],
    [4, 5, 6],
    [7, 8, 9]
);

# 访问元素
print $matrix[0][0];  # 1
print $matrix[1][2];  # 6

# 遍历
for my $row (@matrix) {
    for my $col (@$row) {
        print "$col ";
    }
    print "\n";
}

# 添加新行
push @matrix, [10, 11, 12];

哈希的数组

perl
# 哈希的数组
my @users = (
    {name => "Alice", age => 25, city => "New York"},
    {name => "Bob", age => 30, city => "London"},
    {name => "Charlie", age => 35, city => "Paris"}
);

# 访问
print $users[0]{name};  # Alice

# 遍历
foreach my $user (@users) {
    printf "%-10s: %d years old, %s\n",
           $user->{name}, $user->{age}, $user->{city};
}

数组的哈希

perl
# 数组的哈希
my %student_scores = (
    Alice => [90, 85, 92],
    Bob => [78, 92, 88],
    Charlie => [95, 89, 97]
);

# 访问
print $student_scores{Alice}[0];  # 90

# 计算平均分
foreach my $student (keys %student_scores) {
    my @scores = @{$student_scores{$student}};
    my $sum = 0;
    $sum += $_ for @scores;
    my $average = $sum / @scores;
    printf "%-10s: Average = %.1f\n", $student, $average;
}

哈希的哈希

perl
# 哈希的哈希
my %company = (
    CEO => {name => "John", age => 45, salary => 100000},
    CTO => {name => "Jane", age => 40, salary => 95000},
    CFO => {name => "Bob", age => 38, salary => 90000}
);

# 访问
print $company{CEO}{name};  # John

# 遍历
while (my ($position, $info) = each %company) {
    printf "%-3s: %-10s, %d years old, \$%d\n",
           $position, $info->{name}, $info->{age}, $info->{salary};
}

混合数据结构

perl
# 更复杂的结构
my $data = {
    users => [
        {name => "Alice", scores => [90, 85, 92]},
        {name => "Bob", scores => [78, 92, 88]}
    ],
    metadata => {
        created => "2024-01-01",
        version => 1.0
    }
};

# 访问
print $data->{users}[0]{name};           # Alice
print $data->{users}[0]{scores}[0];      # 90
print $data->{metadata}{created};         # 2024-01-01

# 遍历
foreach my $user (@{$data->{users}}) {
    print "$user->{name}: ";
    print join(", ", @{$user->{scores}});
    print "\n";
}

解引用

基本解引用

perl
my $array_ref = [1, 2, 3];
my @array = @$array_ref;  # 解引用为数组

my $hash_ref = {a => 1, b => 2};
my %hash = %$hash_ref;    # 解引用为哈希

选择性解引用

perl
my $array_ref = [1, 2, 3, 4, 5];

# 只解引用需要的部分
my $first = $array_ref->[0];
my $last = $array_ref->[-1];
my @first_three = @{$array_ref}[0, 1, 2];

my $hash_ref = {a => 1, b => 2, c => 3};
my @keys = keys %$hash_ref;
my @values = values %$hash_ref;

解引用表达式

perl
my $data = {
    items => [
        {id => 1, name => "Item 1"},
        {id => 2, name => "Item 2"}
    ]
};

# 访问嵌套数据
my $item_name = $data->{items}[0]{name};

闭包

基本闭包

perl
sub make_counter {
    my $count = 0;
    return sub {
        return ++$count;
    };
}

my $counter1 = make_counter();
my $counter2 = make_counter();

print $counter1->();  # 1
print $counter1->();  # 2
print $counter2->();  # 1
print $counter1->();  # 3

闭包捕获状态

perl
sub make_multiplier {
    my ($factor) = @_;
    return sub {
        my ($num) = @_;
        return $num * $factor;
    };
}

my $double = make_multiplier(2);
my $triple = make_multiplier(3);

print $double->(5);   # 10
print $triple->(5);   # 15

闭包作为回调

perl
sub process_list {
    my ($list, $callback) = @_;
    my @results;
    
    foreach my $item (@$list) {
        push @results, $callback->($item);
    }
    
    return \@results;
}

my @numbers = (1, 2, 3, 4, 5);
my $squared = process_list(\@numbers, sub { $_ * $_ });
print "@$squared\n";  # 1 4 9 16 25

实践示例

示例 1:学生管理系统

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

my @students = (
    {name => "Alice", age => 20, scores => [90, 85, 92, 88]},
    {name => "Bob", age => 21, scores => [78, 92, 85, 80]},
    {name => "Charlie", age => 22, scores => [95, 89, 97, 91]}
);

sub calculate_average {
    my ($scores_ref) = @_;
    my $sum = 0;
    $sum += $_ for @$scores_ref;
    return $sum / @$scores_ref;
}

sub find_highest_score {
    my ($scores_ref) = @_;
    my $max = $scores_ref->[0];
    $max = $_ if $_ > $max for @$scores_ref;
    return $max;
}

print "=== 学生成绩报告 ===\n";

foreach my $student (@students) {
    my $average = calculate_average($student->{scores});
    my $highest = find_highest_score($student->{scores});
    
    printf "%-10s (%2d岁): 平均分 %.1f, 最高分 %d\n",
           $student->{name},
           $student->{age},
           $average,
           $highest;
}

示例 2:购物车

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

my %products = (
    P001 => {name => "Laptop", price => 999.99},
    P002 => {name => "Mouse", price => 19.99},
    P003 => {name => "Keyboard", price => 49.99},
    P004 => {name => "Monitor", price => 299.99}
);

my @cart = (
    {product_id => "P001", quantity => 1},
    {product_id => "P002", quantity => 2},
    {product_id => "P004", quantity => 1}
);

sub calculate_total {
    my ($cart_ref, $products_ref) = @_;
    my $total = 0;
    
    foreach my $item (@$cart_ref) {
        my $product_id = $item->{product_id};
        my $quantity = $item->{quantity};
        my $price = $products_ref->{$product_id}{price};
        $total += $price * $quantity;
    }
    
    return $total;
}

sub print_receipt {
    my ($cart_ref, $products_ref) = @_;
    
    print "=== 购物小票 ===\n";
    print "-" x 30 . "\n";
    
    my $total = 0;
    
    foreach my $item (@$cart_ref) {
        my $product = $products_ref->{$item->{product_id}};
        my $subtotal = $product->{price} * $item->{quantity};
        $total += $subtotal;
        
        printf "%-15s x%2d: \$%8.2f\n",
               $product->{name},
               $item->{quantity},
               $subtotal;
    }
    
    print "-" x 30 . "\n";
    printf "总计: \$%8.2f\n", $total;
}

print_receipt(\@cart, \%products);

示例 3:配置管理

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

my $config = {
    database => {
        host => "localhost",
        port => 5432,
        name => "mydb",
        user => "admin",
        password => "secret"
    },
    server => {
        host => "0.0.0.0",
        port => 8080,
        workers => 4
    },
    logging => {
        level => "debug",
        file => "/var/log/app.log",
        max_size => "10MB"
    }
};

sub get_config {
    my ($config_ref, @keys) = @_;
    my $value = $config_ref;
    
    foreach my $key (@keys) {
        if (ref($value) eq 'HASH') {
            $value = $value->{$key};
        } else {
            return undef;
        }
    }
    
    return $value;
}

sub print_config {
    my ($config_ref) = @_;
    
    while (my ($section, $data) = each %$config_ref) {
        print "[$section]\n";
        
        if (ref($data) eq 'HASH') {
            while (my ($key, $value) = each %$data) {
                print "  $key = $value\n";
            }
        }
        
        print "\n";
    }
}

# 访问配置
my $db_host = get_config($config, qw(database host));
my $server_port = get_config($config, qw(server port));

print "数据库主机: $db_host\n";
print "服务器端口: $server_port\n";

print "\n=== 完整配置 ===\n";
print_config($config);

小结

本章节学习了 Perl 的引用:

  1. ✅ 创建引用(标量、数组、哈希、子程序)
  2. ✅ 匿名数据结构
  3. ✅ 复杂数据结构(二维数组、嵌套哈希等)
  4. ✅ 解引用
  5. ✅ 闭包

接下来,我们将学习 Perl 文件操作