Perl/ライブラリ・モジュールとオブジェクト指向

プログラミング > Perl > ライブラリ・モジュールとオブジェクト指向

パッケージ

Perl4までは、全ての変数は動的で単一のグローバルな名前空間に存在していました。これは丁度 BASIC と同じ状況で、識別子の衝突の回避がプログラミングの大きなテーマでした。

この問題を解決するためにPerl5では

vars プラグマや our キーワードを使って公開される名前空間付きグローバル変数
my や state で宣言されたレキシカルスコープ変数

が導入されました。

完全修飾形式

グローバル変数は、名前空間の一部とみなされ、「完全修飾形式」( fully qualified form )でアクセスできます。逆に、レキシカルスコープ変数は、そのレキシカルスコープの一部とみなされ、「完全修飾形式」を持ちません。

完全修飾形式: 名前空間::識別子

package

Perl の名前空間は「パッケージ」と呼ばれ、package 宣言は変数や非限定動的名の前にどの名前空間を付けるかを決めます。

package 宣言のスコープは宣言に伴うブロック、ブロックを伴わない場合は次のpackage 宣言までです。

package 宣言を含むコード

use v5.20.0;

say "default package name is @{[ __PACKAGE__ ]}";

package PKG0 {
  sub f { say "I'm @{[ __PACKAGE__ ]}" }
}

say "In @{[ __PACKAGE__ ]}";

package PKG1;
sub f { say "I'm @{[ __PACKAGE__ ]}" }

say "In @{[ __PACKAGE__ ]}";

package main;
sub f { say "I'm @{[ __PACKAGE__ ]}" }

&PKG0::f;
&PKG1::f;
&main::f;
&::f;
&f;

実行結果

default package name is main
default package name is main
In main
In PKG1
I'm PKG0
I'm PKG1
I'm main
I'm main 
I'm main

__PACKAGE__ で、その位置のパッケージ名を参照できます。

トップレベルのパッケージ名は、main です。

package PKG0 は、をブロックを伴って宣言されているので、ブロックを抜けると main パッケージに戻ります。

package PKG1 は、をブロックを伴わず宣言されているので、次の package 宣言までが PKG0 パッケージです。

&PKG0::fで、PKG0パッケージのfが、 &PKG1::fで、PKG1パッケージのfが。

&main::f、&::fあるいは&fで、mainパッケージのfが参照されます。

our

ourで宣言された変数は、パッケージ変数です。パッケージ変数はグローバル変数ですが、パッケージに属しています。 our宣言の場所のスコープでしか単純な名前での参照はできませんが、::をつかった完全修飾形式であれば、ourのスコープの外からも参照できます。

our 宣言を含むコード

use v5.20.0;

our $x = "default package name is @{[ __PACKAGE__ ]}";

package PKG0 {
  our $x = "I'm @{[ __PACKAGE__ ]}"
}

package PKG1;
our $x = "I'm @{[ __PACKAGE__ ]}";

package main;

print <<EOS;
$\PKG0::x --> $PKG0::x
$\PKG1::x --> $PKG1::x
$\main::x --> $main::x
$\::x --> $::x
$\x --> $x
EOS

実行結果

PKG0::x --> I'm PKG0
PKG1::x --> I'm PKG1
main::x --> default package name is main
::x --> default package name is main 
x --> I'm PKG1

最後だけ意外ですが、PKG1 の our $x のレキシカルスコープは尽きていないので、main::x を押し置けて PKG1::x が参照されます。

特殊コードブロック

Perlも、AWK の BEGIN, END のように特定のタイミングで実行されるコードブロックを定義できます。特殊コードブロックは、サブルーチンと外観は似ていますが、同じパッケージに２つ以上定義することもできます。まや、直接呼出すことはできません。５つのどのコードブロックで実行されているかは、${^GLOBAL_PHASE} で参照できます。

「perlmod -- BEGIN, UNITCHECK, CHECK, INIT, END」も参照

BEGIN

BEGINコードブロックは、パースした端から実行されます。 AWKのBEGINと同様です。

UNITCHECK

UNITCHECKブロックは、それを定義したユニットがコンパイルされた直後に実行されます。メインプログラムファイルとそれがロードする各モジュールはコンパイル単位であり、文字列評価、正規表現内の (?{ }) 構成を使用してコンパイルされたランタイムコード、do FILE、require FILEの呼び出し、コマンドライン上の-eスイッチの後のコードも同様です。

CHECK

CHECK コードブロックは、最初の Perl コンパイルフェーズ終了直後、実行時が開始する直前に、LIFO 順で実行されます。 CHECK コードブロックは Perl コンパイラスイートがプログラムのコンパイル状態を保存するために使われます。

INIT

INIT ブロックは Perl ランタイムが実行を開始する直前に、「先入れ先出し」 (FIFO) 順で実行されます。

END

ENDコードブロックはできるだけ遅く、perlがプログラムを実行し終わった後、インタープリターが終了する直前に実行されます。

たとえ、die関数の結果として終了する場合でも同様です。

しかし、execによって他のプログラムに遷移した場合は実行されません。

さらに、ハンドリングされていないシグナルによるアボートの場合も実行されません。

(可能であれば)自分でトラップしなければなりません。

1つのファイルに複数のENDブロックがあっても、それらは定義の逆順で実行されます。

つまり、LIFO(Last In, First Out)です。

ENDブロックは、perlを-cスイッチ付きで実行したときや、コンパイルに失敗したときには実行されません。

AWKのENDと同様です。

モジュール

構文

use モジュール名 [ 識別子 ];

プラグマ

プラグマは、Perl のコンパイル時や実行時の動作に影響を与えるモジュールです。 strict や warnings のように、Perl のコンパイル時や実行時の動作に影響を与えるモジュールです。 Perl 5.10 からは、ユーザーもプラグマを定義できるようになりました。

strict

strictプラグマを有効にすると、宣言済みでないグローバル変数やシンボリックリファレンスなど危険なものの使用を禁止します。それらが出現した時点で例外を発生させ、プログラムを終了します。

use v5.12 以降は strict が^[1]ディフォルトで有効です。

use strict;

use モジュール名;とすると、モジュールを使用することができます。対義語はno モジュール名;で、モジュールを不使用にします。

use strict;
{
    no strict 'refs'; # このブロックの中ではシンボリックリファレンスを使用可能にする
}

strictプラグマはレキシカルスコープを持つので、このようにブロック内でのみ無効にするということができます。

$a と $b

$a と $b は、sort() を使うときの特別なパッケージ変数です。

この特殊性のため、$a と $b は "strict 'vars'" プラグマを使用しても、"use vars" や "our()" を使って宣言する必要はありません。 sort() 比較ブロックや関数で使用したい場合は、「my $a」や「my $b」でレキシカルスコープにしないようにしましょう。

Perlのプログラミングの教本で、変数の例に $a や $b を使っている場合、筆者は特別なパッケージ変数であることに思い至っていないことになります。

warnings

use warnings;

で、警告の機能を追加できます。

これはperlの -w スイッチと同じで、無意味な演算や未定義の変数の使用、一度も使用されていない変数などに対する警告を有効にします。

use v5.36 以降は、warnings がディフォルトで有効です^[2]

警告するだけで、プログラムは続行されます。

ワンライナーや書き捨てのスクリプトを作成する時以外は、strictプラグマと共に常に有効にすることが推奨されます。

標準モジュール

perlに標準で同梱されているモジュールのことを標準モジュールといいます。標準モジュール以外のライブラリは、CPANなどから入手します。

