File Coverage

blib/lib/Text/Keywords/Container.pm

Criterion	Covered	Total	%
statement	11	11	100.0
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	16	16	100.0

package Text::Keywords::Container;
BEGIN {
  $Text::Keywords::Container::AUTHORITY = 'cpan:GETTY';
}
BEGIN {
  $Text::Keywords::Container::VERSION = '0.900';
}
# ABSTRACT: Class for a container of serveral Text::Keywords::List

use 5.010;
use Moo;
use Text::Keywords::Found;

has lists => (
	is => 'ro',
	required => 1,
);

has shuffle => (
	is => 'ro',
	default => sub { 1 },
);

has use_secondary => (
	is => 'ro',
	default => sub { 1 },
);

has params => (
	is => 'ro',
	default => sub {{}},
);

sub find_keywords {
	my ( $self, $primary, $secondary ) = @_;
	$primary = $secondary if !$primary;
	return () if !$primary;
	my @founds;
	my @keywordlists;
	my $klpos = 0;
	for (@{$self->lists}) {
		push @keywordlists, [ $_, $_->count ];
	}
	while (@keywordlists) {
		my $klcount = scalar @keywordlists;
		my $idx = $klpos % $klcount;
		my $kl = $keywordlists[$idx];
		$klpos++;
		for my $keyword (@{$kl->[0]->keywords}[$kl->[0]->count - $kl->[1],$kl->[0]->count - 1]) {
			$kl->[1]--;
			my $found;
			splice(@keywordlists, $idx, 1) if (!$kl->[1]);
			my $rx = qr/(?:^|[^\w]|_)($keyword)(?:$|[^\w]|_)/i;
			my @text_found;
			my $primary_str = $primary;
			push (@text_found, [$primary_str =~ $rx]), $primary_str =~ s{$rx}{} while $primary_str =~ $rx;
			my @secondary_found;
			if ($secondary && $self->use_secondary) {
				my $con_str = $secondary;
				push (@secondary_found, [$con_str =~ $rx]), $con_str =~ s{$rx}{} while $con_str =~ $rx;
			}
			for (@text_found) {
				$found = 1;
				my @matches = @{$_};
				my $found_string = shift @matches;
				my $already_found = 0;
				for my $cur_found (@founds) {
					if ($cur_found->found eq $found_string and @{$cur_found->matches} ~~ @matches) {
						$already_found = 1; last;
					}
				}
				next if $already_found;
				my $found_in_secondary = 0;
				my $cidx = 0;
				for (@secondary_found) {
					my @cmatches = @{$_};
					my $found_cstring = shift @cmatches;
					if ($found_string eq $found_cstring and @matches ~~ @cmatches) {
						delete $secondary_found[$cidx];
					}
					$cidx++;
				}
				push @founds, $self->_new_found($found_string,1,$found_in_secondary,$kl->[0],$keyword,\@matches);
			}
			my @still_secondary_found;
			if (@text_found) {
				for (@secondary_found) {
					push @still_secondary_found, $_ if ($_);
				}
			} else {
				@still_secondary_found = @secondary_found;
			}
			for (@still_secondary_found) {
				$found = 1;
				my @matches = @{$_};
				my $found_string = shift @matches;
				my $already_found = 0;
				for my $cur_found (@founds) {
					if ($cur_found->found eq $found_string and @{$cur_found->matches} ~~ @matches) {
						$already_found = 1; last;
					}
				}
				next if $already_found;
				push @founds, $self->_new_found($found_string,0,1,$kl->[0],$keyword,\@matches);
			}
			last if $self->shuffle and $found;
		}
	}
	return @founds;
}

sub _new_found {
	my ( $self, $found, $in_primary, $in_secondary, $keywordlist, $keyword, $matches ) = @_;
	return Text::Keywords::Found->new({
		keyword => $keyword,
		found => $found,
		list => $keywordlist,
		matches => $matches,
		in_primary => $in_primary ? 1 : 0,
		in_secondary => $in_secondary ? 1 : 0,
		container => $self
	});
}

1;
__END__