— 检查PL/Perl扩展是否安装
SELECT name FROM pg_extension WHERE name = ‘plperl’;

— 输出结果
name
——-
plperl
(1 row)

— 如果未安装，执行以下命令
— CREATE EXTENSION plperl;

— 创建简单的PL/Perl函数
CREATE OR REPLACE FUNCTION fgedu_perl_hello(name TEXT)
RETURNS TEXT
AS $$
my ($name) = @_;
return “Hello, $name!”;
$$ LANGUAGE plperl;

— 输出结果
CREATE FUNCTION

— 测试PL/Perl函数
SELECT fgedu_perl_hello(‘World’);

— 输出结果
fgedu_perl_hello
——————
Hello, World!
(1 row)

— 创建带参数的PL/Perl函数
CREATE OR REPLACE FUNCTION fgedu_perl_calculate(a INTEGER, b INTEGER, operation TEXT)
RETURNS INTEGER
AS $$
my ($a, $b, $operation) = @_;

if ($operation eq ‘add’) {
return $a + $b;
} elsif ($operation eq ‘subtract’) {
return $a – $b;
} elsif ($operation eq ‘multiply’) {
return $a * $b;
} elsif ($operation eq ‘divide’) {
if ($b == 0) {
die “Division by zero”;
}
return $a / $b;
} else {
die “Invalid operation”;
}
$$ LANGUAGE plperl;

— 输出结果
CREATE FUNCTION

— 测试PL/Perl计算函数
SELECT fgedu_perl_calculate(10, 5, ‘add’) AS add;

— 输出结果
add
—–
15
(1 row)

SELECT fgedu_perl_calculate(10, 5, ‘subtract’) AS subtract;

— 输出结果
subtract
———-
5
(1 row)

SELECT fgedu_perl_calculate(10, 5, ‘multiply’) AS multiply;

— 输出结果
multiply
———-
50
(1 row)

SELECT fgedu_perl_calculate(10, 5, ‘divide’) AS divide;

— 输出结果
divide
——–
2
(1 row)

— 测试错误处理
SELECT fgedu_perl_calculate(10, 0, ‘divide’);

— 输出结果
ERROR: Division by zero

— 创建测试表
CREATE TABLE fgedu_students (
id SERIAL PRIMARY KEY,
name VARCHAR(100) NOT NULL,
score INTEGER NOT NULL,
grade VARCHAR(10),
created_at TIMESTAMP DEFAULT NOW()
);

— 输出结果
CREATE TABLE

— 插入测试数据
INSERT INTO fgedu_students(name, score)
VALUES
(‘张三’, 85),
(‘李四’, 92),
(‘王五’, 78),
(‘赵六’, 95);

— 输出结果
INSERT 0 4

— 创建PL/Perl存储过程
CREATE OR REPLACE PROCEDURE fgedu_perl_calculate_grade()
AS $$
my $rv = spi_exec_query(“SELECT id, score FROM fgedu_students WHERE grade IS NULL”);
my $nrows = $rv->{processed};

for my $i (0 .. $nrows – 1) {
my $row = $rv->{rows}->[$i];
my $id = $row->{id};
my $score = $row->{score};
my $grade;

if ($score >= 90) {
$grade = ‘A’;
} elsif ($score >= 80) {
$grade = ‘B’;
} elsif ($score >= 70) {
$grade = ‘C’;
} elsif ($score >= 60) {
$grade = ‘D’;
} else {
$grade = ‘F’;
}

spi_exec_query(“UPDATE fgedu_students SET grade = ‘$grade’ WHERE id = $id”);
}

return “Processed $nrows students”;
$$ LANGUAGE plperl;

— 输出结果
CREATE PROCEDURE

— 测试PL/Perl存储过程
CALL fgedu_perl_calculate_grade();

— 输出结果
fgedu_perl_calculate_grade
———————————-
Processed 4 students
(1 row)

— 查看更新后的数据
SELECT id, name, score, grade FROM fgedu_students;

— 输出结果
id | name | score | grade
—-+——+——-+——-
1 | 张三 | 85 | B
2 | 李四 | 92 | A
3 | 王五 | 78 | C
4 | 赵六 | 95 | A
(4 rows)

— 创建带参数的PL/Perl存储过程
CREATE OR REPLACE PROCEDURE fgedu_perl_add_student(name VARCHAR, score INTEGER)
AS $$
my ($name, $score) = @_;

