or:

and:

LINUX

Language

Kernel

Package

Book

Test

Forum

iakovlev.org

PERL OOP
Copyright (C) 1998-2002 by Steve Litt

Tutorial: Tree Traversing Class
Perl наследование
Загрузка модулей

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.

Оставьте свой комментарий !

Ваше имя:

Комментарий:

Оба поля являются обязательными

Автор	Комментарий к данной статье