98 lines
1.9 KiB
Perl
98 lines
1.9 KiB
Perl
|
|
|
|
###
|
|
### FlatDB_Composable.pm
|
|
###
|
|
|
|
## Chapter 7 section 4
|
|
|
|
package FlatDB_Composable;
|
|
use base 'FlatDB';
|
|
use base 'Exporter';
|
|
@EXPORT_OK = qw(query_or query_and query_not query_without);
|
|
use Iterator_Logic;
|
|
|
|
# usage: $dbh->query(fieldname, value)
|
|
# returns all records for which (fieldname) matches (value)
|
|
sub query {
|
|
my $self = shift;
|
|
my ($field, $value) = @_;
|
|
my $fieldnum = $self->{FIELDNUM}{uc $field};
|
|
return unless defined $fieldnum;
|
|
my $fh = $self->{FH};
|
|
seek $fh, 0, 0;
|
|
<$fh>; # discard header line
|
|
my $position = tell $fh;
|
|
my $recno = 0;
|
|
|
|
return sub {
|
|
local $_;
|
|
seek $fh, $position, 0;
|
|
while (<$fh>) {
|
|
chomp;
|
|
$recno++;
|
|
$position = tell $fh;
|
|
my @fields = split $self->{FIELDSEP};
|
|
my $fieldval = $fields[$fieldnum];
|
|
return [$recno, @fields] if $fieldval eq $value;
|
|
}
|
|
return;
|
|
};
|
|
}
|
|
|
|
|
|
## Chapter 7 section 4
|
|
|
|
BEGIN { *query_or = i_or(sub { $_[0][0] <=> $_[1][0] });
|
|
*query_and = i_and(sub { $_[0][0] <=> $_[1][0] });
|
|
}
|
|
|
|
|
|
## Chapter 7 section 4
|
|
|
|
BEGIN { *query_without = i_without(sub { $_[0][0] <=> $_[1][0] }); }
|
|
|
|
sub callbackquery {
|
|
my $self = shift;
|
|
my $is_interesting = shift;
|
|
my $fh = $self->{FH};
|
|
seek $fh, 0, SEEK_SET;
|
|
<$fh>; # discard header line
|
|
my $position = tell $fh;
|
|
my $recno = 0;
|
|
|
|
return sub {
|
|
local $_;
|
|
seek $fh, $position, SEEK_SET;
|
|
while (<$fh>) {
|
|
$position = tell $fh;
|
|
chomp;
|
|
$recno++;
|
|
my %F;
|
|
my @fieldnames = @{$self->{FIELDS}};
|
|
my @fields = split $self->{FIELDSEP};
|
|
for (0 .. $#fieldnames) {
|
|
$F{$fieldnames[$_]} = $fields[$_];
|
|
}
|
|
return [$recno, @fields] if $is_interesting->(%F);
|
|
}
|
|
return;
|
|
};
|
|
}
|
|
|
|
1;
|
|
|
|
|
|
## Chapter 7 section 4
|
|
|
|
sub query_not {
|
|
my $self = shift;
|
|
my $q = shift;
|
|
query_without($self->all, $q);
|
|
}
|
|
sub all {
|
|
$_[0]->callbackquery(sub { 1 });
|
|
}
|
|
|
|
1;
|