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} で参照できます。
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スイッチ付きで実行したときや、コンパイルに失敗したときには実行されません。
モジュール
[編集]- 構文
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 による継承機構
- 単純継承だけでなく多重継承をサポート
- 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 メソッドを定義しています。
- シンボルテーブルを直接操作すればできそうですが、もう少しシンプルな方法がありそうな気がします。