[Moscow.pm] POE::Filter::Line

[Ruslan Zakirov]

Можно файлом получить ето дело. Чтобы форматирование не билось.

On Sat, Mar 29, 2008 at 5:43 PM, Ivan B. Serezhkin <ivan на serezhkin.com> wrote:
> Привет.
>
>  В прошлом письме наврал, вместо индекса опять замерил регекс.
>
>           Rate   Line  Index Regexp
>  Line   4.78/s     --   -88%   -96%
>  Index  39.4/s   725%     --   -64%
>  Regexp  109/s  2191%   178%     --
>
>
>
>
>  freebsd7 stable perlmalloc
>  Rate Line Index Regexp
>  Line 4.74/s -- -96% -96%
>  Index 108/s 2188% -- -1%
>  Regexp 109/s 2208% 1% --
>
>  =code
>
>  use Storable qw(freeze dclone);
>  use Benchmark qw(:all) ;
>  use POE::Filter::Line;
>
>  my @s=map {join '', map { 'SEPARATOR'.'data'x(100+int(rand(100))) }
>  (1..100)} (1..10);
>  cmpthese(100, {
>  Regexp => sub {
>  my $data=dclone(\@s);
>  my $f=POE::Filter::Regexp->new(qr/SEPARATOR/);
>  $f->get($data);
>  },
>  Index => sub {
>  my $data=dclone(\@s);
>  my $f=POE::Filter::Regexp->new(qr/SEPARATOR/);
>  $f->get($data);
>  },
>  Line => sub {
>  my $data=dclone(\@s);
>  my $f=POE::Filter::Line->new(InputRegexp => qr/SEPARATOR/);
>  $f->get($data);
>  },
>  });
>
>
>
> package POE::Filter::Regexp;
>  use strict;
>
> use vars qw($VERSION);
>
>  $VERSION='Production 1.0';
>
>
> sub new {
>  my ($class,$re)=@_;
>  $re ||= qr/\n/;
>  die "Param in new must be a Regexp but this is a ".ref($re) unless ref
>  $re eq 'Regexp';
>  return bless [
>
> [], # ready queue
>  '', # raw unparsed data
>
> $re,
>  ], $class;
>  }
>
>  sub get {
>  my ($self, $stream) = @_;
>  my @ret;
>
> while($_=shift @$stream){
>  $self->[1].=$_;
>  $_=''; #yah we'r cl'r mems !!!111
>  my $p=0;
>  while($self->[1]=~/$self->[2]/gm) {
>
> next unless $-[0]; #begin of stream
>  push @ret, substr($self->[1], $p, $-[0]-$p);
>  $p=$-[0];
>  }
>
> substr($self->[1], 0, $p)='';
>  }
>  $self->[1]=''.$self->[1]; #Clean holes in string.
>  return \@ret;
>  }
>
>
>
>
>  package POE::Filter::Index;
>  use strict;
>  use vars qw($VERSION);
>
>  $VERSION='Devel';
>
>  sub new {
>  my ($class,$sep)=@_;
>  $sep ||= "\n";
>  return bless [
>  [], # ready queue
>  '', # raw unparsed data
>  $sep,
>
> ], $class;
>  }
>
>  sub get {
>  my ($self, $stream) = @_;
>  my @ret;
>
> while($_=shift @$stream){
>  $self->[1].=$_;
>  $_=''; #yah we'r cl'r mems 4 4ture iterations !!!111 one one
>  my $b=0; #base
>  while((my $p=index($self->[1], $self->[2], $b+1)) >0) {
>  push @ret, substr($self->[1], $b, $p-$b);
>  $b=$p;
>  }
>  substr($self->[1], 0, $b)='';
>  }
>  $self->[1]=''.$self->[1]; #Clean holes in string.
>  return \@ret;
>  }
>
>
>  =cut
>
>
>
>
>
>
>  Ruslan Zakirov wrote:
>
>
> > Набросал бенчмарк, но только простенький и последняя версия в слайдах
>  > была совершенно другой. Надеюсь подправите и вернете назад чтобы я мог
>  > варианты ss1 и ss2 привести к единому варианту ответа, пока они
>  > отличаются.
>  >
>  > amd64, gentoo, system malloc.
>  >
>  >        Rate   re  ss2  ss1
>  > re   6381/s   -- -51% -81%
>  > ss2 12961/s 103%   -- -62%
>  > ss1 34367/s 439% 165%   --
>  >
>  >
>  > 2008/3/17 Ivan B. Serezhkin <ivan на serezhkin.com>:
>  >
>  >> Привет.
>  >>  Может кому и интересно ?
>  >>  получил прирос в 25 раз на больших файлах.
>  >>  Можете поругать стиль =)
>  >>  На очереди сделать нормальный быстрый драйвер.
>  >>  И кстати, это удобный темплейт для написания своих фильтров, например
>  >>  POE::Filter::Log::Postfix =)
>  >>  Использовать так:
>  >>
>  >>  Wheel ...
>  >>  Driver => POE::Driver::SysRW->new( BlockSize => 256*1024*1024) ,
>  >>  Filter => POE::Filter::Regexp->new(qr/RecordSeparator/),
>  >>  ....
>  >>
>  >>
>  >>
>  >>  package POE::Filter::Regexp;
>  >>  use strict;
>  >>
>  >>  sub new {
>  >>  my ($class,$re)=@_;
>  >>  $re ||= qr/\n/;
>  >>  die "Param in new must be a Regexp but this is a ".ref($re) unless ref
>  >>  $re eq 'Regexp';
>  >>  return bless [
>  >>  '', # raw unparsed data
>  >>  [], # ready queue
>  >>  $re,
>  >>  ], $class;
>  >>  }
>  >>
>  >>  sub get {
>  >>  my ($self, $stream) = @_;
>  >>  my @ret;
>  >>  while($self->[0].=shift @$stream){
>  >>  my $p=0;
>  >>  while($self->[0]=~/$self->[2]/g) {
>  >>  next unless $-[0]; #begin of stream
>  >>  push @ret, substr($self->[0], $p, $-[0]-$p);
>  >>  $p=$-[0];
>  >>  }
>  >>  substr($self->[0], 0, $p)=undef;
>  >>  }
>  >>  return \@ret;
>  >>  }
>  >>  1;
>  >>
>  >>  --
>  >>  Ivan B. Serezhkin
>  >>
>  >>  --
>  >>  Moscow.pm mailing list
>  >>  moscow-pm на pm.org | http://moscow.pm.org
>  >>  http://mail.pm.org/mailman/listinfo/moscow-pm
>  >>
>  >
>  >
>  >
>  >
>  > ------------------------------------------------------------------------
>
>
> >
>  > --
>  > Moscow.pm mailing list
>  > moscow-pm на pm.org | http://moscow.pm.org
>  > http://mail.pm.org/mailman/listinfo/moscow-pm
>
>
>  --
>  Ivan B. Serezhkin
>
>
>  --
>  Moscow.pm mailing list
>  moscow-pm на pm.org | http://moscow.pm.org
>  http://mail.pm.org/mailman/listinfo/moscow-pm



-- 
Best regards, Ruslan.