標準モジュールの一覧とサポートバージョンの一覧を表示するコード

use v5.30.0;
use warnings;
use Module::CoreList;

my $version = '5.030000';
my $modules = $Module::CoreList::version{$version};
print <<EOS;
Modules in perl $version:
@{[ join "\n",  (sort keys %$modules) ]}

version in Module::CoreList::version:
@{[ join "\n",  (sort keys %Module::CoreList::version) ]}
EOS

実行結果

Modules in perl 5.030000:
Amiga::ARexx
Amiga::Exec
AnyDBM_File
App::Cpan
App::Prove
App::Prove::State
App::Prove::State::Result
App::Prove::State::Result::Test
Archive::Tar
Archive::Tar::Constant
Archive::Tar::File
Attribute::Handlers
AutoLoader
AutoSplit
B
B::Concise
B::Deparse
B::Op_private
B::Showlex
B::Terse
B::Xref
Benchmark
CPAN
CPAN::Author
CPAN::Bundle
CPAN::CacheMgr
CPAN::Complete
CPAN::Debug
CPAN::DeferredCode
CPAN::Distribution
CPAN::Distroprefs
CPAN::Distrostatus
CPAN::Exception::RecursiveDependency
CPAN::Exception::blocked_urllist
CPAN::Exception::yaml_not_installed
CPAN::Exception::yaml_process_error
CPAN::FTP
CPAN::FTP::netrc
CPAN::FirstTime
CPAN::HTTP::Client
CPAN::HTTP::Credentials
CPAN::HandleConfig
CPAN::Index
CPAN::InfoObj
CPAN::Kwalify
CPAN::LWP::UserAgent
CPAN::Meta
CPAN::Meta::Converter
CPAN::Meta::Feature
CPAN::Meta::History
CPAN::Meta::Merge
CPAN::Meta::Prereqs
CPAN::Meta::Requirements
CPAN::Meta::Spec
CPAN::Meta::Validator
CPAN::Meta::YAML
CPAN::Mirrors
CPAN::Module
CPAN::Nox
CPAN::Plugin
CPAN::Plugin::Specfile
CPAN::Prompt
CPAN::Queue
CPAN::Shell
CPAN::Tarzip
CPAN::URL
CPAN::Version
Carp
Carp::Heavy
Class::Struct
Compress::Raw::Bzip2
Compress::Raw::Zlib
Compress::Zlib
Config
Config::Extensions
Config::Perl::V
Cwd
DB
DBM_Filter
DBM_Filter::compress
DBM_Filter::encode
DBM_Filter::int32
DBM_Filter::null
DBM_Filter::utf8
DB_File
Data::Dumper
Devel::PPPort
Devel::Peek
Devel::SelfStubber
Digest
Digest::MD5
Digest::SHA
Digest::base
Digest::file
DirHandle
Dumpvalue
DynaLoader
Encode
Encode::Alias
Encode::Byte
Encode::CJKConstants
Encode::CN
Encode::CN::HZ
Encode::Config
Encode::EBCDIC
Encode::Encoder
Encode::Encoding
Encode::GSM0338
Encode::Guess
Encode::JP
Encode::JP::H2Z
Encode::JP::JIS7
Encode::KR
Encode::KR::2022_KR
Encode::MIME::Header
Encode::MIME::Header::ISO_2022_JP
Encode::MIME::Name
Encode::Symbol
Encode::TW
Encode::Unicode
Encode::Unicode::UTF7
English
Env
Errno
Exporter
Exporter::Heavy
ExtUtils::CBuilder
ExtUtils::CBuilder::Base
ExtUtils::CBuilder::Platform::Unix
ExtUtils::CBuilder::Platform::VMS
ExtUtils::CBuilder::Platform::Windows
ExtUtils::CBuilder::Platform::Windows::BCC
ExtUtils::CBuilder::Platform::Windows::GCC
ExtUtils::CBuilder::Platform::Windows::MSVC
ExtUtils::CBuilder::Platform::aix
ExtUtils::CBuilder::Platform::android
ExtUtils::CBuilder::Platform::cygwin
ExtUtils::CBuilder::Platform::darwin
ExtUtils::CBuilder::Platform::dec_osf
ExtUtils::CBuilder::Platform::os2
ExtUtils::Command
ExtUtils::Command::MM
ExtUtils::Constant
ExtUtils::Constant::Base
ExtUtils::Constant::ProxySubs
ExtUtils::Constant::Utils
ExtUtils::Constant::XS
ExtUtils::Embed
ExtUtils::Install
ExtUtils::Installed
ExtUtils::Liblist
ExtUtils::Liblist::Kid
ExtUtils::MM
ExtUtils::MM_AIX
ExtUtils::MM_Any
ExtUtils::MM_BeOS
ExtUtils::MM_Cygwin
ExtUtils::MM_DOS
ExtUtils::MM_Darwin
ExtUtils::MM_MacOS
ExtUtils::MM_NW5
ExtUtils::MM_OS2
ExtUtils::MM_QNX
ExtUtils::MM_UWIN
ExtUtils::MM_Unix
ExtUtils::MM_VMS
ExtUtils::MM_VOS
ExtUtils::MM_Win32
ExtUtils::MM_Win95
ExtUtils::MY
ExtUtils::MakeMaker
ExtUtils::MakeMaker::Config
ExtUtils::MakeMaker::Locale
ExtUtils::MakeMaker::version
ExtUtils::MakeMaker::version::regex
ExtUtils::Manifest
ExtUtils::Miniperl
ExtUtils::Mkbootstrap
ExtUtils::Mksymlists
ExtUtils::Packlist
ExtUtils::ParseXS
ExtUtils::ParseXS::Constants
ExtUtils::ParseXS::CountLines
ExtUtils::ParseXS::Eval
ExtUtils::ParseXS::Utilities
ExtUtils::Typemaps
ExtUtils::Typemaps::Cmd
ExtUtils::Typemaps::InputMap
ExtUtils::Typemaps::OutputMap
ExtUtils::Typemaps::Type
ExtUtils::XSSymSet
ExtUtils::testlib
Fatal
Fcntl
File::Basename
File::Compare
File::Copy
File::DosGlob
File::Fetch
File::Find
File::Glob
File::GlobMapper
File::Path
File::Spec
File::Spec::AmigaOS
File::Spec::Cygwin
File::Spec::Epoc
File::Spec::Functions
File::Spec::Mac
File::Spec::OS2
File::Spec::Unix
File::Spec::VMS
File::Spec::Win32
File::Temp
File::stat
FileCache
FileHandle
Filter::Simple
Filter::Util::Call
FindBin
GDBM_File
Getopt::Long
Getopt::Std
HTTP::Tiny
Hash::Util
Hash::Util::FieldHash
I18N::Collate
I18N::LangTags
I18N::LangTags::Detect
I18N::LangTags::List
I18N::Langinfo
IO
IO::Compress::Adapter::Bzip2
IO::Compress::Adapter::Deflate
IO::Compress::Adapter::Identity
IO::Compress::Base
IO::Compress::Base::Common
IO::Compress::Bzip2
IO::Compress::Deflate
IO::Compress::Gzip
IO::Compress::Gzip::Constants
IO::Compress::RawDeflate
IO::Compress::Zip
IO::Compress::Zip::Constants
IO::Compress::Zlib::Constants
IO::Compress::Zlib::Extra
IO::Dir
IO::File
IO::Handle
IO::Pipe
IO::Poll
IO::Seekable
IO::Select
IO::Socket
IO::Socket::INET
IO::Socket::IP
IO::Socket::UNIX
IO::Uncompress::Adapter::Bunzip2
IO::Uncompress::Adapter::Identity
IO::Uncompress::Adapter::Inflate
IO::Uncompress::AnyInflate
IO::Uncompress::AnyUncompress
IO::Uncompress::Base
IO::Uncompress::Bunzip2
IO::Uncompress::Gunzip
IO::Uncompress::Inflate
IO::Uncompress::RawInflate
IO::Uncompress::Unzip
IO::Zlib
IPC::Cmd
IPC::Msg
IPC::Open2
IPC::Open3
IPC::Semaphore
IPC::SharedMem
IPC::SysV
JSON::PP
JSON::PP::Boolean
List::Util
List::Util::XS
Locale::Maketext
Locale::Maketext::Guts
Locale::Maketext::GutsLoader
Locale::Maketext::Simple
MIME::Base64
MIME::QuotedPrint
Math::BigFloat
Math::BigFloat::Trace
Math::BigInt
Math::BigInt::Calc
Math::BigInt::FastCalc
Math::BigInt::Lib
Math::BigInt::Trace
Math::BigRat
Math::Complex
Math::Trig
Memoize
Memoize::AnyDBM_File
Memoize::Expire
Memoize::ExpireFile
Memoize::ExpireTest
Memoize::NDBM_File
Memoize::SDBM_File
Memoize::Storable
Module::CoreList
Module::CoreList::Utils
Module::Load
Module::Load::Conditional
Module::Loaded
Module::Metadata
Moped::Msg
NDBM_File
NEXT
Net::Cmd
Net::Config
Net::Domain
Net::FTP
Net::FTP::A
Net::FTP::E
Net::FTP::I
Net::FTP::L
Net::FTP::dataconn
Net::NNTP
Net::Netrc
Net::POP3
Net::Ping
Net::SMTP
Net::Time
Net::hostent
Net::netent
Net::protoent
Net::servent
O
ODBM_File
OS2::DLL
OS2::ExtAttr
OS2::PrfDB
OS2::Process
OS2::REXX
Opcode
POSIX
Params::Check
Parse::CPAN::Meta
Perl::OSType
PerlIO
PerlIO::encoding
PerlIO::mmap
PerlIO::scalar
PerlIO::via
PerlIO::via::QuotedPrint
Pod::Checker
Pod::Escapes
Pod::Find
Pod::Functions
Pod::Functions::Functions
Pod::Html
Pod::InputObjects
Pod::Man
Pod::ParseLink
Pod::ParseUtils
Pod::Parser
Pod::Perldoc
Pod::Perldoc::BaseTo
Pod::Perldoc::GetOptsOO
Pod::Perldoc::ToANSI
Pod::Perldoc::ToChecker
Pod::Perldoc::ToMan
Pod::Perldoc::ToNroff
Pod::Perldoc::ToPod
Pod::Perldoc::ToRtf
Pod::Perldoc::ToTerm
Pod::Perldoc::ToText
Pod::Perldoc::ToTk
Pod::Perldoc::ToXml
Pod::PlainText
Pod::Select
Pod::Simple
Pod::Simple::BlackBox
Pod::Simple::Checker
Pod::Simple::Debug
Pod::Simple::DumpAsText
Pod::Simple::DumpAsXML
Pod::Simple::HTML
Pod::Simple::HTMLBatch
Pod::Simple::HTMLLegacy
Pod::Simple::LinkSection
Pod::Simple::Methody
Pod::Simple::Progress
Pod::Simple::PullParser
Pod::Simple::PullParserEndToken
Pod::Simple::PullParserStartToken
Pod::Simple::PullParserTextToken
Pod::Simple::PullParserToken
Pod::Simple::RTF
Pod::Simple::Search
Pod::Simple::SimpleTree
Pod::Simple::Text
Pod::Simple::TextContent
Pod::Simple::TiedOutFH
Pod::Simple::Transcode
Pod::Simple::TranscodeDumb
Pod::Simple::TranscodeSmart
Pod::Simple::XHTML
Pod::Simple::XMLOutStream
Pod::Text
Pod::Text::Color
Pod::Text::Overstrike
Pod::Text::Termcap
Pod::Usage
SDBM_File
Safe
Scalar::Util
Search::Dict
SelectSaver
SelfLoader
Socket
Storable
Sub::Util
Symbol
Sys::Hostname
Sys::Syslog
Sys::Syslog::Win32
TAP::Base
TAP::Formatter::Base
TAP::Formatter::Color
TAP::Formatter::Console
TAP::Formatter::Console::ParallelSession
TAP::Formatter::Console::Session
TAP::Formatter::File
TAP::Formatter::File::Session
TAP::Formatter::Session
TAP::Harness
TAP::Harness::Env
TAP::Object
TAP::Parser
TAP::Parser::Aggregator
TAP::Parser::Grammar
TAP::Parser::Iterator
TAP::Parser::Iterator::Array
TAP::Parser::Iterator::Process
TAP::Parser::Iterator::Stream
TAP::Parser::IteratorFactory
TAP::Parser::Multiplexer
TAP::Parser::Result
TAP::Parser::Result::Bailout
TAP::Parser::Result::Comment
TAP::Parser::Result::Plan
TAP::Parser::Result::Pragma
TAP::Parser::Result::Test
TAP::Parser::Result::Unknown
TAP::Parser::Result::Version
TAP::Parser::Result::YAML
TAP::Parser::ResultFactory
TAP::Parser::Scheduler
TAP::Parser::Scheduler::Job
TAP::Parser::Scheduler::Spinner
TAP::Parser::Source
TAP::Parser::SourceHandler
TAP::Parser::SourceHandler::Executable
TAP::Parser::SourceHandler::File
TAP::Parser::SourceHandler::Handle
TAP::Parser::SourceHandler::Perl
TAP::Parser::SourceHandler::RawTAP
TAP::Parser::YAMLish::Reader
TAP::Parser::YAMLish::Writer
Term::ANSIColor
Term::Cap
Term::Complete
Term::ReadLine
Test
Test2
Test2::API
Test2::API::Breakage
Test2::API::Context
Test2::API::Instance
Test2::API::Stack
Test2::Event
Test2::Event::Bail
Test2::Event::Diag
Test2::Event::Encoding
Test2::Event::Exception
Test2::Event::Fail
Test2::Event::Generic
Test2::Event::Note
Test2::Event::Ok
Test2::Event::Pass
Test2::Event::Plan
Test2::Event::Skip
Test2::Event::Subtest
Test2::Event::TAP::Version
Test2::Event::V2
Test2::Event::Waiting
Test2::EventFacet
Test2::EventFacet::About
Test2::EventFacet::Amnesty
Test2::EventFacet::Assert
Test2::EventFacet::Control
Test2::EventFacet::Error
Test2::EventFacet::Hub
Test2::EventFacet::Info
Test2::EventFacet::Info::Table
Test2::EventFacet::Meta
Test2::EventFacet::Parent
Test2::EventFacet::Plan
Test2::EventFacet::Render
Test2::EventFacet::Trace
Test2::Formatter
Test2::Formatter::TAP
Test2::Hub
Test2::Hub::Interceptor
Test2::Hub::Interceptor::Terminator
Test2::Hub::Subtest
Test2::IPC
Test2::IPC::Driver
Test2::IPC::Driver::Files
Test2::Tools::Tiny
Test2::Util
Test2::Util::ExternalMeta
Test2::Util::Facets2Legacy
Test2::Util::HashBase
Test2::Util::Trace
Test::Builder
Test::Builder::Formatter
Test::Builder::IO::Scalar
Test::Builder::Module
Test::Builder::Tester
Test::Builder::Tester::Color
Test::Builder::TodoDiag
Test::Harness
Test::More
Test::Simple
Test::Tester
Test::Tester::Capture
Test::Tester::CaptureRunner
Test::Tester::Delegate
Test::use::ok
Text::Abbrev
Text::Balanced
Text::ParseWords
Text::Tabs
Text::Wrap
Thread
Thread::Queue
Thread::Semaphore
Tie::Array
Tie::File
Tie::Handle
Tie::Hash
Tie::Hash::NamedCapture
Tie::Memoize
Tie::RefHash
Tie::Scalar
Tie::StdHandle
Tie::SubstrHash
Time::HiRes
Time::Local
Time::Piece
Time::Seconds
Time::gmtime
Time::localtime
Time::tm
UNIVERSAL
Unicode
Unicode::Collate
Unicode::Collate::CJK::Big5
Unicode::Collate::CJK::GB2312
Unicode::Collate::CJK::JISX0208
Unicode::Collate::CJK::Korean
Unicode::Collate::CJK::Pinyin
Unicode::Collate::CJK::Stroke
Unicode::Collate::CJK::Zhuyin
Unicode::Collate::Locale
Unicode::Normalize
Unicode::UCD
User::grent
User::pwent
VMS::DCLsym
VMS::Filespec
VMS::Stdio
Win32
Win32API::File
Win32API::File::inc::ExtUtils::Myconst2perl
Win32CORE
XS::APItest
XS::Typemap
XSLoader
_charnames
attributes
autodie
autodie::Scope::Guard
autodie::Scope::GuardStack
autodie::Util
autodie::exception
autodie::exception::system
autodie::hints
autodie::skip
autouse
base
bigint
bignum
bigrat
blib
bytes
charnames
constant
deprecate
diagnostics
encoding
encoding::warnings
experimental
feature
fields
filetest
if
integer
less
lib
locale
meta_notation
mro
ok
open
ops
overload
overload::numbers
overloading
parent
perlfaq
re
sigtrap
sort
strict
subs
threads
threads::shared
unicore::Name
utf8
vars
version
version::regex
vmsish
warnings
warnings::register

