第13章类, 对象和 Ties

bless 绑定到当前包:

1 2	`my $object = {}; bless($object);`

在用 bless 将一个引用绑定到一个包后, ref 函数将不会返回引用类型, 而是其绑定的包名.

bless 的目的就是让引用和一个名称空间联系, Perl 可以从中查找 functions.

典型的构造器为:

sub new {
    my $class = shift;
    my $self = {};
    bless($self, $class);
    return $self;
}

destructor 只能为 DESTROY. 其会在对象的内存释放之前调用.

如果想要区分类函数和对象函数, 可以写为.

如, 只能用类调用:

use Carp;
sub class_only_method {
    my $class = shift;
    croak "class method invoked on object" if ref $class;
    ...
}

ref 需要作用于一个引用. 作用于其他值时返回空字符串. 作用于引用时返回引用类型.

若只允许对象调用:

use Carp;
sub instance_only_method {
    my $self = shift;
    croak "instance method invoked on class" unless ref $self;
    # more code here
}

调用不存在的 method 则会自动调用 AUTOLOAD.

Perl, 在 @ISA 变量中查找继承的类. 如果 $ISA[0] 中仍然没有需要的方法, 但 $ISA[0] 中有自己的 @ISA, 那么又会从这个变量中查找.

如果所有的父类中都没有需要的方法, 则重复上述查找, 只不过是查找 AUTOLOAD 函数.

如果 @ISA 中只有一个元素, 则称为 single inheritance.

几个可参考的文档:

perltoot
perlboot
perlobj
perlbot

以及 Damian Conway’s 的 Object Oriented Perl 这本书.

13.1 构建一个对象

一般用匿名哈希来为一个对象分配内存.

如:

sub new {
    my $class = shift;
    my $self = { };
    bless $self => $class;
    return $self;
}

或写为:

1	`sub new { bless {} => shift }`

可将构造为对象和赋予属性分开:

sub new {
    my $class = shift;
    my $self = {};
    bless $self => $class;
    $self->_init(@_);
    return $self;
}

sub _init {
    my $self = shift;
    $self->{START} = time();
    $self->{AGE} = 0;
    if (@_) {
        my %extra = @_;
        @$self{keys %extra} = values %extra;
    }
}

13.2 销毁一个对象

创建 DESTROY 子例程, 如:

sub DESTROY {
    my $self = shift;
    printf("$self dying at %s\n", scalar localtime);
}

destructor 不能有任意名称的原因: constructor 是显示声明的, 但 destruction 是由 Perl 的 garbage collection 自动运行的.

在 Perl 的惯例中, 名称为全大写的函数一般会被 Perl 自动调用, 如 BEGIN, INIT, END, AUTOLOAD, 以及 tied object 的所有 methods.

13.3 管理对象的属性

用 methods 来获取对象的属性, 如:

sub get_name {
    my $self = shift;
    return $self->{NAME};
}

sub set_name {
    my $self = shift;
    $self->{NAME} = shift;
}

或通过传入的参数数量来判断行为:

sub name {
    my $self = shift;
    if (@_) { $self->{NAME} = shift }
    return $self->{NAME};
}

每一个属性应该有一个 method 来 update it, retrieve it, or both. (对于私有属性可以忽略)

一个比较好的示例:

use Carp;
sub name {
    my $self = shift;
    return $->{NAME} unless @_;
    local $_ = shift;
    croak "too many arguments" if @_;
    if ($^W) {
        ...
    }
    ...
    $self->{NAME} = $_;
}

13.4 管理包属性

如以下代码中的 $Body_Count :

package Person;

$Body_Count = 0;

sub population { return $Body_Count }

sub new {
    $Body_Count++;
    return bless {} => shift;
}

sub DESTROY { --$Body_Count }

package main;

for (1..10) { push @people, Person->new }
printf "There are %d people alive.\n", Person->population();

13.5 将类作为结构体使用

