Search     or:     and:
 LINUX 
 Language 
 Kernel 
 Package 
 Book 
 Test 
 OS 
 Forum 
 iakovlev.org 
 Languages
 С
 GNU С Library 
 Qt 
 STL 
 Threads 
 C++ 
 Samples 
 stanford.edu 
 ANSI C
 Libs
 LD
 Socket
 Pusher
 Pipes
 Encryption
 Plugin
 Inter-Process
 Errors
 Deep C Secrets
 C + UNIX
 Linked Lists / Trees
 Asm
 Perl
 Python
 Shell
 Erlang
 Go
 Rust
 Алгоритмы
NEWS
Последние статьи :
  Тренажёр 16.01   
  Эльбрус 05.12   
  Алгоритмы 12.04   
  Rust 07.11   
  Go 25.12   
  EXT4 10.11   
  FS benchmark 15.09   
  Сетунь 23.07   
  Trees 25.06   
  Apache 03.02   
 
TOP 20
 Secure Programming for Li...6507 
 Linux Kernel 2.6...5279 
 Trees...1119 
 Максвелл 3...1051 
 William Gropp...990 
 Go Web ...963 
 Ethreal 3...930 
 Ethreal 4...918 
 Gary V.Vaughan-> Libtool...914 
 Ext4 FS...905 
 Clickhouse...901 
 Rodriguez 6...900 
 Ethreal 1...897 
 Steve Pate 1...886 
 C++ Patterns 3...864 
 Assembler...854 
 Ulrich Drepper...844 
 DevFS...788 
 MySQL & PosgreSQL...774 
 Стивенс 9...758 
 
  01.01.2024 : 3621733 посещений 

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.
Оставьте свой комментарий !

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

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