if ($score < 0 || $score > 100) {
die “Score must be between 0 and 100”;
}

my $grade;
if ($score >= 90) {
$grade = ‘A’;
} elsif ($score >= 80) {
$grade = ‘B’;
} elsif ($score >= 70) {
$grade = ‘C’;
} elsif ($score >= 60) {
$grade = ‘D’;
} else {
$grade = ‘F’;
}

spi_exec_query(“INSERT INTO fgedu_students(name, score, grade) VALUES (‘$name’, $score, ‘$grade’)”);

return “Added student $name with score $score and grade $grade”;
$$ LANGUAGE plperl;

— 输出结果
CREATE PROCEDURE

— 测试PL/Perl存储过程
CALL fgedu_perl_add_student(‘孙七’, 88);

— 输出结果
fgedu_perl_add_student
—————————————
Added student 孙七 with score 88 and grade B
(1 row)

— 测试错误处理
CALL fgedu_perl_add_student(‘周八’, 105);

— 输出结果
ERROR: Score must be between 0 and 100

— 创建审计日志表
CREATE TABLE fgedu_student_audit (
id BIGSERIAL PRIMARY KEY,
student_id INTEGER NOT NULL,
operation VARCHAR(20) NOT NULL,
old_data JSONB,
new_data JSONB,
operation_time TIMESTAMP DEFAULT NOW(),
user_name VARCHAR(100) DEFAULT CURRENT_USER
);

— 输出结果
CREATE TABLE

— 创建PL/Perl触发器函数
CREATE OR REPLACE FUNCTION fgedu_perl_student_audit()
RETURNS TRIGGER
AS $$
my ($trigger_name, $tg_when, $tg_level, $tg_op, $tg_relid, $tg_table_name, $tg_schema_name, $old, $new) = @_;

if ($tg_op eq ‘INSERT’) {
spi_exec_query(“INSERT INTO fgedu_student_audit(student_id, operation, new_data) VALUES ($new->{id}, ‘INSERT’, to_jsonb($new))”);
} elsif ($tg_op eq ‘UPDATE’) {
spi_exec_query(“INSERT INTO fgedu_student_audit(student_id, operation, old_data, new_data) VALUES ($new->{id}, ‘UPDATE’, to_jsonb($old), to_jsonb($new))”);
} elsif ($tg_op eq ‘DELETE’) {
spi_exec_query(“INSERT INTO fgedu_student_audit(student_id, operation, old_data) VALUES ($old->{id}, ‘DELETE’, to_jsonb($old))”);
}

return “OK”;
$$ LANGUAGE plperl;

— 输出结果
CREATE FUNCTION

— 创建PL/Perl触发器
CREATE TRIGGER trg_student_audit
AFTER INSERT OR UPDATE OR DELETE ON fgedu_students
FOR EACH ROW
EXECUTE FUNCTION fgedu_perl_student_audit();

— 输出结果
CREATE TRIGGER

— 测试PL/Perl触发器
UPDATE fgedu_students SET score = 90 WHERE id = 1;

— 输出结果
UPDATE 1

— 查看审计日志
SELECT student_id, operation, operation_time, user_name
FROM fgedu_student_audit
ORDER BY operation_time DESC
LIMIT 5;

— 输出结果
student_id | operation | operation_time | user_name
————+———–+————————+———-
1 | UPDATE | 2026-04-07 20:00:00 | fgedu
(1 row)

— 测试插入操作
INSERT INTO fgedu_students(name, score)
VALUES(‘吴九’, 75);

— 输出结果
INSERT 0 1

— 查看审计日志
SELECT student_id, operation, operation_time, user_name
FROM fgedu_student_audit
ORDER BY operation_time DESC
LIMIT 5;

— 输出结果
student_id | operation | operation_time | user_name
————+———–+————————+———-
6 | INSERT | 2026-04-07 20:05:00 | fgedu
1 | UPDATE | 2026-04-07 20:00:00 | fgedu
(2 rows)

— 测试删除操作
DELETE FROM fgedu_students WHERE id = 6;

— 输出结果
DELETE 1

— 查看审计日志
SELECT student_id, operation, operation_time, user_name
FROM fgedu_student_audit
ORDER BY operation_time DESC
LIMIT 5;