使用标准的 Class::Struct 模块, 可以像 C 语言一样定义结构体:

use Class::Struct;

struct Person => {
    name  => '$', # scalar
    age   => '$', # scalar
    peers => '$', # array
}

my $p = Person->new();

$p->name("Jason Smythe");
$p->age(13);
$p->peers(["Wilbur", "Ralph", "Fred"]);

# or 
@{$p->peers} = ("Wilbur", "Ralph", "Fred");

定义中的 $ 代表标量, @ 代表数组, % 代表哈希.

每一个属性都可以用一个 method 来获取, 或者加上参数来设置值.

这里的 struct 同样创建了名称空间, 比如这里的 name method 实际上为 Person::name.

因此也可以重写, 如:

1
2
3

sub Person::age {
    ...
}

声明也可以写为 array representation, 其速度更快, 占用空间更少:

1	`struct Family => [head => 'Person', address => '$', members => '@'];`

13.6 克隆构造器

也就是, 你想要创建一个对象, 其和另一个对象属于同一个类, 如:

my $ob1 = Widget->new();
my $ob2 = ob1->new();

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $parrent = ref($proto) && $proto;

    my $self;

    if (@ISA && $proto->SUPER::can("new")) {
        $self = $proto->SUPER::new(@_);
    } 
    else {
        $self = {};
        bless $self => $class;
    }

    $self->{PARENT} = $parrent;
    $self->{START} = time();
    $self->{AGE} = 0;

    return $self;
}

13.7 复制构造器

当你需要复制一个对象时.

可以利用标准的 Storable 模块中的 dclone() 函数.

如:

use Storable qw(dclone);
use Carp;
sub copy {
    my $self = shift;
    croak "can't copy class $self" unless ref $self;
    my $copy = Storable::dclone($self);
}

13.8 间接调用方法

将 methods 名放入变量中:

$methname = "flicker";
$obj->$methname(10);

foreach $m ( qw(start run stop) ) {
    $obj->$m();
}

有这样的写法;

1
2
3

my $fnref = sub { $ob->method(@_) };

$fnref->(10, "fred");

13.9 确定子类成员

确认一个对象是否为一个类的实例, 或者其子类的实例. 或者想知道一个类是否能执行一个 method.

$obj->isa("HTTP::Message");
HTTP::Response->isa("HTTP::Message");

if ($obj->can("method_name")) { ... }

这些方法继承自 UNIVERSE 类.

13.10 写一个可继承的类

利用一个空的基类来测试一个类是否能继承. 如:

package Person;
sub new {
    my $class = shift;
    my $self = {};
    return bless $self => $class;
}

sub name {
    my $self = shift;
    $self->{NAME} = shift if @_;
    return $self->{NAME};
}

sub age {
    my $self = shift;
    $self->{AGE} = shift if @_;
    return $self->{AGE};
}

package Employee;
use Person;
@ISA = ("Person");
1;

测试:

1
2
3

use Employee;
my $empl = Employee->new();
$empl->name("Jason");

13.11 访问被覆盖的方法

也就是访问父类的方法.

如:

sub meth {
    my $self = shift;
    $self->SUPER::meth();
}

私有 method 的命名惯例为, 加下划线, 如 _init.

SUPER 只对第一个被覆盖的方法管用. 即使 @ISA 中有多个元素.

13.12 用 AUTOLOAD 生成属性方法

用 AUTOLOAD 来提供所有的访问和设置属性的方法.

$AUTOLOAD 包含调用的不存在函数名.

如:

package Person;
use strict;
use Carp;
our(%ok_field);

for my $attr ( qw(name age peers parent) ) { $ok_field{$attr}++; }