version in Module::CoreList::version:
5
5.000
5.001
5.002
5.00307
5.004
5.00405
5.005
5.00503
5.00504
5.006
5.006000
5.006001
5.006002
5.007003
5.008
5.008000
5.008001
5.008002
5.008003
5.008004
5.008005
5.008006
5.008007
5.008008
5.008009
5.009
5.009000
5.009001
5.009002
5.009003
5.009004
5.009005
5.01
5.010000
5.010001
5.011
5.011000
5.011001
5.011002
5.011003
5.011004
5.011005
5.012
5.012000
5.012001
5.012002
5.012003
5.012004
5.012005
5.013
5.013000
5.013001
5.013002
5.013003
5.013004
5.013005
5.013006
5.013007
5.013008
5.013009
5.01301
5.013010
5.013011
5.014
5.014000
5.014001
5.014002
5.014003
5.014004
5.015
5.015000
5.015001
5.015002
5.015003
5.015004
5.015005
5.015006
5.015007
5.015008
5.015009
5.016
5.016000
5.016001
5.016002
5.016003
5.017
5.017000
5.017001
5.017002
5.017003
5.017004
5.017005
5.017006
5.017007
5.017008
5.017009
5.01701
5.017010
5.017011
5.018
5.018000
5.018001
5.018002
5.018003
5.018004
5.019
5.019000
5.019001
5.019002
5.019003
5.019004
5.019005
5.019006
5.019007
5.019008
5.019009
5.01901
5.019010
5.019011
5.02
5.020000
5.020001
5.020002
5.020003
5.021
5.021000
5.021001
5.021002
5.021003
5.021004
5.021005
5.021006
5.021007
5.021008
5.021009
5.02101
5.021010
5.021011
5.022
5.022000
5.022001
5.022002
5.022003
5.022004
5.023
5.023000
5.023001
5.023002
5.023003
5.023004
5.023005
5.023006
5.023007
5.023008
5.023009
5.024
5.024000
5.024001
5.024002
5.024003
5.024004
5.025
5.025000
5.025001
5.025002
5.025003
5.025004
5.025005
5.025006
5.025007
5.025008
5.025009
5.02501
5.025010
5.025011
5.025012
5.026
5.026000
5.026001
5.026002
5.026003
5.027
5.027000
5.027001
5.027002
5.027003
5.027004
5.027005
5.027006
5.027007
5.027008
5.027009
5.02701
5.027010
5.027011
5.028
5.028000
5.028001
5.028002
5.029
5.029000
5.029001
5.029002
5.029003
5.029004
5.029005
5.029006
5.029007
5.029008
5.029009
5.02901
5.029010
5.03
5.030000

