Perl 包和模块

包（Package）

基本包

package MyUtils;
use strict;
use warnings;

sub add {
    my ($a, $b) = @_;
    return $a + $b;
}

sub multiply {
    my ($a, $b) = @_;
    return $a * $b;
}

1;  # 包必须返回真值

# 使用
package main;
use MyUtils;

print MyUtils::add(10, 20) . "\n";  # 30
print MyUtils::multiply(5, 3) . "\n";  # 15

导出符号

package MyUtils;
use strict;
use warnings;
use Exporter qw(import);

our @EXPORT = qw(add subtract);  # 默认导出
our @EXPORT_OK = qw(multiply divide);  # 可选导出

sub add {
    my ($a, $b) = @_;
    return $a + $b;
}

sub subtract {
    my ($a, $b) = @_;
    return $a - $b;
}

sub multiply {
    my ($a, $b) = @_;
    return $a * $b;
}

sub divide {
    my ($a, $b) = @_;
    return $a / $b;
}

1;

# 使用
package main;
use MyUtils;  # 导出 add 和 subtract
use MyUtils qw(multiply);  # 导出 multiply

print add(10, 20) . "\n";
print multiply(5, 3) . "\n";
print MyUtils::divide(10, 2) . "\n";

模块（Module）

模块结构

模块是存储在 .pm 文件中的包：

MyModule/
  ├── MyModule.pm
  └── lib/
      └── SubModule.pm

创建模块

# MyMath.pm
package MyMath;
use strict;
use warnings;
our $VERSION = '1.00';

sub sum {
    my @numbers = @_;
    my $total = 0;
    $total += $_ for @numbers;
    return $total;
}

sub average {
    my @numbers = @_;
    return sum(@numbers) / @numbers;
}

1;

# 使用
use MyMath;
my @nums = (1, 2, 3, 4, 5);
print MyMath::sum(@nums) . "\n";
print MyMath::average(@nums) . "\n";

CPAN 模块

安装 CPAN 模块

# 使用 cpanm（推荐）
cpanm Module::Name

# 使用 cpan
perl -MCPAN -e 'install Module::Name'

# 使用 CPANminus
cpanminus Module::Name

常用 CPAN 模块

# JSON 处理
use JSON;
my $data = { name => "Alice", age => 25 };
my $json = encode_json($data);
print $json . "\n";

# 数据库
use DBI;
my $dbh = DBI->connect("DBI:mysql:database=test", "user", "pass");

# HTTP 请求
use LWP::UserAgent;
my $ua = LWP::UserAgent->new();
my $response = $ua->get("http://example.com");

# 日期时间
use DateTime;
my $dt = DateTime->now();
print $dt->ymd() . "\n";

模块管理工具

cpanm

# 安装模块
cpanm JSON::XS

# 安装特定版本
cpanm JSON::XS@4.0

# 列出已安装的模块
cpanm -l

# 卸载模块
cpanm --uninstall JSON::XS

cpan

# 启动 CPAN shell
perl -MCPAN -e shell

# 在 CPAN shell 中
install JSON::XS
upgrade all

命名空间

包命名约定

# 好的命名
package MyApp::User;
package MyApp::Database::Connection;
package MyApp::Utils::String;

# 避免的命名
package User;  # 太通用
package db;    # 太短

使用命名空间

package MyApp::User;

sub new {
    my $class = shift;
    bless { name => shift }, $class;
}

package main;

use MyApp::User;
my $user = MyApp::User->new("Alice");

版本控制

版本号

package MyModule;
use strict;
use warnings;

our $VERSION = '1.00';  # 传统版本
our $VERSION = v1.2.3;  # v-string 版本

# 使用 VERSION 宏
use version; our $VERSION = qv('1.2.3');

1;

# 使用版本
use MyModule 1.00;
use MyModule v1.2.3;

版本检查

package MyModule;
use strict;
use warnings;

our $VERSION = '1.00';

sub import {
    my ($class, $version) = @_;
    if (defined $version && $version > $VERSION) {
        die "Need MyModule version $version, have $VERSION\n";
    }
}

1;

文档

POD（Plain Old Documentation）

package MyModule;
use strict;
use warnings;

our $VERSION = '1.00';

=head1 NAME

MyModule - A sample module for demonstration

=head1 SYNOPSIS

    use MyModule;

    my $result = MyModule::add(10, 20);
    print "$result\n";

=head1 DESCRIPTION

This module provides basic mathematical operations.

=head1 FUNCTIONS

=head2 add($a, $b)