sub AUTOLOAD {
    my $self = shift;
    my $attr = our $AUTOLOAD; # 获取访问函数名
    $attr =~ s/.*:://; # 去掉包名
    return unless $attr =~ /[^A-Z]/; # 跳过大写名的方法
    croak "invalid attibute method: ->$attr()" unless $ok_field($attr); # 检查是否有这个属性
    $self->{uc $attr} = shift if @_;  # 用于设置属性, uc 操作符是转为大写
    return $self->{uc $attr}; # 返回属性值
}

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $parent = ref($proto) && $proto;
    my $self = {};
    bless $self => $class;
    $self->parent($parent);
    return $self;
}
1

一般不会定义 AUTOLOAD, 调用一个方法前可以用 can 来判断:

1	`$man->be_merry() if $man->can("be_merry");`

13.15 用 tie 创建魔法变量

tie 同样将一个变量或句柄与一个类绑定. (主要是自动调用一些函数, 绑定操作还是用 bless 完成)

tie 中最重要的几个方法:

TIESCALAR, TIEARRAY, TIEHASH, TIEHANDLE, 用于绑定时调用
FETCH, 用于拦截读取操作
STORE, 用于拦截写入操作

示意图如:

示例代码:

use ValueRing;
tie $color, "ValueRing", qw(red blue);
print "$color $color $color $color $color $color\n";

$color = "green";
print "$color $color $color $color $color $color\n";

定义的类:

package ValueRing;

sub TIESCALAR {
    my ($class, @values) = @_;
    bless \@values, $class;
    return \@values;
}

sub FETCH {
    my $self = shift;
    push(@$self, shift(@$self));
    return $self->[-1];
}

sub STORE {
    my ($self, $value) = @_;
    unshift @$self, $value;
    return $value;
}

四个模块:

Tie::Scalar
Tie::Array
Tie::Hash
Tie::Handle

第14章访问数据库

14.0 介绍

DBD::SQLite 模块和 DBI 模块.

什么是 DBM files:
DBM（Database Management）文件是一种基于磁盘的哈希表，它可以用来存储键值对。DBM文件通常用于存储小型数据集，例如配置文件、用户信息等。在Perl中，可以使用标准模块DB_File来访问和操作DBM文件。

14.8 将查询结果存储为 Excel 或 CSV 格式

使用 CPAN 上的 DBIx::Dump 模块. (也可以参考 Spreadsheet::WriteExcel 和 Text::CSV_XS 模块)

如:

use DBIx::Dump;
use DBI;
# ... connect to your database as normal
$sth = $dbh->prepare("SELECT ..."); # your query here
$sth->execute( );

$out = DBIx::Dump->new('format' => $FORMAT, # excel or csv
                       'output' => $FILENAME, # file to save as
                       'sth' => $sth);
$out->dump( );

14.9 用 DBI 运行 SQL 语句

连接数据库如:

1 2	`$dbh = DBI->connect('dbi:driver:database', 'username', 'auth', { RaiseError => 1, AutoCommit => 1});`

第一个参数称为 DSN (Data Source Name), 其包含三个用 : 分隔的字段, 用于判断你连接的是哪一个数据库.

第四个参数是可选的哈希引用. 用于确定一些连接的特性.

运行一个查询并返回行数据, 一般可用 selectall_arrayref 和 selectall_hashref 方法. 如:

$rows = $dbh->selectall_arrayref("SELECT isbn, title, author FROM books");
print $row[0][1];

$rows = $dbh->selectall_hashref("SELECT isbn, title, author FROM books", "isbn"); # 后一个参数应该表明, 可以用 isbn 作为键
print $rows->{596000278}[2];

上述的无法复用. 可利用 prepare 和 execute 来创建一个 statement handle, 然后用 fetchrow_array 和 fetchrow_hashref 来取用. 如:

$sth = $dbh->prepare($SQL_SELECT_STATEMENT);
$sth->execute();
while (@row = $sth->fetchrow_array) {
    # ...
}

14.11 处理数据库错误

在连接时开启 RaiseError, 以及使用 eval 表达式, 如:

$dbh = DBI->connect($DSN, $user, $password, 
                    { RaiseError => 1 });