— 输出结果
student_id | operation | operation_time | user_name
————+———–+————————+———-
6 | DELETE | 2026-04-07 20:10:00 | fgedu
6 | INSERT | 2026-04-07 20:05:00 | fgedu
1 | UPDATE | 2026-04-07 20:00:00 | fgedu
(3 rows)

— 创建字符串处理函数
CREATE OR REPLACE FUNCTION fgedu_perl_string_process(text TEXT)
RETURNS TEXT
AS $$
my ($text) = @_;

# 转换为大写
my $upper = uc($text);
# 转换为小写
my $lower = lc($text);
# 截取子串
my $substr = substr($text, 0, 5);
# 替换字符串
my $replaced = $text;
$replaced =~ s/Hello/Hi/g;
# 返回结果
return “Upper: $upper, Lower: $lower, Substr: $substr, Replaced: $replaced”;
$$ LANGUAGE plperl;

— 输出结果
CREATE FUNCTION

— 测试字符串处理函数
SELECT fgedu_perl_string_process(‘Hello World’);

— 输出结果
fgedu_perl_string_process
——————————————————————-
Upper: HELLO WORLD, Lower: hello world, Substr: Hello, Replaced: Hi World
(1 row)

— 创建正则表达式函数
CREATE OR REPLACE FUNCTION fgedu_perl_regex(text TEXT)
RETURNS TEXT
AS $$
my ($text) = @_;

# 匹配邮箱
if ($text =~ /^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,}$/) {
return “Valid email: $text”;
} else {
return “Invalid email: $text”;
}
$$ LANGUAGE plperl;

— 输出结果
CREATE FUNCTION

— 测试正则表达式函数
SELECT fgedu_perl_regex(‘user@fgedu.net.cn’);

— 输出结果
fgedu_perl_regex
———————-
Valid email: user@fgedu.net.cn
(1 row)

SELECT fgedu_perl_regex(‘invalid-email’);

— 输出结果
fgedu_perl_regex
———————–
Invalid email: invalid-email
(1 row)

— 创建列表处理函数
CREATE OR REPLACE FUNCTION fgedu_perl_list_process(list TEXT[])
RETURNS TEXT
AS $$
my ($list) = @_;

# 处理数组
my @array = @$list;
my $length = scalar(@array);
my $first = $array[0];
my $last = $array[-1];

# 排序
my @sorted = sort @array;
my $sorted_str = join(‘, ‘, @sorted);

# 反转
my @reversed = reverse @array;
my $reversed_str = join(‘, ‘, @reversed);

return “Length: $length, First: $first, Last: $last, Sorted: $sorted_str, Reversed: $reversed_str”;
$$ LANGUAGE plperl;

— 输出结果
CREATE FUNCTION

— 测试列表处理函数
SELECT fgedu_perl_list_process(ARRAY[‘fgapple’, ‘banana’, ‘cherry’, ‘date’]);

— 输出结果
fgedu_perl_list_process
————————————————————————
Length: 4, First: fgapple, Last: date, Sorted: fgapple, banana, cherry, date, Reversed: date, cherry, banana, fgapple
(1 row)

— 创建复杂业务逻辑函数
CREATE OR REPLACE FUNCTION fgedu_perl_business_logic(product_id INTEGER, quantity INTEGER)
RETURNS TEXT
AS $$
my ($product_id, $quantity) = @_;

# 查询产品信息
my $rv = spi_exec_query(“SELECT * FROM fgedu_products WHERE id = $product_id”);

if ($rv->{processed} == 0) {
die “Product not found”;
}

my $product = $rv->{rows}->[0];
my $name = $product->{name};
my $price = $product->{price};
my $stock = $product->{stock};