CPAN

CPAN (Comprehensive Perl Archive Network) とは、Perlのライブラリ、モジュール、その他のスクリプトなどを集めた世界的なアーカイブネットワークです。標準モジュールのCPAN.pmでは、シェルからcpanコマンドを使ってCPANのモジュールをインストールするインタフェースを提供しています。

モジュールの作成

「Perl Modules(en)」および「Perl Modules(ja)」も参照

非オブジェクト指向版

lib/Category/Example.pm

package Category::Example {
    use v5.30.0;

    BEGIN {
        require Exporter;

        # バージョンチェックのためのバージョン
        our $VERSION     = 1.00;

        # Exporterを継承して関数と変数をエクスポートする
        our @ISA         = qw(Exporter);

        # デフォルトでエクスポートされる関数と変数
        our @EXPORT      = qw(func1 func2);

        # オプションでエクスポート可能な関数と変数
        our @EXPORT_OK   = qw($Var1 %Hashit func3);
    }

    # エクスポートされるパッケージのグローバル識別子
    our $Var1    = '';
    our %Hashit  = ();

    # エクスポートされないパッケージのグローバル識別子
    # （これらは、$Category::Example::stuffとしてまだアクセス可能です）
    our @more    = ();
    our $stuff   = 'stuff';

    # ファイルプライベートレキシカルは、それらを使用する関数の前に、ここに置かれます。
    my $priv_var    = '';
    my %secret_hash = ();

    # ここでは、ファイル・プライベート関数をクロージャとして、
    # $priv_func->() として呼び出しています。
    my $priv_func = sub {
        ...
    };

    # エクスポートされている関数の実装。
    sub func1      { return "func1" }
    sub func2      { return "func2" }

    # これはエクスポートされませんが、
    # Some::Module::func3() として直接呼び出すことができます。
    sub func3      { return "func3" }

    END {     }       # モジュールのクリーンアップコード（グローバルデストラクター）。
}
1;  # true を返すことを忘れないでください。

Main.pl

use v5.30.0;
use lib './lib';

use Category::Example;

say func1;
say func2;
say Category::Example::func3;

オブジェクト指向でないモジュール実装の例です。

モジュールの拡張子は .pm （Perl Modules）で、モジュール階層の区切り :: をファイルシステムのディレクトセパレーターに置き換えたものがパスになります。: モジュールは package として実装します。

コンパイル単位を超えて識別子をエキスポートするには Exporter モジュールを使います。

オブジェクト指向版

「#具体的な実装例」も参照

lib/Point.pm

