Re^8: Find Prefix if regex didn't match

[demoralizer]

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%          --

[Anonymous Monk]

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

I see :)

#!/usr/bin/perl --
use Benchmark qw/ cmpthese /;
print "$]\n";

my $what1 = my $what2 = my $orig = 'LMNOPQRSTUVWYXZWWWA';
my $pos1 = 0;
cmpthese(
    -3,
    {
        circumcised => sub {
            $what1 =~ /AB.*Z/gc; # fail one
            $what1 .='DBBBABC';
            $pos1+=8;
            pos($what1) = $pos1;
            $what1 =~ /AB.*Z/gc; # fail another
            return;
        },
        uncut => sub {
            $what2 =~ /AB.*Z/gc; # fail one
            $what2 .='DBBBABC';
            $what2 =~ /AB.*Z/gc; # fail another
            return;
        },
    },
);

print "length circumcised(@{[length $what1 ]}) uncut(@{[ length $what2
+ ]})\n\n";


$what1 = $what2 = $orig;
$pos1 = 0;
cmpthese(
    -3,
    {
        circumcised => sub {
            $what1 =~ /AB.*Z/gc; # fail one
            $what1 .='DBBBABCZ';
            $pos1+=8;
            pos($what1) = $pos1;
            $what1 =~ /AB.*Z/gc; # match one
            return;
        },
        uncut => sub {
            $what2 =~ /AB.*Z/gc; # fail one
            $what2 .='DBBBABCZ';
            $what2 =~ /AB.*Z/gc; # match one
            return;
        },
    },
);
print "length circumcised(@{[length $what1 ]}) uncut(@{[ length $what2
+ ]})\n\n";

$what1 = $what2 = $orig;
cmpthese(
    -3,
    {
        circumcised => sub {
            $what1 =~ /AB.*Z/gc; # fail one
            $what1 .='DBBBABCZ';
            substr $what1, 0, 8, '';
            $what1 =~ /AB.*Z/gc; # match one
            return;
        },
        uncut => sub {
            $what2 =~ /AB.*Z/gc; # fail one
            $what2 .='DBBBABCZ';
            $what2 =~ /AB.*Z/gc; # match one
            return;
        },
    },
);
print "length circumcised(@{[length $what1 ]}) uncut(@{[ length $what2
+ ]})\n\n";

$what1 = $what2 = $orig;
cmpthese(
    -3,
    {
        circumcised => sub {
            $what1 =~ /AB.*Z/; # fail one
            $what1 .='DBBBABCZ';
            substr $what1, 0, 8, '';
            $what1 =~ /AB.*Z/; # match one
            return;
        },
        uncut => sub {
            $what2 =~ /AB.*Z/; # fail one
            $what2 .='DBBBABCZ';
            $what2 =~ /AB.*Z/; # match one
            return;
        },
    },
);
print "length circumcised(@{[length $what1 ]}) uncut(@{[ length $what2
+ ]})\n\n";
__END__
5.014001
                Rate       uncut circumcised
uncut         2305/s          --       -100%
circumcised 517638/s      22360%          --
length circumcised(13175874) uncut(219812)

                Rate       uncut circumcised
uncut         2843/s          --        -99%
circumcised 361434/s      12614%          --
length circumcised(10770163) uncut(396371)

                Rate       uncut circumcised
uncut         2855/s          --       -100%
circumcised 579256/s      20188%          --
length circumcised(19) uncut(395315)

                Rate       uncut circumcised
uncut         2176/s          --       -100%
circumcised 435567/s      19915%          --
length circumcised(19) uncut(235675)

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

[demoralizer]

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

Yes, that's for sure meanwhile... in a previous versions I used $rec = <$term> instead of read($term, $rec, 0xFFFF) what came in my mind when I was writing one of my replies here and what definitely was the major reason for my timing problem because the log file I receive via TCP contains many new lines what caused much more matchings than necessary... so asking questions here has already fulfilled its purpose :)

But what has left, there is still a problem in my mind I haven't really solved yet, that is scanning for prefixes which could be a regular expression, not just a simple ASCII string. So I'm still wondering if there is really no possibility in pearl asking the regexp engine to tell me at which position it started matching when it reached the end of given string the first time even if it hasn't reached end of expression yet...

By the way many thanks for all your help, according to your astonishing response time I guess you live in front of your computer? ;)