#Perl Quote

What is a quote?

References are pointers to data structures, allowing you to create complex data structures (such as arrays of arrays, arrays of hashes, etc.).

Create reference

Scalar reference

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

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

Array reference

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

Hash reference

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

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

Subroutine reference

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

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

Anonymous data structure

Anonymous array

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

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

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

Anonymous Hash

# 创建匿名哈希
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";
}

Anonymous subroutine

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

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

Complex data structure

Array of arrays (two-dimensional array)

# 创建二维数组
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];

Array of hash

# 哈希的数组
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};
}

Hash of array

# 数组的哈希
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;
}

Hash of hashes

# 哈希的哈希
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};
}

Mixed data structures

# 更复杂的结构
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";
}

Dereference

Basic dereferencing

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

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

Selective dereferencing

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;

Dereference expression

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

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

Closure

Basic closure

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

Closure capture status

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

Closure as callback

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

Practical example

Example 1: Student Management System

#!/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;
}

Example 2: Shopping cart

#!/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);

Example 3: Configuration Management

#!/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);

Summary

In this chapter, we learned about Perl citations:

  1. ✅ Create references (scalar, array, hash, subroutine)
  2. ✅ Anonymous data structure
  3. ✅ Complex data structures (two-dimensional arrays, nested hashes, etc.)
  4. ✅ Dereference
  5. ✅ Closure

Next, we'll learn about Perl file operations.