package Point {
    use v5.30.0;
    use feature 'signatures';
    no warnings "experimental::signatures";
    use POSIX qw[hypot];
    
    BEGIN {
        our @VERSION = "1.2.0";
    }

    sub new ( $class, $x = 0.0, $y = 0.0 ) {
        bless { x => $x, y => $y, }, $class;
    }
    use overload
        '""'  => sub ( $self, $p, $q ) {"Point($self->{x}, $self->{y})"},
        'abs' => sub ( $self, $p, $q ) { POSIX::hypot( $self->{x}, $self->{y} ) };
    sub abs   ($self) { POSIX::hypot( $self->{x}, $self->{y} ) }
    sub angle ($self) { atan2( $self->{x}, $self->{y} ) }
}

if ( $0 eq __FILE__ ) {

    my $pt = Point->new( 6.0, 8.0 );

    print <<EOS;
\@Point::VERSION: @{[ @Point::VERSION ]}
\$pt: $pt 
\$pt->abs(): @{[ $pt->abs() ]}
\$pt->angle(): @{[ $pt->angle() ]}
EOS
}
1;

Main.pl

use v5.30.0;
use lib q(./lib);
use Point;

my $pt = Point->new( 3.0, 4.0 );

print <<EOS;
\@Point::VERSION: @{[ @Point::VERSION ]}
\$pt: $pt 
abs \$pt: @{[ abs $pt ]}
\$pt->abs: @{[ $pt->abs ]}
\$pt->angle(): @{[ $pt->angle() ]}
EOS

実行結果

@Point::VERSION: 1.2.0
$pt: Point(3, 4) 
abs $pt: 5
$pt->abs: 5 
$pt->angle(): 0.643501108793284

オブジェクト指向のモジュール実装の例です。

abs は、単項演算子でもあるのでメソッド版と演算子版の２つを用意しました。

package をクラスとして使っているので、Exporter の出番はなく、完全修飾形式が基本になります。

呼出し元のパッケージ（典型的には main::）の名前空間を汚染しないのがよいです。

use overload '""' => sub($self, $p, $q) { "Point($self->{x}, $self->{y})" };は、文字列化演算子を演算子オーバーロードしています。

Perlとオブジェクト指向

Perl のオブジェクト指向の特徴

クラスベースのオブジェクト指向
クラスは、package 構文の拡張
コンストラクターの中核は bless 関数
@ISA による継承機構
1. 単純継承だけでなく多重継承をサポート
overload モジュールを使うことで演算子オーバーロードが可能

具体的な実装例　

直交座標系の１点を表すクラス Point

use v5.30.0;
use feature 'signatures';
no warnings "experimental::signatures";
use POSIX ();

package Point {

    BEGIN {
        our @VERSION = '1.2.0';
    }

    sub new : prototype($$$) ( $class, $x = 0.0, $y = 0.0 ) {
        bless { x => $x, y => $y, }, $class;
    }

    use overload
        '""'  => sub ( $self, $p, $q ) {"Point($self->{x}, $self->{y})"},
        'abs' => sub ( $self, $p, $q ) { POSIX::hypot @$self{qw(x y)} };
    sub abs : prototype($) ($self) { POSIX::hypot @$self{qw(x y)} }
    sub angle ($self) { atan2 $self->{x}, $self->{y} }
}

package main {
    my $pt = Point->new( 3.0, 4.0 );

    print <<EOS;
\@Point::VERSION: @Point::VERSION
\$pt: $pt
abs \$pt: @{[ abs $pt ]}
\$pt->abs(): @{[ $pt->abs() ]}
\$pt->angle(): @{[ $pt->angle() ]}
\$pt->{x}: @{[ $pt->{x} ]}
\$pt->{y}: @{[ $pt->{y} ]}
\@\$pt{qw(x y)}: @{[ @$pt{qw(x y)} ]}
EOS
}

実行結果

@Point::VERSION: 1.2.0
$pt: Point(3, 4)
abs $pt: 5
$pt->abs(): 5
$pt->angle(): 0.643501108793284
$pt->{x}: 3
$pt->{y}: 4 
@$pt{qw(x y)}: 3 4

コンストラクター

コンストラクターはオブジェクトを返すサブルーチンです。他の多くの言語と同じく名前には new を使います。他の名前でも、データ構造をクラスに bless し返すサブルーチンは全てコンストラクターです。

コンストラクターの定義

    sub new : prototype($$$) ( $class, $x = 0.0, $y = 0.0 ) {
        bless { x => $x, y => $y, }, $class;
    }

use feature 'signatures';しているのでモダンでスタイリッシュですが

