PERL OOP
Copyright (C) 1998-2002 by Steve Litt
Tutorial: Tree Traversing Class
Создадим скриптовый файл Tree.pm.
#File Tree.pm, module for class Tree #The "package Tree" syntax declares it as a package (class) package Tree;
#The constructor is always called new(). It can take as many args #as required. sub new { #Arg0 is the type because the constructor will look like # my($instance) = Tree->new(arg1,arg2,whatever) #so arg0 will be Tree. my($type) = $_[0];
#Make subroutine-local var $self, and make it a reference. #Specifically, make it a reference to a (right now) empty hash. #Later on, that hash will contain object properties. my($self) = {};
#For now, we'll have one instance variable (property, whatever) #It will be in the hash referenced by $self, and will have #the index 'root'. This will be the first arg (inside the parentheses) #of the call to the constructor in the main program. $self->{'root'} = $_[1]; #remember $_[0] was the Tree before the ->
#There's nothing reserved about the word $self. It could have been #called $oodolaboodola. To link the object with both the hash pointed #to by $self and the type (Tree), we use the 2 argument version #of the keyword bless: bless($self, $type);
#Now finally, return the hash as a reference to be used as an "object" return($self); }
#Now make diagnostic routine tellroot to make sure everything's OK. sub tellroot { #first "find yourself". Once again, there's nothing reserved #about the word $self. We simply assume that whoever called tellroot #was smart enough to call it like $myinstance->tellroot(). my($self)=$_[0];
#Now that we have $self, we can get the root from the hash after #dereferencing. print "Root is $self->{'root'}.\n"; }
return(1); #package files must always return 1.
|
Создадим скриптовый файл main.pl
#main.pl
use Tree; #include the tree class file.
my($TreeObj) = Tree->new("c:\\"); #instantiate. Note that arg0 is Tree.
$TreeObj->tellroot(); #Note that arg0 is $TreeObj.
#This code should print out "C:\".
|
Запустив последний скрипт , мы увидим , что он распечатает "c:\".
Напишем следующую версию класса Tree
#File Tree.pm, module for class Tree package Tree;
sub new { my($type) = $_[0]; my($self) = {}; $self->{'root'} = $_[1]; #remember $_[0] was the Tree before the -> bless($self, $type); return($self); }
sub tellroot { my($self)=$_[0]; print "Root is $self->{'root'}.\n"; }
sub cruisetree { my($self) = $_[0]; #Find yourself
#*** Now call method onedir with self->onedir, NEVER &onedir *** $self->onedir($self->{'root'}); #note called with instance }
sub onedir { my($self) = $_[0]; #Find yourself my($dirname) = $_[1]; #Directory passed in
#*** Below this point there's nothing OOP, EXCEPT *** #*** EXCEPT for the line commented %%%% O O P %%%% *** opendir(DIR, $dirname); my(@Names) = readdir(DIR); closedir(DIR);
# Blow off possible trailing backslash before appending one. # Don't want 2 consecutive backslashes. if($dirname =~ /(.*)\\$/) {$dirname = $1;}
# Loop thru directory, handle files and directories my($Name); foreach $Name (@Names) { chomp($Name); my($Path) = "$dirname\\$Name"; if( -d $Path ) # if path represents a directory { if(($Name ne "..") && ($Name ne ".")) { print "Directory $Path...\n"; $self->onedir($Path); #%%%% O O P %%%% } } else # if path represents a file { print " File $Path\n" } } return; }
return(1); #package files must always return 1.
|
Перепишем main.pl :
#main.pl
use Tree; #include the tree class file.
my($TreeObj) = Tree->new("c:\\"); #instantiate. Note that arg0 is Tree.
$TreeObj->cruisetree(); #Note that arg0 is $TreeObj.
#This code should print out the entire c:\ tree.
|
Имеются 2 функции - одна для директории и другая для файла .
В обьект Tree передадим 2 параметра - путь и имя файла .
#File Tree.pm, module for class Tree package Tree;
sub new { my($type) = $_[0]; my($self) = {}; $self->{'root'} = $_[1]; #remember $_[0] was the Tree before the -> $self->{'dirfcn'} = $_[2]; $self->{'filefcn'} = $_[3]; bless($self, $type); return($self); }
sub tellroot { my($self)=$_[0]; print "Root is $self->{'root'}.\n"; }
sub cruisetree { my($self) = $_[0]; #Find yourself
#*** Now call method onedir with self->onedir, NEVER &onedir *** #*** Note that dirfcn and filefcn aren't passed *** #*** Because they're contained in $self and don't change *** $self->onedir($self->{'root'}); #note called with instance }
sub onedir { my($self) = $_[0]; #Find yourself my($dirname) = $_[1]; #Directory passed in
#*** Below this point there's nothing OOP, EXCEPT *** #*** EXCEPT for the line commented %%%% O O P %%%% *** opendir(DIR, $dirname); my(@Names) = readdir(DIR); closedir(DIR);
# Blow off possible trailing backslash before appending one. # Don't want 2 consecutive backslashes. if($dirname =~ /(.*)\\$/) {$dirname = $1;}
# Loop thru directory, handle files and directories my($Name); foreach $Name (@Names) { chomp($Name); my($Path) = "$dirname\\$Name"; if( -d $Path ) # if path represents a directory { if(($Name ne "..") && ($Name ne ".")) { &{$self->{'dirfcn'}}($Path, $Name); #%%%% O O P %%%% $self->onedir($Path); #%%%% O O P %%%% } } else # if path represents a file { &{$self->{'filefcn'}}($Path, $Name) #%%%% O O P %%%% } } return; }
return(1); #package files must always return 1.
|
#main.pl
use Tree; #include the tree class file.
my($TreeObj) = Tree->new("c:\\windows", \&showdir, \&showfile);
$TreeObj->cruisetree(); #Note that arg0 is $TreeObj.
sub showdir { print "Directory: $_[0] ...\n"; }
sub showfile { print " File: $_[0] ...\n"; } #This code should print out "C:\".
|
Perl наследование
Создадим в корневой директории 3 подкаталога:
- persontest
- personclass
- personclass/Person
Создадим Person class в $HOME/personclass каталоге.
package Person;
sub new { my($type) = $_[0]; my($self) = {}; $self->{'name'} = $_[1]; bless($self, $type); return($self); }
sub tellname { my($self)=$_[0]; print "Person name is $self->{'name'}.\n"; }
return(1);
|
В этом классе конструктор имеет 1 аргумент - имя персоны .
Функция tellname() печатает имя .
Создадим подкласс Person и назовем его Male.
Поместим этот клас в подкаталог $HOME/personclass/Person
Вот он - $HOME/personclass/Person/Male.pm:
use Person; #Children must know about their parents package Person::Male; #This class is called Person::Male
BEGIN{@ISA = qw ( Person );} #Declare this a child of the Person class
sub tellname { my($self)=$_[0]; print "Male name is $self->{'name'}.\n"; }
return(1);
|
Имя класса - Person::Male.
Он перегружает метод tellname(). Но он не перегружает базовый конструктор.
Теперь сделаем подкласс Female для базового класса Person, похожий на
Male. Код будет лежать в $HOME/personclass/Person/Female.pm:
use Person; #Children must know about their parents package Person::Female; #This class is called Person::Female
BEGIN{@ISA = qw ( Person );} #Declare this a child of the Person class
sub tellname { my($self)=$_[0]; print "Female name is $self->{'name'}.\n"; }
return(1);
|
Разница между Male и Female лишь в методе tellname() .
Теперь главная программа. Она может быть расположена где угодно , в отличие от подклассов.
Ее расширение может отличаться от pm.
#!/usr/bin/perl -w use strict;
use lib $ENV{"HOME"} . "/personclass" ; #Look for modules in this tree use Person; #The Person class use Person::Male; #The Male subclass of Person use Person::Female; #The Female subclass of Person
my($wr) = Person::Male->new("Doug"); #Make a Male $wr->tellname();
$wr = Person::Female->new("Tiffany"); #Make a Female $wr->tellname();
$wr = Person->new("Baby"); #Make a Person $wr->tellname();
|
Строка use lib указывает на путь , в котором нужно искать обьект Person
и его наследников .
Загрузка модулей
Рассмотрим строчку:
use Node;
Перл ищет файл Node.pm. Когда он его находит , файл загружается и сканируется .
Это происходит во время компиляции файла .
По сути , это эквивалентно следующему:
BEGIN { require Node; import Node; }
А что если Node.pm не находится в текущем каталоге ?
Есть несколько вариантов :
- Эту директорию можно с помощью опции -I добавить в командной строке при запуске perl
- Использовать синтаксис use lib (Node) в самом коде
- Использовать в коде переменную @INC
Например из командной строки:
perl -I /home/slitt/mymodules umenu.pl s
|
Или в заголовке самого файла :
#!/usr/bin/perl -w -I /home/slitt/mymodules
|
Или так :
use lib /home/slitt/mymodules;
|
Загрузка директории в рантайме
Такая необходимость иногда возникает .
Рассмотрим пример - пусть имеется конфиг-файл umenu.cnf,в который включена строка :
nodedir=/home/slitt/mymodules
Рассмотрим функцию loadNodeModule():
sub loadNodeModule() { my($conffile) = $ENV{'UMENU_CONFIG'}; $conffile = "./umenu.cnf" unless defined($conffile); print "Using config file $conffile.\n";
open CONF, '<' . $conffile or die "FATAL ERROR: Could not open config file $conffile."; my @lines = <CONF>; close CONF;
my @nodedirs; foreach my $line (@lines) { chomp $line; if($line =~ m/^\s*nodedir\s*=\s*([^\s]*)/) { my $dir = $1; if($dir =~ m/(.*)\$HOME(.*)/) { $dir = $1 . $ENV{'HOME'} . $2; } push @nodedirs, ($dir); } }
if(@nodedirs) { unshift @INC, @nodedirs; }
require Node; import Node; }
|
Информация из конфига грузится в массив , который парсится . И список каталогов из конфига
добавляется в @INC .
После чего загружается сам Node.pm.
|
|