Adds two numbers and returns the result.

=cut

sub add {
    my ($a, $b) = @_;
    return $a + $b;
}

=head1 AUTHOR

Your Name <you@example.com>

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;

生成文档

# 转换为文本
perldoc MyModule.pm

# 转换为 HTML
pod2html MyModule.pm > MyModule.html

# 转换为手册页
pod2man MyModule.pm > MyModule.1

实践示例

示例 1：配置模块

# MyApp/Config.pm
package MyApp::Config;
use strict;
use warnings;
use Exporter qw(import);

our @EXPORT = qw(get_config set_config);

my %config = (
    database => {
        host => "localhost",
        port => 5432,
        name => "mydb"
    },
    debug => 1,
    log_level => "INFO"
);

sub get_config {
    my ($key) = @_;
    
    if (wantarray) {
        return exists $config{$key} ? @{$config{$key}} : ();
    } else {
        return $config{$key};
    }
}

sub set_config {
    my ($key, $value) = @_;
    $config{$key} = $value;
}

1;

# 使用
use MyApp::Config;

my $db_config = get_config('database');
print "Host: $db_config->{host}\n";

set_config('debug', 0);
print "Debug: " . get_config('debug') . "\n";

示例 2：日志模块

# MyApp/Logger.pm
package MyApp::Logger;
use strict;
use warnings;
use Exporter qw(import);
use Time::HiRes qw(time);
use POSIX qw(strftime);

our @EXPORT = qw(logger log_debug log_info log_warn log_error);

my $log_level = "INFO";
my %levels = (
    DEBUG => 1,
    INFO => 2,
    WARN => 3,
    ERROR => 4
);

sub set_level {
    my ($level) = @_;
    $log_level = $level;
}

sub _should_log {
    my ($level) = @_;
    return $levels{$level} >= $levels{$log_level};
}

sub _format_message {
    my ($level, $message) = @_;
    my $timestamp = strftime("%Y-%m-%d %H:%M:%S", localtime);
    return "[$timestamp] [$level] $message\n";
}

sub logger {
    my ($level, $message) = @_;
    
    if (_should_log($level)) {
        print _format_message($level, $message);
    }
}

sub log_debug { logger('DEBUG', @_); }
sub log_info { logger('INFO', @_); }
sub log_warn { logger('WARN', @_); }
sub log_error { logger('ERROR', @_); }

1;

# 使用
use MyApp::Logger;

log_debug("This is debug message");
log_info("Application started");
log_warn("Low disk space");
log_error("Connection failed");

示例 3：数据库助手模块

# MyApp/DBHelper.pm
package MyApp::DBHelper;
use strict;
use warnings;
use DBI;

sub new {
    my ($class, $config) = @_;
    my $self = {
        dbh => DBI->connect(
            "DBI:mysql:database=$config->{database};host=$config->{host}",
            $config->{username},
            $config->{password},
            { RaiseError => 1, AutoCommit => 0 }
        )
    };
    bless $self, $class;
    return $self;
}

sub execute {
    my ($self, $sql, @params) = @_;
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute(@params);
    return $sth;
}

sub select_all {
    my ($self, $sql, @params) = @_;
    my $sth = $self->execute($sql, @params);
    return $sth->fetchall_arrayref({});
}

sub select_one {
    my ($self, $sql, @params) = @_;
    return $self->{dbh}->selectrow_hashref($sql, undef, @params);
}

sub commit {
    my ($self) = @_;
    $self->{dbh}->commit();
}

sub rollback {
    my ($self) = @_;
    $self->{dbh}->rollback();
}

sub disconnect {
    my ($self) = @_;
    $self->{dbh}->disconnect();
}

1;

# 使用
use MyApp::DBHelper;

my $db = MyApp::DBHelper->new({
    database => "test",
    host => "localhost",
    username => "user",
    password => "pass"
});

eval {
    my $users = $db->select_all("SELECT * FROM users");
    
    foreach my $user (@$users) {
        print "$user->{name}\n";
    }
    
    $db->commit();
};

if ($@) {
    $db->rollback();
    die "Database error: $@";
}

$db->disconnect();

小结

本章节学习了 Perl 的包和模块：

1. ✅ 包（Package）基础
2. ✅ 模块（Module）结构
3. ✅ CPAN 模块
4. ✅ 模块管理工具
5. ✅ 命名空间
6. ✅ 版本控制
7. ✅ 文档（POD）
8. ✅ 实践示例

接下来，我们将学习 Perl 进程管理。