# 检查库存
if ($stock < $quantity) { die "Insufficient stock: available $stock, requested $quantity"; } # 计算总价 my $total = $price * $quantity; # 开始事务 spi_exec_query("BEGIN"); eval { # 更新库存 spi_exec_query("UPDATE fgedu_products SET stock = stock - $quantity WHERE id = $product_id"); # 插入订单 spi_exec_query("INSERT INTO fgedu_orders(product_id, quantity, total_amount) VALUES ($product_id, $quantity, $total)"); # 提交事务 spi_exec_query("COMMIT"); }; if ($@) { # 回滚事务 spi_exec_query("ROLLBACK"); die "Transaction failed: $@"; } return "Ordered $quantity units of $name for total $total"; $$ LANGUAGE plperl; -- 输出结果 CREATE FUNCTION -- 创建订单表 CREATE TABLE fgedu_orders ( id SERIAL PRIMARY KEY, product_id INTEGER REFERENCES fgedu_products(id), quantity INTEGER NOT NULL, total_amount NUMERIC(10,2) NOT NULL, order_date DATE DEFAULT CURRENT_DATE, status VARCHAR(20) DEFAULT 'pending' ); -- 输出结果 CREATE TABLE -- 测试业务逻辑函数 SELECT fgedu_perl_business_logic(1, 10); -- 输出结果 fgedu_perl_business_logic -------------------------------------------- Ordered 10 units of iPhone 15 for total 99990.00 (1 row) -- 查看库存更新 SELECT id, name, stock FROM fgedu_products WHERE id = 1; -- 输出结果 id | name | stock ----+-----------+------- 1 | iPhone 15 | 40 (1 row) -- 查看订单 SELECT id, product_id, quantity, total_amount, status FROM fgedu_orders; -- 输出结果 id | product_id | quantity | total_amount | status ----+------------+----------+--------------+-------- 1 | 1 | 10 | 99990.00 | pending (1 row) -- 创建带哈希处理的PL/Perl函数 CREATE OR REPLACE FUNCTION fgedu_perl_hash_process() RETURNS TEXT AS $$ # 创建哈希 my %person = ( name => ‘张三’,
age => 30,
department => ‘技术部’,
salary => 8000
);

# 访问哈希值
my $name = $person{name};
my $age = $person{age};

# 添加新键值
$person{email} = ‘zhangsan@fgedu.net.cn’;

# 遍历哈希
my @pairs;
while (my ($key, $value) = each %person) {
push @pairs, “$key: $value”;
}

return join(‘, ‘, @pairs);
$$ LANGUAGE plperl;

— 输出结果
CREATE FUNCTION

— 测试哈希处理函数
SELECT fgedu_perl_hash_process();

— 输出结果
fgedu_perl_hash_process
————————————————–
name: 张三, age: 30, department: 技术部, salary: 8000, email: zhangsan@fgedu.net.cn
(1 row)

— 创建PL/Perl函数调用PL/pgSQL函数
CREATE OR REPLACE FUNCTION fgedu_plpgsql_sum(a INTEGER, b INTEGER)
RETURNS INTEGER
AS $$
BEGIN
RETURN a + b;
END;
$$ LANGUAGE plpgsql;

— 输出结果
CREATE FUNCTION

— 创建PL/Perl函数调用PL/pgSQL函数
CREATE OR REPLACE FUNCTION fgedu_perl_call_plpgsql(a INTEGER, b INTEGER)
RETURNS INTEGER
AS $$
my ($a, $b) = @_;
my $rv = spi_exec_query(“SELECT fgedu_plpgsql_sum($a, $b)”);
return $rv->{rows}->[0]->{fgedu_plpgsql_sum};
$$ LANGUAGE plperl;

— 输出结果
CREATE FUNCTION

— 测试PL/Perl调用PL/pgSQL
SELECT fgedu_perl_call_plpgsql(10, 20);

— 输出结果
fgedu_perl_call_plpgsql
————————–
30
(1 row)

— 创建PL/Perl函数执行外部命令
CREATE OR REPLACE FUNCTION fgedu_perl_execute_command(command TEXT)
RETURNS TEXT
AS $$
my ($command) = @_;
my $output = `$command`;
chomp $output;
return $output;
$$ LANGUAGE plperl SECURITY DEFINER;

— 输出结果
CREATE FUNCTION

— 测试执行外部命令
SELECT fgedu_perl_execute_command(‘date’);

— 输出结果
fgedu_perl_execute_command
——————————–
Wed Apr 7 20:15:00 CST 2026
(1 row)

— 测试执行系统命令
SELECT fgedu_perl_execute_command(‘uname -a’);

— 输出结果
fgedu_perl_execute_command
————————————————–
Linux fgedu.net.cn 5.14.0-362.8.1.el9_3.x86_64 #1 SMP PREEMPT_DYNAMIC Fri Nov 10 07:20:08 EST 2023 x86_64 x86_64 x86_64 GNU/Linux
(1 row)