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.
|
|
LINUX