/usr/lib/x86_64-linux-gnu/perl5/5.24/DBD/SQLite/VirtualTable/FileContent.pm is in libdbd-sqlite3-perl 1.54-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 | #======================================================================
package DBD::SQLite::VirtualTable::FileContent;
#======================================================================
use strict;
use warnings;
use base 'DBD::SQLite::VirtualTable';
my %option_ok = map {($_ => 1)} qw/source content_col path_col
expose root get_content/;
my %defaults = (
content_col => "content",
path_col => "path",
expose => "*",
get_content => "DBD::SQLite::VirtualTable::FileContent::get_content",
);
#----------------------------------------------------------------------
# object instanciation
#----------------------------------------------------------------------
sub NEW {
my $class = shift;
my $self = $class->_PREPARE_SELF(@_);
local $" = ", "; # for array interpolation in strings
# initial parameter check
!@{$self->{columns}}
or die "${class}->NEW(): illegal options: @{$self->{columns}}";
$self->{options}{source}
or die "${class}->NEW(): missing (source=...)";
my @bad_options = grep {!$option_ok{$_}} keys %{$self->{options}};
!@bad_options
or die "${class}->NEW(): bad options: @bad_options";
# defaults ... tempted to use //= but we still want to support perl 5.8 :-(
foreach my $k (keys %defaults) {
defined $self->{options}{$k}
or $self->{options}{$k} = $defaults{$k};
}
# get list of columns from the source table
my $src_table = $self->{options}{source};
my $sql = "PRAGMA table_info($src_table)";
my $dbh = ${$self->{dbh_ref}}; # can't use method ->dbh, not blessed yet
my $src_info = $dbh->selectall_arrayref($sql, {Slice => [1, 2]});
@$src_info
or die "${class}->NEW(source=$src_table): no such table in database";
# associate each source colname with its type info or " " (should eval true)
my %src_col = map { ($_->[0] => $_->[1] || " ") } @$src_info;
# check / complete the exposed columns
my @exposed_cols;
if ($self->{options}{expose} eq '*') {
@exposed_cols = map {$_->[0]} @$src_info;
}
else {
@exposed_cols = split /\s*,\s*/, $self->{options}{expose};
my @bad_cols = grep { !$src_col{$_} } @exposed_cols;
die "table $src_table has no column named @bad_cols" if @bad_cols;
}
for (@exposed_cols) {
die "$class: $self->{options}{content_col} cannot be both the "
. "content_col and an exposed col" if $_ eq $self->{options}{content_col};
}
# build the list of columns for this table
$self->{columns} = [ "$self->{options}{content_col} TEXT",
map {"$_ $src_col{$_}"} @exposed_cols ];
# acquire a coderef to the get_content() implementation, which
# was given as a symbolic reference in %options
no strict 'refs';
$self->{get_content} = \ &{$self->{options}{get_content}};
bless $self, $class;
}
sub _build_headers {
my $self = shift;
my $cols = $self->sqlite_table_info;
# headers : names of columns, without type information
$self->{headers} = [ map {$_->{name}} @$cols ];
}
#----------------------------------------------------------------------
# method for initiating a search
#----------------------------------------------------------------------
sub BEST_INDEX {
my ($self, $constraints, $order_by) = @_;
$self->_build_headers if !$self->{headers};
my @conditions;
my $ix = 0;
foreach my $constraint (grep {$_->{usable}} @$constraints) {
my $col = $constraint->{col};
# if this is the content column, skip because we can't filter on it
next if $col == 0;
# for other columns, build a fragment for SQL WHERE on the underlying table
my $colname = $col == -1 ? "rowid" : $self->{headers}[$col];
push @conditions, "$colname $constraint->{op} ?";
$constraint->{argvIndex} = $ix++;
$constraint->{omit} = 1; # SQLite doesn't need to re-check the op
}
# TODO : exploit $order_by to add ordering clauses within idxStr
my $outputs = {
idxNum => 1,
idxStr => join(" AND ", @conditions),
orderByConsumed => 0,
estimatedCost => 1.0,
estimatedRows => undef,
};
return $outputs;
}
#----------------------------------------------------------------------
# method for preventing updates
#----------------------------------------------------------------------
sub _SQLITE_UPDATE {
my ($self, $old_rowid, $new_rowid, @values) = @_;
die "attempt to update a readonly virtual table";
}
#----------------------------------------------------------------------
# file slurping function (not a method!)
#----------------------------------------------------------------------
sub get_content {
my ($path, $root) = @_;
$path = "$root/$path" if $root;
my $content = "";
if (open my $fh, "<", $path) {
local $/; # slurp the whole file into a scalar
$content = <$fh>;
close $fh;
}
else {
warn "can't open $path";
}
return $content;
}
#======================================================================
package DBD::SQLite::VirtualTable::FileContent::Cursor;
#======================================================================
use strict;
use warnings;
use base "DBD::SQLite::VirtualTable::Cursor";
sub FILTER {
my ($self, $idxNum, $idxStr, @values) = @_;
my $vtable = $self->{vtable};
# build SQL
local $" = ", ";
my @cols = @{$vtable->{headers}};
$cols[0] = 'rowid'; # replace the content column by the rowid
push @cols, $vtable->{options}{path_col}; # path col in last position
my $sql = "SELECT @cols FROM $vtable->{options}{source}";
$sql .= " WHERE $idxStr" if $idxStr;
# request on the index table
my $dbh = $vtable->dbh;
$self->{sth} = $dbh->prepare($sql)
or die DBI->errstr;
$self->{sth}->execute(@values);
$self->{row} = $self->{sth}->fetchrow_arrayref;
return;
}
sub EOF {
my ($self) = @_;
return !$self->{row};
}
sub NEXT {
my ($self) = @_;
$self->{row} = $self->{sth}->fetchrow_arrayref;
}
sub COLUMN {
my ($self, $idxCol) = @_;
return $idxCol == 0 ? $self->file_content : $self->{row}[$idxCol];
}
sub ROWID {
my ($self) = @_;
return $self->{row}[0];
}
sub file_content {
my ($self) = @_;
my $root = $self->{vtable}{options}{root};
my $path = $self->{row}[-1];
my $get_content_func = $self->{vtable}{get_content};
return $get_content_func->($path, $root);
}
1;
__END__
=head1 NAME
DBD::SQLite::VirtualTable::FileContent -- virtual table for viewing file contents
=head1 SYNOPSIS
Within Perl :
$dbh->sqlite_create_module(fcontent => "DBD::SQLite::VirtualTable::FileContent");
Then, within SQL :
CREATE VIRTUAL TABLE tbl USING fcontent(
source = src_table,
content_col = content,
path_col = path,
expose = "path, col1, col2, col3", -- or "*"
root = "/foo/bar"
get_content = Foo::Bar::read_from_file
);
SELECT col1, path, content FROM tbl WHERE ...;
=head1 DESCRIPTION
A "FileContent" virtual table is bound to some underlying I<source
table>, which has a column containing paths to files. The virtual
table behaves like a database view on the source table, with an added
column which exposes the content from those files.
This is especially useful as an "external content" to some
fulltext table (see L<DBD::SQLite::Fulltext_search>) : the index
table stores some metadata about files, and then the fulltext engine
can index both the metadata and the file contents.
=head1 PARAMETERS
Parameters for creating a C<FileContent> virtual table are
specified within the C<CREATE VIRTUAL TABLE> statement, just
like regular column declarations, but with an '=' sign.
Authorized parameters are :
=over
=item C<source>
The name of the I<source table>.
This parameter is mandatory. All other parameters are optional.
=item C<content_col>
The name of the virtual column exposing file contents.
The default is C<content>.
=item C<path_col>
The name of the column in C<source> that contains paths to files.
The default is C<path>.
=item C<expose>
A comma-separated list (within double quotes) of source column names
to be exposed by the virtual table. The default is C<"*">, which means
all source columns.
=item C<root>
An optional root directory that will be prepended to the I<path> column
when opening files.
=item C<get_content>
Fully qualified name of a Perl function for reading file contents.
The default implementation just slurps the entire file into a string;
but this hook can point to more sophisticated implementations, like for
example a function that would remove html tags. The hooked function is
called like this :
$file_content = $get_content->($path, $root);
=back
=head1 AUTHOR
Laurent Dami E<lt>dami@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright Laurent Dami, 2014.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
|