view release on metacpan or  search on metacpan

lib/App/DuckPAN/Fathead.pm  view on Meta::CPAN

	return $dir;
}

has _trigger_words => (
	is      => 'ro',
	builder => 1,
	lazy    => 1,
);

sub _build__trigger_words {
	my ($self) = @_;
	my $tf = 'trigger_words.txt';
	return [] unless $self->has_selected;
	my $file = path("lib/fathead/", $self->selected, $tf);
	unless ($file->exists){
		my $full_path = $file->realpath;
		$self->app->emit_debug("No $tf was found in $full_path");
		return [];
	}
	chomp (my @words = $file->lines);
	return \@words;
}

has _trigger_re => (
	is      => 'ro',
	lazy    => 1,
	builder => 1,
);

sub _build__trigger_re {
	my ($self) = @_;
	my @words = @{$self->_trigger_words};
	my $text = join '|', map { quotemeta $_ } @words;
	return qr/\b(?:$text)\b/i;
}

has output_txt => (
	is => 'rwp',
	lazy => 1,
	required => 0
);

has dbh => (
	is => 'rw',
	lazy => 1,
	required => 0,
	builder => 1
);

sub _build_dbh {
	my ( $self ) = @_;

	# Open output.txt file for searching
	# Handles as a CSV with "\t" separator
	# Provide numbered column names
	my $dbh = DBI->connect ("dbi:CSV:", undef, undef, {
		f_dir                   => $self->output_txt->parent,
		f_ext                   => ".txt/r",
		csv_sep_char            => "\t",
		csv_quote_char          => undef,
		csv_escape_char         => undef,
		csv_allow_whitespace    => 1,
		csv_allow_quotes        => 1,
		RaiseError              => 1,
		PrintError              => 0,
		csv_tables => {
			output => {
				file => 'output.txt',
				col_names => [
					"title",
					"type",
					"redirect",
					"col4",
					"categories",
					"col6",
					"related_topics",
					"col8",
					"external_links",
					"disambiguation",
					"images",
					"abstract",
					"abstract_url",
				],
			},
		},
	}) or die $DBI::errstr;

	return $dbh;
}

# Get a Fathead result from the DB
# Requery when we get a Redirect
sub _search_output {

	my ($self, $query) = @_;

	my $trigger_re = $self->_trigger_re;
	$query =~ s/^$trigger_re\s+|\s+$trigger_re$//;
	my $result = $self->_db_lookup($query);

	while ($result && $result->{type} eq 'R') {
		my $redirect = $result->{redirect};
		$self->app->emit_notice("Following Redirect: '$result->{title}' -> '$redirect'");
		$result = $self->_db_lookup($redirect);
	}
	return $result;
}

# Attempt to get a result from DB (output.txt)
# Capture & display any raised errors
sub _db_lookup {
	my ($self, $query) = @_;

	my $result;
	$@ = '';

	eval {
		# TODO lowercase all titles first
		my $sth = $self->dbh->prepare("SELECT * FROM output WHERE lower(title) = ?");
		$sth->execute(lc $query);
		while (my $row = $sth->fetchrow_hashref) {