非シグネチャーでコンストラクターの定義

    sub new {
        my $class = shift;
        bless { x => shift // 0.0, y => shift // 0.0, }, $class;
    }

とも書けます。

コンストラクターの呼出し

  my $pt = Point->new(3.0, 4.0);

Point が隠れた第一引数として渡されます。

間接オブジェクト文法

  my $pt = new Point(3.0, 4.0);

これは、間接オブジェクト文法( indirect object notation )という構文ですが、v5.36で廃止されました。

bless

組込み関数blessは、コンストラクターの中核で、第一引数（典型的には $self という名前のハッシュ）と、第二引数の（典型的には $class と言う名前のパッケージ）を結びつけたインスタンス（クラスを実体化したオブジェクト）を戻値とします。bless の戻値を使ってメソッドやメンバーを参照します。

オブジェクトの内部構造 $self は、典型的にはハッシュが使われますが、これはハッシュはキー（名前）によって値を取り出すことができるためメンバーを表現するのに適しているためです。ほかのデータ構造、配列・スカラー・ファイルハンドルなどを内部構造にすることもあります。

クラス

クラスの宣言はpackage宣言によって行います。これはライブラリ・モジュールがパッケージを宣言するのと文法的には全く同じです。

メソッド

メソッドの定義は関数定義と同じsubによって行われます。メソッドは第一引数にオブジェクト（慣習として $self の名前が使われます）が渡されるサブルーチンです。

$pt->abs()

のようにしてアクセスされるメソッドは、

シグネチャー版

  sub abs($self) { POSIX::hypot($self->{x}, $self->{y}) }

のように定義されます。

非シグネチャー版

  sub abs {
    my $self = shift;
    POSIX::hypot($self->{x}, $self->{y})
  }

メンバー

bless でパッケージと結ぶ付けられたデータ構造にハッシュを使った場合、キーを名前とするメンバー変数として振舞います。

$pt->{x}
$pt->{y}

のようにリファレンスで参照します。

クラス変数

Perlでは、パッケージ変数がクラス変数に相当します。

$Point::VERSION

のように、パッケージ内でour宣言された変数（パッケージ変数）はクラス変数として振舞います。

デストラクター

オブジェクトへの最後の参照がなくなると、そのオブジェクトは破棄されます。

レキシカルスカラー変数（1つだけ）にオブジェクトへの参照が束縛されている場合、その変数がスコープを出たときにオブジェクトが破棄されます。
パッケージグローバル変数にオブジェクトへの参照が束縛されている場合、（その変数に別の値が入りでもしな限り）プログラム終了までオブジェクトは破棄されません。

このオブジェクトが「破棄」されるサブルーチンがデストラクターです。

DESTROY

デストラクターは、DESTROY と言う名前です（new と異なり名前は DESTROY 固定です）。

DESTROY メソッドはいつでも呼び出すことができるので、 DESTROY メソッドで行う何かによって設定されるかもしれないグローバルなステータス変数をローカル化しなければいけません。このため、DESTROYのプロローグは下のようなものになります。

sub DESTROY($self) {
    local($., $@, $!, $^E, $?);

    ...;
}

継承

オブジェクト指向プログラミングでは、既存のクラスから性質の部分的に異なるクラスを派生させることを継承といいます。

基底クラス
ベースクラス: 派生元のクラス
派生クラス
デライブドクラス: 派生先のクラス

$pt->abs();

としたとき、Perlは$pt属するクラス（＝パッケージ）にabsという名前のメソッドを探しにいきます。もし見つからなかった場合は、@ISAという特殊な配列に格納されているクラスにabsという名前のメソッドを探しにいきます。

@ISA

@ISAに基底クラスの名前を入れておくことで、継承を実現することができます。

単一継承

@ISA の要素数が１の継承は単一継承です。

単一継承

use v5.30.0;
use warnings;

package BaseClass {
    sub new     { bless {}, shift }
    sub hello   { say "hello I'm @{[ __PACKAGE__ ]}" }
    sub goodbye { say "goodbye I'm @{[ __PACKAGE__ ]}" }
}

package MyClass {

    BEGIN {
        our @ISA = qw(BaseClass);
    }

    sub new {
        my $class = shift;
        my $self  = $class->SUPER::new(@_);
        $self;
    }
    sub goodbye { say "goodbye I'm @{[ __PACKAGE__ ]}" }
}

my $mc = MyClass->new();
say qq(@{[ $mc->isa("MyClass") ? "t" : "()"]});
say qq(@{[ $mc->isa("BaseClass") ? "t" : "()" ]});
say qq(@{[ $mc->isa("OtherClass") ? "t" : "()" ]});
$mc->hello();
$mc->goodbye();

実行結果

t
t
()
hello I'm BaseClass 
goodbye I'm MyClass

多重継承

@ISAに複数のクラス名を列挙する継承が多重継承です。

多重継承

use v5.30.0;
use warnings;

package BaseClass1 {
    sub new     { bless {}, shift }
    sub hello   { say "hello I'm @{[ __PACKAGE__ ]}" }
    sub goodbye { say "goodbye I'm @{[ __PACKAGE__ ]}" }
}

package BaseClass2 {
    sub new     { bless {}, shift }
    sub hello   { say "hello I'm @{[ __PACKAGE__ ]}" }
    sub goodbye { say "goodbye I'm @{[ __PACKAGE__ ]}" }
}

package MyClass {

    BEGIN {
        our @ISA = qw(BaseClass1 BaseClass2);
    }

    sub new {
        my $class = shift;
        my $self  = $class->SUPER::new(@_);
        $self;
    }
}

my $mc = MyClass->new();
say qq(@{[ $mc->isa("MyClass") ? "t" : "()"]});
say qq(@{[ $mc->isa("BaseClass1") ? "t" : "()" ]});
say qq(@{[ $mc->isa("BaseClass2") ? "t" : "()" ]});
say qq(@{[ $mc->isa("OtherClass") ? "t" : "()" ]});
$mc->hello();
$mc->goodbye();

実行結果

t
t
t
()
hello I'm BaseClass1 
goodbye I'm BaseClass1

ここで問題なのは、my $self = $class->SUPER::new(@_);での SUPER は BaseClass1 でもう１つの基底クラス BaseClass2 はコンストラクターが呼ばれていない点です。

このコードでは、各基底クラスのプロパティは参照されていませんが、もしプロパティを参照するとBaseClass2のメソッドが未初期化プロパティの参照を引き起こします。

幾つかの対策が考えられますが

基底クラスごとにインスタンスをプロパティの１つとして保持する ⇒ それは継承でなく包含

最初の基底クラスのnewの戻値を次の基底クラスのnewにわたすのを繰返す ⇒ blessされたオブジェクトの再blessになる

基底クラスの１つしかプロパティを持たせず、ほかはメソッドのみ ⇒ それは Mix-in

と多重継承にはメソッドの呼出の優先順以上に超えなければいけない問題があります。

ダイアモンド継承

基底クラス同士が共通のクラスから派生されている継承関係をダイアモンド継承と呼びます。

ダイアモンド継承

use v5.30.0;
use warnings;

package BaseClass { }

package BaseClass1 {

    BEGIN {
        our @ISA = qw(BaseClass);
    }
}

package BaseClass2 {

    BEGIN {
        our @ISA = qw(BaseClass);
    }
}

package MyClass {

    BEGIN {
        our @ISA = qw(BaseClass1 BaseClass2);
    }
    sub new { bless {}, shift }
}

my $mc = MyClass->new();
say qq(@{[ $mc->isa("MyClass") ? "t" : "()"]});
say qq(@{[ $mc->isa("BaseClass1") ? "t" : "()" ]});
say qq(@{[ $mc->isa("BaseClass2") ? "t" : "()" ]});
say qq(@{[ $mc->isa("BaseClass") ? "t" : "()" ]});
say qq(@{[ $mc->isa("OtherClass") ? "t" : "()" ]});

実行結果

t
t
t
t 
()

Mix-in

Perlの多重継承では、2つ以上のコンストラクターを呼出すスマートな方法がないので、片方はコンストラクターを用意せず、メソッドセットとして実装することとなり、実質的に Mix-in になります。

Mix-in

use v5.30.0;
use feature 'signatures';
no warnings "experimental::signatures";

package Eachable {

    BEGIN {
        our @VERSION = '1.0.0';
    }

    sub reduce ( $self, $cbr, $init = undef ) {
        my $clone = "@{[ref $self]}"->new( $self->values() );
        while ( my @pair = $clone->each() ) {
            local $_ = $pair[1];
            $init = $cbr->( $init, $_ );
        }
        return $init;
    }

    sub foreach ( $self, $cbr ) {
        my $clone = "@{[ref $self]}"->new( $self->values() );
        while ( my @pair = $clone->each() ) {
            local $_ = $pair[1];
            $cbr->(@pair);
        }
        undef;
    }

    sub map ( $self, $cbr ) {
        my @result = ();
        my $clone  = "@{[ref $self]}"->new( $self->values() );
        while ( my @pair = $clone->each() ) {
            local $_ = $pair[1];
            push @result, $cbr->(@pair);
        }
        return Array->new(@result);
    }

    sub filter ( $self, $cbr ) {
        my @result = ();
        my $clone  = "@{[ref $self]}"->new( $self->values() );
        while ( my @pair = $clone->each() ) {
            local $_ = $pair[1];
            push @result, $_ if $cbr->(@pair);
        }
        return Array->new(@result);
    }

    sub sum ( $self, $cbr = undef ) {
        my $sum   = 0;
        my $c     = 0;
        my $clone = "@{[ref $self]}"->new( $self->values() );
        while ( my @pair = $clone->each() ) {
            local $_ = $pair[0];
            my @deltas = defined $cbr ? $cbr->(@pair) : @pair[ 1 .. 1 ];
            foreach my $delta (@deltas) {
                my $y = $delta - $c;
                my $t = $sum + $y;
                $c   = ( $t - $sum ) - $y;
                $sum = $t;
            }
        }
        return $sum;
    }

    sub every ( $self, $cbr ) {
        my $clone = "@{[ref $self]}"->new( $self->values() );
        while ( my @pair = $clone->each() ) {
            local $_ = $pair[1];
            $cbr->($_) ? 0 : return 0 != 0;
        }
        return 0 == 0;
    }

    sub some ( $self, $cbr ) {
        my $clone = "@{[ref $self]}"->new( $self->values() );
        while ( my @pair = $clone->each() ) {
            local $_ = $pair[1];
            $cbr->($_) ? return 0 == 0 : 0;
        }
        return 0 != 0;
    }
}

package Array {

    BEGIN {
        our @VERSION = '1.0.0';
        our @ISA     = qw(Eachable);
    }

    sub new ( $class, @ary ) {
        bless \@ary, $class;
    }
    use overload '""' => sub ( $self, $p, $q ) {"(@{[join ',', @$self ]})"};

    sub push    ( $self, @other ) { push @$self, @other; $self }
    sub unshift ( $self, @other ) { unshift @$self, @other; $self }
    sub pop     ($self)           { pop @$self;   $self }
    sub shift   ($self)           { shift @$self; $self }
    sub keys    ($self)           { keys @$self; }
    sub values  ($self)           { values @$self; }
    sub each    ($self)           { each @$self; }

    # sub splice; XXX

}

package Hash {

    BEGIN {
        our @VERSION = '1.0.0';
        our @ISA     = qw(Eachable);
    }

    sub new ( $class, $hash ) {

        #my %self = %$hash;
        #map { $self{$_} = $hash->{$_} } keys %$hash;
        bless \%$hash, $class;
    }
    use overload '""' => sub ( $self, $p, $q ) {qq!(@{[join ',', map { "$_=>$self->{$_}" } sort keys %$self ]})!};

    # XXX
    sub delete ( $self, $key ) { delete %$self{$key} }
    sub exists ( $self, $key ) { exists $$self{$key} }
    sub keys   ($self)         { keys %$self }
    sub values ($self)         { my %clone = %$self; \%clone }
    sub each   ($self)         { each %$self }
}

if ( $0 eq __FILE__ ) {
    use Test::More tests => 35;

    say "for Array:";
    my $ary = Array->new( 1 .. 3 );
    say 'my $ary = Array->new( 1 .. 3 );';
    ok( Array->new( 1 .. 10 )->reduce( sub { my ( $x, $y ) = @_; $x + $y } ) == 55,     "Array::reduce(1)" );
    ok( Array->new( 1 .. 10 )->reduce( sub { my ( $x, $y ) = @_; $x + $y }, 10 ) == 65, "Array::reduce(2)" );
    ok( do {
            my $i;
            $ary->foreach( sub { $i += $_ } );
            $i == 6;
        },
        "Array::foreach"
    );
    ok( "" . $ary->map( sub { $_ * 2 } ) eq "(2,4,6)",                      "Array::map @{[ $ary->map(sub{$_*2}) ]}" );
    ok( "" . $ary->filter( sub { $_ % 2 == 0 } ) eq "(2)",                  "Array::filter @{[ $ary->filter( sub { $_ % 2 == 0 } ) ]}" );
    ok( "" . $ary->sum == 6,                                                "Array::sum @{[ $ary->sum ]}" );
    ok( $ary->every( sub { $_ < 10 } ),                                     'Array::every $ary->every( sub { $_ < 10 } )' );
    ok( !$ary->every( sub { $_ < 3 } ),                                     'Array::every $ary->every( sub { $_ < 3 } )' );
    ok( !$ary->every( sub { $_ == 1 } ),                                    'Array::every $ary->every( sub { $_ == 1 } )' );
    ok( !$ary->every( sub { $_ == 100 } ),                                  'Array::every $ary->every( sub { $_ == 100 } )' );
    ok( $ary->some( sub { $_ < 10 } ),                                      'Array::every $ary->some( sub { $_ < 10 } )' );
    ok( $ary->some( sub { $_ < 3 } ),                                       'Array::every $ary->some( sub { $_ < 3 } )' );
    ok( $ary->some( sub { $_ == 1 } ),                                      'Array::every $ary->some( sub { $_ == 1 } )' );
    ok( !$ary->some( sub { $_ == 100 } ),                                   'Array::every $ary->some( sub { $_ == 100 } )' );
    ok( "" . $ary eq "(1,2,3)",                                             qq(Array::Operator "" --> $ary) );
    ok( "" . $ary->push(10) eq "(1,2,3,10)",                                "Array::push --> $ary" );
    ok( "" . $ary->push( 10, 11, 12 ) eq "(1,2,3,10,10,11,12)",             "Array::push --> $ary" );
    ok( "" . $ary->pop() eq "(1,2,3,10,10,11)",                             "Array::pop --> $ary" );
    ok( "" . $ary->unshift(10) eq "(10,1,2,3,10,10,11)",                    "Array::unshift --> $ary" );
    ok( "" . $ary->unshift( 10, 11, 12 ) eq "(10,11,12,10,1,2,3,10,10,11)", "Array::unshift --> $ary" );
    ok( "" . $ary->shift() eq "(11,12,10,1,2,3,10,10,11)",                  "Array::shift --> $ary" );
    ok( "@{[$ary->keys()]}" eq "0 1 2 3 4 5 6 7 8",                         "Array::keys @{[$ary->keys()]}" );
    ok( "@{[$ary->values()]}" eq "11 12 10 1 2 3 10 10 11",                 "Array::values @{[$ary->values()]}" );

    say 'for Hash:';
    my $hash = Hash->new( { a => 2, b => 3, c => 5, d => 7 } );
    ok( "@{[sort($hash->map(sub{$_*2})->values)]}" eq "10 14 4 6",             "Hash::map @{[ sort($hash->map(sub{$_*2})->values) ]}" );
    ok( "@{[ sort $hash->filter( sub { $_ % 2 != 0 } )->values ]}" eq "3 5 7", "Hash::filter @{[ sort $hash->filter( sub { $_ % 2 != 0 } )->values ]}" );
    ok( "" . $hash->sum == 17,                                                 "Hash::sum @{[ $hash->sum ]}" );
    ok( $hash->every( sub { $_ < 10 } ),                                       'Hash::every $hash->every( sub { $_ < 10 } )' );
    ok( !$hash->every( sub { $_ < 3 } ),                                       'Hash::every $hash->every( sub { $_ < 3 } )' );
    ok( !$hash->every( sub { $_ == 1 } ),                                      'Hash::every $hash->every( sub { $_ == 1 } )' );
    ok( !$hash->every( sub { $_ == 100 } ),                                    'Hash::every $hash->every( sub { $_ == 100 } )' );
    ok( $hash->some( sub { $_ < 10 } ),                                        'Hash::every $hash->some( sub { $_ < 10 } )' );
    ok( $hash->some( sub { $_ < 3 } ),                                         'Hash::every $hash->some( sub { $_ < 3 } )' );
    ok( $hash->some( sub { $_ == 2 } ),                                        'Hash::every $hash->some( sub { $_ == 2 } )' );
    ok( !$hash->some( sub { $_ == 100 } ),                                     'Hash::every $hash->some( sub { $_ == 100 } )' );
    ok( "" . $hash eq "(a=>2,b=>3,c=>5,d=>7)",                                 qq(Hash::Operator "" --> $hash) );
}

実行結果

1..35
for Array:
my $ary = Array->new( 1 .. 3 );
ok 1 - Array::reduce(1)
ok 2 - Array::reduce(2)
ok 3 - Array::foreach
ok 4 - Array::map (2,4,6)
ok 5 - Array::filter (2)
ok 6 - Array::sum 6
ok 7 - Array::every $ary->every( sub { $_ < 10 } )
ok 8 - Array::every $ary->every( sub { $_ < 3 } )
ok 9 - Array::every $ary->every( sub { $_ == 1 } )
ok 10 - Array::every $ary->every( sub { $_ == 100 } )
ok 11 - Array::every $ary->some( sub { $_ < 10 } )
ok 12 - Array::every $ary->some( sub { $_ < 3 } )
ok 13 - Array::every $ary->some( sub { $_ == 1 } )
ok 14 - Array::every $ary->some( sub { $_ == 100 } )
ok 15 - Array::Operator "" --> (1,2,3)
ok 16 - Array::push --> (1,2,3,10)
ok 17 - Array::push --> (1,2,3,10,10,11,12)
ok 18 - Array::pop --> (1,2,3,10,10,11)
ok 19 - Array::unshift --> (10,1,2,3,10,10,11)
ok 20 - Array::unshift --> (10,11,12,10,1,2,3,10,10,11)
ok 21 - Array::shift --> (11,12,10,1,2,3,10,10,11)
ok 22 - Array::keys 0 1 2 3 4 5 6 7 8
ok 23 - Array::values 11 12 10 1 2 3 10 10 11
for Hash:
ok 24 - Hash::map 10 14 4 6
ok 25 - Hash::filter 3 5 7
ok 26 - Hash::sum 17
ok 27 - Hash::every $hash->every( sub { $_ < 10 } )
ok 28 - Hash::every $hash->every( sub { $_ < 3 } )
ok 29 - Hash::every $hash->every( sub { $_ == 1 } )
ok 30 - Hash::every $hash->every( sub { $_ == 100 } )
ok 31 - Hash::every $hash->some( sub { $_ < 10 } )
ok 32 - Hash::every $hash->some( sub { $_ < 3 } )
ok 33 - Hash::every $hash->some( sub { $_ == 2 } )
ok 34 - Hash::every $hash->some( sub { $_ == 100 } )
ok 35 - Hash::Operator "" --> (a=>2,b=>3,c=>5,d=>7)

Array と Hash は、iterator メソッドだけ実装して、each,mapやsumメソッドは、共通祖先の Eachable で実装しています。

Eachable は、コンストラクターを持たないクラスで、インスタンス化することはなく繰返しを行うメソッドだけを提供しています。

sumは、カハンの加算アルゴリズムを実装しておりアルゴリズムは、Eachableの中に閉じています。

Test::Moreモジュールによる回帰テストを用意しました。

このように、メソッドセットを合成するクラス間の関係を、Mix-inといいます。

SUPER

SUPER擬似クラス( SUPER pseudo-class )は、常に基底クラスを指しています。基底クラスのメソッドを派生クラス内で呼び出す場合に使用します。

package MyClass {

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

[TODO:多事継承の場合のSUPERの振舞い]

base プラグマ

base プラグマは2022年11月現在、非推奨とされ parent プラグマの使用が推奨されています。少なくとも base は多重継承に対応していません。

base プラグマを使うと、基底クラスの定義に必要なuseや@ISAの代入から基底クラス内の変数や関数のインポートまでをすべて自動で行うことができます。

package BaseClass;

package MyClass;
use base qw(BaseClass);

parent プラグマ

このモジュールは、baseからフォークして、溜まっていたゴミを取り除いたものです。

package BaseClass;

package MyClass;
use base qw(BaseClass1 BaseClass2);

の様に使用しますが、これは実質的に

package BaseClass;

package MyClass;
BEGIN {
  require BaseClass1;
  require BaseClass2;
  push @ISA, qw(BaseClass1 BaseClass2)
}

と同じです（自分自身を継承しようとしているバグの検出は追加されています）。

この他にも、Class::Structの様にコンストラクターの自動生成などを行うモジュールなど、クラス定義を補助するユーティリティは幾つかありますが、手早くクラスとクラス階層の有効性を評価するのには便利ですが、クラス設計が完了した時点で、@ISAを直接操作する素朴なコードに書き換えたほうが保守性は向上します。

移植例

包含と継承

JavaScript/クラス#包含と継承を、Rubyに移植したコードを、OOPerl に移植しました。

包含と継承

use v5.20.0;
use feature 'signatures';
no warnings "experimental::signatures";

package Point {
  sub new($class, $x = 0, $y = 0) {
    bless { x => $x, y => $y }, $class
  }
  
  use overload '""' => sub ($self, $p, $q) { "x:$self->{x}, y:$self->{y}" };
  sub move($self, $dx = 0, $dy = 0) {
    $self->{x} += $dx;
    $self->{y} += $dy;
    $self
  }
}

package Shape {
  sub new($class, $x = 0, $y = 0) {
    bless { location => Point->new($x, $y) }, $class
  }
  use overload '""' => sub ($self, $p, $q) { "" . $self->{location} };
  sub to_string($self) { "" . $self->{location} }
  sub move($self, $x, $y) {
    $self->{location}->move($x, $y)
  }
  sub area($self) { "!!! Unimplemented !!!" }
}

package Rectangle {
  our @ISA = qw(Shape);

  sub new($class, $x = 0, $y = 0, $width = 0, $height = 0) {
    my $self = $class->SUPER::new($x, $y);
    $self->{width}  = $width;
    $self->{height} = $height;
    $self
  }
  use overload '""' => sub ($self, $p, $q) { "@{[ $self->SUPER::to_string() ]}, width:$self->{width}, height:$self->{height}" };
#  sub area($self) { $self->{width} * $self->{height} }
}

my $rct = Rectangle->new(12, 32, 100, 50);

print <<EOS;
\$rct --> $rct
\$rct->isa("Rectangle") --> @{[ $rct->isa("Rectangle") ? "true" : "false" ]}
\$rct->isa("Shape") --> @{[ $rct->isa("Shape") ? "true" : "false" ]}
\$rct->isa("Point") --> @{[ $rct->isa("Point") ? "true" : "false" ]}
EOS

$rct->move(11, 21);
say "\$rct --> $rct";
say "\$rct->area --> @{[ $rct->area ]}"

実行結果

$rct --> x:12, y:32, width:100, height:50
$rct->isa("Rectangle") --> true
$rct->isa("Shape") --> true
$rct->isa("Point") --> false
$rct --> x:23, y:53, width:100, height:50 
$rct->area --> !!! Unimplemented !!!

継承というと、メソッドをオーバーライドするのがまず頭に浮かびますが、派生クラスのメソッド中で基底クラスのメソッドを $self->SUPER::method(...) のように呼び出すことができます。

オブジェクト $rct は Rectangleクラスのインスタンスなので、$rct->isa("Rectangle") --> true

RectangleクラスはShapeクラスの派生クラスなので、$rct->isa("Shape") --> true

ShapeクラスはPointクラスを包含していますが、継承はしていないので $rct->isa("Point") --> false

$rct->area --> !!! Unimplemented !!! は、面積を返すメソッド area を Rectangle で実装していないので Shape の実装漏れチェックにランタイムで捕捉された様子。

Perlでは抽象クラスや抽象メソッドは直接はサポートされていないので、ユニットテストとクラス中のアサーションで対応することになります。

スーパークラスで実装されているオーバーロードされた演算子の呼出方法がわからなかったので to_string メソッドを定義しています。

シンボルテーブルを直接操作すればできそうですが、もう少しシンプルな方法がありそうな気がします。

脚註

このページ「Perl/ライブラリ・モジュールとオブジェクト指向」は、まだ書きかけです。加筆・訂正など、協力いただける皆様の編集を心からお待ちしております。また、ご意見などがありましたら、お気軽にトークページへどうぞ。

[1] 暗黙のstrict

[2] use v5.36

[1]

[2]