in reply to Re^5: Find Prefix if regex didn't match
in thread Find Prefix if regex didn't match

In my case I see that cutting works...

May be some more explanation is necessary: I'm reading (non-blocking) to a socket where a process running on another machine sends logging stuff to me. Sometimes I get many single characters sometimes I get large blocks. I don't know when I will receive the next package. A user can give me a regular expression I have to watch for and a timeout value. If I can match I return immediately if not I return after given timeout with an error.

Using expressions like "ABC" works quite fast and don't cause any problems with the timeout but not expressions like "AB.*Z". They only work as long as I get a few characters wihtin a few packages but not with thousands of them.

If I check the received string length and cut it after e.g. it gets larger than 20 characters I have no timeout problems any more and eth. works fine.
  • Comment on Re^6: Find Prefix if regex didn't match

Replies are listed 'Best First'.
Re^7: Find Prefix if regex didn't match
by Anonymous Monk on Oct 31, 2012 at 14:36 UTC
    Show code and prove it, its easy 
    #!/usr/bin/perl --
use Benchmark qw/ cmpthese /;
print "$]\n";
cmpthese(
    -3,
    {
        circumcised => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/gc; # fail one
            $what .='DBBBABC';
            pos($what) = 8;
            $what =~ /AB.*Z/gc; # fail another
            return;
        },
        uncut => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/gc; # fail one
            $what .='DBBBABC';
            $what =~ /AB.*Z/gc; # fail another
            return;
        },
    },
);

print "\n\n";


cmpthese(
    -3,
    {
        circumcised => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/gc; # fail one
            $what .='DBBBABCZ';
            pos($what) = 8;
            $what =~ /AB.*Z/gc; # match one
            return;
        },
        uncut => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/gc; # fail one
            $what .='DBBBABCZ';
            $what =~ /AB.*Z/gc; # match one
            return;
        },
    },
);
print "\n\n";

cmpthese(
    -3,
    {
        circumcised => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/gc; # fail one
            $what .='DBBBABCZ';
            substr $what, 0, 8, '';
            $what =~ /AB.*Z/gc; # match one
            return;
        },
        uncut => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/gc; # fail one
            $what .='DBBBABCZ';
            $what =~ /AB.*Z/gc; # match one
            return;
        },
    },
);
print "\n\n";
cmpthese(
    -3,
    {
        circumcised => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/; # fail one
            $what .='DBBBABCZ';
            substr $what, 0, 8, '';
            $what =~ /AB.*Z/; # match one
            return;
        },
        uncut => sub {
            my $what = 'WWWA';
            $what =~ /AB.*Z/; # fail one
            $what .='DBBBABCZ';
            $what =~ /AB.*Z/; # match one
            return;
        },
    },
);
print "\n\n";
__END__

    [download]
    5.014001
                 Rate circumcised       uncut
circumcised  370001/s          --        -70%
uncut       1245010/s        236%          --


                Rate circumcised       uncut
circumcised 301014/s          --        -41%
uncut       506153/s         68%          --


                Rate circumcised       uncut
circumcised 398024/s          --        -19%
uncut       492750/s         24%          --


                Rate circumcised       uncut
circumcised 554597/s          --        -26%
uncut       749156/s         35%          --

    [download]
[reply]
[d/l]
[select]
      Sorry, I haven't found any time spending on this topic the last days...

      Your benchmarks are not exactly what I thought about, what I have in my mind is: 
      #!/usr/bin/perl --
use Benchmark qw/ cmpthese /;
print "$]\n";
my $what1 = 'WWWA';
my $what2 = $what1;
cmpthese(
    -3,
    {
        circumcised => sub {
            $what1 =~ /EB.*Z/; # fail one
            $what1 .='DBBBABC';
            substr $what1, 0, 8, '';
            $what1 =~ /EB.*Z/; # fail another
            return;
        },
        uncut => sub {
            $what2 =~ /EB.*Z/; # fail one
            $what2 .='DBBBABC';
            $what2 =~ /EB.*Z/; # fail another
            return;
        },
    },
);

print "\n\n";
__END__

5.010001
                 Rate       uncut circumcised
uncut          2735/s          --       -100%
circumcised 3398892/s     124179%          --

      [download]
[reply]
[d/l]

        Your benchmarks are not exactly what I thought about, what I have in my mind is:

        I see :)

        <Reveal this spoiler or all in this thread>

        But, still, neither results seems very important , network is always much slower than both

[reply]
[d/l]

In Section Seekers of Perl Wisdom