ru.perl

 
 - RU.PERL ----------------------------------------------------------------------
 From : Andrey Chernomyrdin                  2:5020/400     27 Oct 2005  11:46:25
 To : Andrew Alakozow
 Subject : Re: Q: Plugins
 -------------------------------------------------------------------------------- 
 

 Andrew Alakozow wrote:
 
 > AC> Хотелось-бы задать вопрос про использование plugin-ов в perl.
 > AC> Hет острого желания изобретать велосипед.
 > 
 > Модули (perldoc -q module, perldoc perlmod).
 > 
 > В Perl их можно подгружать  как во время компиляции (use module), так и во 
 > время исполнения (require module).
 
 Примерно понял, но кое-какие вопросы остались.
 
 Вот тут поизобретал (код см. ниже) смысл программы в том, что на STDIN поступает
 некий лог-файл, а соответствующие plugins 
 выхватывают из потока строки (используется метод pattern) и обрабатывают эти
 строки методом parse.
 
 - --[ main.pl ]-- -
 package main;
 use strict;
 use Application;
 use Plugin qw(Plugin::MyPlugin1 Plugin::MyPlugin2);
 
 my $a = Application->new(
     config_file => 'main.yaml',
     plugins     => Plugin->new( 'pattern' ),
 );
 
 while( <> ) {
     $a->parse( $_ );
 }
 
 - --[ Application.pm ]-- -
 package Application;
 use strict;
 use YAML;
 
 our     $VERSION = '1.0';
 
 sub new {
          my      $class  = shift;
          my      $self   = bless( {}, $class );
 
          $self->init( @_ );
 }
 sub plugin :lvalue {
          $_[0]->{plugin}->{ $_[1] }
 }
 sub config {
          my      $self   = shift;
          my      %base   = @_;
 
          if( defined $base{config_file} ) {
                  my $ptr = YAML::LoadFile( $base{config_file} );
 
                  @{ $self }{ keys %{ $ptr } } = values %{ $ptr };
          }
          @{ $self }{ keys %base } = values %base;
 }
 sub init {
          my      $self   = shift;
          my      @base   = @_;
 
          # Config
          $self->config( @base, base => \@base );
          # Load plugins
          $self->{plugin} = {};
          foreach ( $self->{plugins}->plugins('new', parent => $self ) ) {
                  my      $name = $_->name;
                  my      $pattern = $_->pattern;
 
                  $self->plugin( $name ) = $_;
                  $self->output( "\nFound: ", $name, " ...\n" );
                  $self->output( "\tpattern: ", $pattern, "\n" );
 
          }
 
          $self->gen_parse;
          return $self;
 }
 sub gen_parse {
          my      $self   = shift;
          my      $code   = '';
 
          while( my( $name, $ptr ) = each %{ $self->{plugin} } ) {
                  $code .= join("\n",
                          '       elsif( /' . $ptr->pattern . '/o ) {',
                          '               $self->plugin(' . "'$name'" .
 ')->parse($1 || $_);',
                          '       }','',
                  );
          }
          $code = join("\n",
                  'sub parse {',
                  '       my      $self   = shift;',
                  '       local   $_      = shift;','',
                  '       if( not defined $_ ) {',
                  '               return;',
                  '       }','',
                  $code,
                  '}',
                  '',
          );
          eval( $code );
          $self->output( "$@\n", $code ) if( $@ );
 }
 sub print {
          my      $self   = shift;
 
          print @_;
 }
 sub output { &print }
 1;
 
 - --[ Plugin.pm ]-- -
 package Plugin;
 use strict;
 use Carp;
 
 our     $VERSION        = '1.0';
 
 my      @List;
 
 sub import {
          my      $class  = shift;
 
          foreach ( @_ ) {
                  eval( "use $_" );
                  Carp::croak( "Error load plugin $_\: $@" ) if( $@ );
                  push( @List, $_ );
          }
          @List;
 }
 sub use { &import }
 sub new {
          my      $class  = shift;
          my      $method = shift || 'is_plugin';
          my      $self;
 
          foreach ( @List ) {
                  $self->{ $_ } = undef
                          if( $_->can( $method ) );
          }
          bless( $self, $class );
 }
 sub names { keys %{ $_[0] } }
 sub plugins {
          my      $self   = shift;
          my      $method = shift;
 
          if( defined $method and length $method ) {
                  $self->{$_} = $_->$method( @_ )
                          foreach ( $self->names );
                  return values %{ $self };
          }
          else {
                  return $self->names;
          }
 }
 sub plugin {
          my      $self   = shift;
          my      $name   = shift;
          my      $rc;
 
          if( defined $name and exists $self->{$name} ) {
                  $rc = (defined $self->{$name}) ?
                          $self->{$name} :
                          $name;
          }
          return $rc;
 }
 1;
 
 - --[ Plugin::Base.pm ]-- -
 package Plugin::Base;
 use strict;
 
 our     $VERSION        = '1.0';
 
 sub is_plugin { 1 }
 sub name { __PACKAGE__ }
 sub new {
          my      $class = shift;
          bless( { @_ }, $class );
 }
 # может как-то по-другому написать ?
 sub parent { $_[0]->{parent} || $_[0] }
 sub AUTOLOAD {
          my      $self   = shift;
          my      $method = our $AUTOLOAD;
 
          $method =~ s/.*:://o;
          $self->parent->can( $method ) and $self->parent->$method( @_ );
   # отсутствует обработка ошибок
 }
 1;
 
 - --[ Plugin::MyPlugin1 ]-- -
 package Plugin::MyPlugin1;
 
 use strict;
 use base qw{Plugin::Base};
 
 our $VERSION = '1.0';
 
 sub pattern { q{subsys1\[\d+\]:\s+(.*)$} }
 sub name { __PACKAGE__ }
 sub parse {
          my      $self   = shift;
 
          $self->parent->print(
                  $self->name,
                  "::parse(@_)\n"
          );
 }
 1;
 - --
 Plugin::MyPlugin2 - полная копия Plugin::MyPlugin1, только pattern другой.
 
 Все в принципе работает, осталось пара _но_ которая раздражает:
 Хотелось-бы что-бы избавится от метода parent внутри plugin-ов, как-нибудь это
 можно сделать ?
 Просто хотелось-бы пользоватся методами Application внутри plugin, кроме тех
 методов которые я переопределил в нем.
 
 В общем хотелось-бы объективной и конструктивной критики того, что сделано.
 
 > aa29 
 
 -- 
 Andrey Chernomyrdin
 
 --- ifmail v.2.15dev5.3
  * Origin: Demos online service (2:5020/400)
 
 

Вернуться к списку тем, сортированных по: возрастание даты  уменьшение даты  тема  автор