eval {
$dbh->do($SQL);
$sth = $dbh->prepare($SQL2);
$sth->execute( );
while (@row = $sth->fetchrow_array) {
    # ...
}
};
if ($@) {
    # recover here using $DBI::lasth->errstr to get
    # the error message
}

或者关闭 RaiseError, 用:

1 2	`$dbh->do($SQL) or die $dbh->errstr; $sth->execute( ) or die $sth->errstr;`

do 会返回获取的行数.

可以在连接时加入 PrintError => 1, 如:

1 2	`$dbh = DBI->connect($DSN, $user, $password, { RaiseError => 1, PrintError => 1 });`

14.12 重复查询的效率

预先 prepare 查询语句.

如:

$sth = $dbh->prepare('SELECT uid,login FROM People WHERE name = ?');
foreach $person (@names) {
    $sth->execute($person);
    while (@row = $sth->fetchrow_array) {
        # ...
    }
}

bind_param 可以将绑定操作从 execute 中分离出来:

1
2
3

$sth = $dbh->prepare('SELECT id,login FROM People WHERE middle_initial = ?');
$sth->bind_param(1, 'J');
$sth->execute( );

这里的 1 是占位符的位置.

如两个占位符:

$sth = $dbh->prepare('SELECT * FROM Addresses WHERE House = ?
AND Street LIKE ?');
$sth->bind_param(1, '221b');
$sth->bind_param(2, 'Baker');

bind_param 的第三个参数可以指定传入值的类型, 如:

1	`$sth->bind_param(1, 'J', SQL_CHAR);`

若要使用这些类型, 需要显示开启:

1 2	`use DBI qw(SQL_CHAR SQL_INTEGER); use DBI qw(:sql_types);`

查看所有类型:

1
2
3

foreach (@{ $dbi::EXPORT_TAGS{sql_types} }) {
    printf "%s=%d\n", $_, &{"DBI::$_"};
}

占位符的缺陷在于, 只能用于单值, 且不能表示 table 或 column name.

14.13 以编程方式构造查询

将语句 join 到一起, 如:

if ($year_min)
 { push @clauses, "Year >= $year_min" }
if ($year_max)
 { push @clauses, "Year <= $year_max" }
if ($bedrooms_min) { push @clauses, "Beds >= $bedrooms_min" }
if ($bedrooms_max) { push @clauses, "Beds <= $bedrooms_max" }
# ...
$clause = join(" AND ", @clauses);
$sth = $dbh->prepare("SELECT beds,baths FROM Houses WHERE $clause");

14.14 查看一个查询返回的行数

也就是 do 的返回值, 如果查询出错, 则返回 undef:

$rows = $dbh->do("DELETE FROM Conference WHERE Language='REBOL'");
if (! defined $rows) {
# failed, but this is not needed if RaiseError is active
} else {
    print "Deleted $rows rows\n";
}

也可以用查询语句查看有多少行:

1	`SELECT COUNT(*) FROM People WHERE Age > 30`

14.15 使用事件

也就是提交修改以及回溯.

使用 commit 和 rollback 方法.

如:

$dbh->{AutoCommit} = 0; # enable transactions
$dbh->{RaiseError} = 1; # die( ) if a query has problems
eval {
    # do inserts, updates, deletes, queries here
    $dbh->commit( );
};
if ($@) {
    warn "Transaction aborted: $@";
    eval { $dbh->rollback( ) }; # in case rollback( ) fails
    # do your application cleanup here
}

AutoCommit 控制 DBI 的自动提交功能.

14.18 不用 Database Server 来调用 SQL 语句

可以用 CPAN 的 DBD::SQLite 模块.

第15章交互

15.0 介绍

15.1 解析程序参数

用 Getopt::Std 和 Getopt::Long 模块来处理选项.

使用 Getopt::Std 时, 其会自动设置一些变量, 注意关闭 strict 和 warning, 如:

use Getopt::Std;

getopt("v:");

{
    no strict;
    no warnings;
    say "Hello, your option is [$opt_v]";
}

使用 Getopt::Long, 可以自己决定设置的变量名, 变量的值会随着一些设置而改变, 如:

GetOptions('verbose'   => \$verbose);
GetOptions('verbose!'  => \$verbose);
GetOptions('verbose+'  => \$verbose);
GetOptions('verbose=s' => \$verbose);

具体作用可以看 perldoc 文档.

其会自动加上 -- 在你设置的 option 之前.

在命令行中分隔两个 options 用 --, 如: --size 24 -- --all

当 options with valus 时, 值可以为三种类型:

integer number
floating point number
strings

上面的 verbose=s 中的 s 代表 string, 因此也有 i 代表 integer, f 代表 float, 将 = 换成 : 表明选项值是 optional. 若有 my $verbose = "test", 这是给默认值.

对于一个 option 有多个值的情况等. 各种情况都可见 perldoc 文档.

15.2 测试一个程序是否是交互式程序

15.3 清除屏幕

15.4 确定终端或屏幕大小

第17章 Sockets

这里讨论两种套接字:

streams, 流
datagrams, 数据报

互联网中的套接字的名称由两部分组成:

IP
port number

在 Unix 中, 套接字一般为一个文件, 如 /tmp/mysock

几个 Perl 的内置函数. 当发生错误时, 都返回 undef 且设置 $!.

用 symbolic names 而不是 numbers.

一般, 协议在操作系统中对应数字, 如 tcp, udp 等. 可以用 getprotobyname 函数, 从名称得到数字, 如:

1 2	`my $num = getprotobyname("tcp"); say $num;`

将 0 传递给 Perl 的 socket function 用于选择默认的 protocol.

Perl 内置的函数提供对套接字的 low-level 操作. IO::Socket::INET 和 IO::Socket::UNIX 两个模块提供创建和操作套接字的 high-level 函数.

几个内置函数

socket: 创建一个套接字.

bind: 给套接字一个 local name.

connect: 将一个 local socket 连接到另一个.

listen: readies a socket for connection from other sockets.

accept: receives the connections one by one.

可以用 print 和 <>, 或 syswrite 和 sysread 或 send 和 recv 来通过一个 datagram socket 通信.

一般来说:

server 一般调用: socket, bind, listen 和 accept
client 一般调用: socket, connect

Datagram client 不需要 connect, 因为其用 send 来指定.

当 bind, connect, send 到 specific destination 时, 需提供一个 socket name.

一个 Internet domain socket name 是一个 host (an IP address packed with inet_aton) 加上一个 port (a number), 如:

use Socket;

$packed_ip = inet_aton("208.201.239.37");
$socket_name = sockaddr_in($port, $packed_ip);

一个Unix domain socket name 是一个文件名 packed into a C structure with sockaddr_un, 如:

1
2
3

use Socket;

$socket_name = sockaddr_un("/tmp/mysock");

由一个 packed socket name 得到文件名或者 host and port, 可以:

1 2	`($port, $packed_ip) = sockaddr_in($socket_name); ($filename) = sockaddr_un($socket_name);`

用 inet_ntoa (numbers to ASCII) 将一个 packed IP address 转换为 ASCII 字符串. 用 inet_aton (ASCII to numbers) 将 ASCII 字符串转换为 packed ip, 如:

1
2
3

$ip_address = inet_ntoa($packed_ip);
$packed_ip  = inet_aton("208.201.239.37");
$packed_ip  = inet_aton("www.oreilly.com");

Perl

Perl-cookbook-Notes

http://example.com/2023/03/17/Perl-cookbook-Notes/

作者

Jie

发布于

2023年3月17日

许可协议

Verilog-菜鸟教程-Notes 上一篇

修复-vivado-在-Archlinux-DWM-下开启后白屏问题下一篇