Search     or:     and:
 LINUX 
 Language 
 Kernel 
 Package 
 Book 
 Test 
 OS 
 Forum 
iakovlev.org
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 не находится в текущем каталоге ? Есть несколько вариантов :
  1. Эту директорию можно с помощью опции -I добавить в командной строке при запуске perl
  2. Использовать синтаксис use lib (Node) в самом коде
  3. Использовать в коде переменную @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.
Оставьте свой комментарий !

Ваше имя:
Комментарий:
Оба поля являются обязательными

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