How to efficiently get a number of words from a text using perl?
I need to get the first ~50 words from a text for suplying exerpt to the users of my application. I did the following:
use strict;use warnings;use utf8;
binmode(STDOUT, ':utf8');
my $text = <<TXT;
Регулярните изрази ни позволяват да търсим шаблони в данните си.
Повечето букви и символи просто ще съвпадат със самите себе си.
Например, регулярният израз "test" просто и точно ще съвпада със
символния низ "test". Можете да включите режим,
нечувствителен към разликата между малки и големи букви, който ще
позволи да съвпадне също така и с "Test" или "TEST". Има изключения от
това правило, някои символи са особени и не съвпадат със
самите себе си. Вместо това те сигнализират...
TX开发者_开发百科T
my $c = 0;
my $collected = substr($text, 0, 10);
while ($text =~ /$collected/) {
$c += 10;
$collected = substr($text, 0, $c);
print $collected, $/;
#sleep 1;
my @words = split(/\s+/, $collected);
if (@words >= 49) { last; }
}
this works fine but I am concerned about the efficiency of the code.
Imagine that I havto do the same for many, many texts. There should be a smarter more perlish way, but I can not figure it out.
Thanks in advance.
If you define a "word" as "\S", you could do something like this:
$words = $1 if $text=~/^\s*((?:\S+(?:\s+|$)){0,50})/;
Try:
#!/usr/bin/env perl
use strict;
use warnings;
my $text = <<TXT;
Регулярните изрази ни позволяват да търсим шаблони в данните си.
Повечето букви и символи просто ще съвпадат със самите себе си.
Например, регулярният израз "test" просто и точно ще съвпада със
символния низ "test". Можете да включите режим,
нечувствителен към разликата между малки и големи букви, който ще
позволи да съвпадне също така и с "Test" или "TEST". Има изключения от
това правило, някои символи са особени и не съвпадат със
самите себе си. Вместо това те сигнализират...
TXT
my @words = $text =~ m/ \s* ( \S+ ) /gmsx;
$#words = 49;
print "@words\n";
You could get all the words then remove the excess as in shawnhcorey's solution, or you could stop when you have enough.
my @words;
push @words, $1 while @words < 50 && $text =~ /\s*(\S+)/g;
Update: Removed bad solution.
精彩评论