From: Sebastian Date: Wed, 4 Jun 2014 23:13:54 +0000 (+0200) Subject: modules: initial FIDOMAIL, MSGBASE, MISC, CONFIG X-Git-Url: http://sraa.de/git/?a=commitdiff_plain;h=00161605c296c6c2659d87f33ebdc3e565240680;p=fido.git modules: initial FIDOMAIL, MSGBASE, MISC, CONFIG FIDOMAIL: handles FTN style mail - read_packet_file: reads packed message file and parses headers to messages - read_message: reads and parses messages, generates mails (see docs/) - write_packet_file and write_message are stubbed so far MSGBASE: handles message base - area_list: list existing areas - area_open, area_close: connect/disconnect from area database - mail_add, mail_remove: add/remove mail from area - mail_search: search area for mails MISC: lots of helper functions - FTN-CHRS <-> charset map - read_datestring: parse different date formats - date2text / text2date: convert to/from "yyyy-mm-hh" - time2text / text2time: convert to/from "hh:mm:ss" - fido2text / text2fido: convert to/from "z:n/n.p" - netnodelist2text / text2netnodelist: converts parsed PATH/SEEN-BY kludges CONFIG: configuration store --- diff --git a/modules/CONFIG.pm b/modules/CONFIG.pm new file mode 100644 index 0000000..73bd38c --- /dev/null +++ b/modules/CONFIG.pm @@ -0,0 +1,23 @@ +#!/usr/bin/perl -w +use strict; +use v5.012; + +package CONFIG; + +our %config = ( + 'address' => [ 2, 240, 8001, 7 ], # my address + 'in_charset' => 'cp437', # input charset if unknown + + # Message Base + 'dbase_driver' => 'sqlite', + 'dbase_path' => '/home/basti/fido/msgbase', + 'dbase_user' => '', + 'dbase_pass' => '', + + # Special Areas + 'areafix' => 'AREAFIX', + 'netmail' => 'NETMAIL', + 'outbound' => 'OUTBOUND', +); + +1; diff --git a/modules/FIDOMAIL.pm b/modules/FIDOMAIL.pm new file mode 100644 index 0000000..4c8d119 --- /dev/null +++ b/modules/FIDOMAIL.pm @@ -0,0 +1,340 @@ +#!/usr/bin/perl -w +use strict; +use v5.012; + +use CONFIG; +use MISC; +use Data::Dumper; + +# ========================================================================= +# Perl module to handle FTN style mail +# +# mails are stored in the msgbase +# messages are stored in packet files +# +# read_message(): parse single message +# $mail = read_message($message) +# returns mail-hashref or undef on error +# +# write_message(): create message (TODO) +# $message = write_message($mail) +# takes mail-hashref +# returns message-hashref of undef on error +# +# read_packet_file(): parse *.PKT file +# $messages = read_packet_file($filename) +# returns arrayref of message-hashrefs or undef on error +# +# write_packet_file(): create *.PKT file (TODO) +# write_packet_file($filename, $messages) +# takes arrayref of message-hashrefs +# returns true on success, undef on error +# ========================================================================= + +package FIDOMAIL; +use Encode; + +my $addrregex = qr/^(|(\d+):)(\d+)\/(\d+)(|\.(\d+))(|\@([\w\.]+))$/; + # (zone, net, node, point, domain) = ($2, $3, $4, $6, $8) + +sub read_message($) +{ + my ($message) = @_; + my (%mail, @seenby, @path, $charset); + + # replace CRLF and CR with newlines + $message->{body} =~ s/\x0D\x0A/\n/g; + $message->{body} =~ s/\x0D/\n/g; + + # filter out area + $mail{area} = $2 if($message->{body} =~ s/^(\x01|)AREA:(.+)(\n)//); + + # parse buffer line by line + my $body = ""; + my ($intl, $fmpt, $topt); + foreach(split(/^/, $message->{body})) { + chomp; + + # PATH or SEEN-BY kludge + if(/^(\x01|)(PATH|SEEN-BY): (.*)$/) { + my ($net, $node); + my $key = $2; + foreach(split(/ /, $3)) { + if(/(\d+)\/(\d+)/) { + $net = $1; $node = $2; + } else { + $node = $_; + } + + if($key eq 'PATH') { + push(@{$mail{path}}, [$net, $node]); + } elsif($key eq 'SEEN-BY') { + push(@{$mail{seen}}, [$net, $node]); + } else { + die("Impossible keyword $key!"); + } + } + next; + } + + # kludge lines + if(/^\x01(\S+) (.+)$/) { + my ($kludge, $data) = ($1, $2); + if($kludge =~ /MSGID:/) { + $mail{msgid} = $data; + } elsif($kludge =~ /REPLY:/) { + $mail{reply} = $data; + } elsif($kludge =~ /PID:/) { + $mail{pid} = $data; + } elsif($kludge =~ /TID:/) { + $mail{tid} = $data; + } elsif($kludge =~ /(CHRS:|CHARSET)/) { + if($MISC::charsets{from}->{$data}) { + $charset = + $MISC::charsets{from}->{$data}; + } else { + warn("Unknown CHRS '$data'!"); + } + } elsif($kludge =~ /CODEPAGE/) { + if($MISC::charsets{from}->{"CP$data 2"}) { + $charset = + $MISC::charsets{from}->{"CP$data 2"}; + } else { + warn("Unknown CODEPAGE '$data'"); + } + } elsif($kludge =~ /INTL/) { + $intl = $data; + } elsif($kludge =~ /FMPT/) { + $fmpt = $data; + } elsif($kludge =~ /TOPT/) { + $topt = $data; + } elsif($kludge =~ /TZUTC|Via/) { + # FIXME: ignored + } else { + # FIXME: generic header + warn("Unknown kludge '$kludge' '$data'"); + } + next; + } + + # not a kludge line + $body .= "$_\n"; + } + + # build mail + $mail{fname} = $message->{fname}; + $mail{tname} = $message->{tname}; + $mail{date} = $message->{date}; + $mail{time} = $message->{time}; + $mail{attr} = $message->{attr}; + $mail{packet} = $message->{packet}; + + # decode subject and body to utf-8 + $charset = $CONFIG::config{in_charset} unless($charset); + $mail{subj} = decode($charset, $message->{subj}); + $mail{body} = decode($charset, $body); + + # find FROM and TO addresses + if(!$mail{area}) { + # --> NETMAIL + if($intl) { + if($intl=~ /^(\d+):(\d+)\/(\d+) (\d+):(\d+)\/(\d+)$/) { + if($fmpt) { + $mail{from} = [ $4, $5, $6, $fmpt ]; + } else { + $mail{from} = [ $4, $5, $6, 0 ]; + } + + if($topt) { + $mail{to} = [ $1, $2, $3, $topt ]; + } else { + $mail{to} = [ $1, $2, $3, 0 ]; + } + } else { + warn("Cannot parse INTL: '$intl'"); + } + } elsif($mail{packet}) { + warn("Took FROM/TO from packet!"); + $mail{from} = $mail{packet}->{from}; + $mail{to} = $mail{packet}->{to}; + } else { + warn("Don't know FROM/TO address!"); + $mail{from} = [ 0, 0, 0, 0 ]; + $mail{to} = [ 0, 0, 0, 0 ]; + } + } else { + # --> ECHOMAIL + if($mail{msgid} && $mail{msgid} =~ /^(\S+) \S+$/ && + $1 =~ $addrregex) { + # --> use MSGID + my @addr = ($2, $3, $4, $6, $8); + $addr[0] = $CONFIG::config{address}[0] + unless($addr[0]); + $addr[3] = 0 unless($addr[3]); + $mail{from} = [ @addr[0..3] ]; + } elsif($body =~ /\n \* Origin: (.*) \((.+?)\)\n/m && + $2 =~ $addrregex){ + # --> use Origin line + my @addr = ($2, $3, $4, $6); + $addr[0] = $CONFIG::config{address}[0] + unless($addr[0]); + $addr[3] = 0 unless($addr[3]); + $mail{from} = [ @addr[0..3] ]; + } else { + # --> use 0:0/0.0 as unknown address + warn "Don't know FROM address!"; + $mail{from} = [ 0, 0, 0, 0 ]; + } + } + + return(\%mail); +} + +sub write_message($) +{ + my ($mail) = @_; + + die("write_message not implemented"); +} + +sub read_packet_file($) +{ + my ($filename) = @_; + my ($buf, @messages); + + if(!$filename) { + die("read_packet_file() called without filename!"); + return(undef); + } + + if(!open(PKT, '<', "$filename")) { + die("Can't open packet file $filename!"); + return(undef); + } + binmode(PKT); + + # read packet header + if(read(PKT, $buf, 0x3a) != 0x3a) { + die("Corrupted packet file $filename: Too short!"); + close(PKT); + return(undef); + } + + # parse packet header + my ($onode, $dnode, $year, $month, $day, $hour, $minute, $second, + $baud, $type, $onet, $dnet, $prodL, $revMaj, $password, + $Qozone, $Qdzone, $auxnet, $cwcopy, $prodH, $revMin, $cw, + $ozone, $dzone, $opoint, $dpoint, $data) = unpack( + "v v v v v v v v v v v v C C Z8 v v v n C C v v v v v a4", $buf); + + if($type != 2) { + die("Unsupported packet file type $type!"); + close(PKT); + return(undef); + } + + my %packet; + if(($cw == $cwcopy) && ($cw != 0) && ($cw & 0x0001)) { + # FSC-0048 packet type 2+ + $onet = $auxnet if($onet == 0xFFFF && $opoint != 0); + $packet{from} = [ $ozone, $onet, $onode, $opoint ]; + $packet{to} = [ $dzone, $dnet, $dnode, $dpoint ]; + $packet{product} = ($prodH << 16) | $prodL; + $packet{revision} = "$revMaj.$revMin"; + $packet{type} = "FSC-0048"; + } else { + # FTS-0001 packet type 2 + $packet{from} = [ $Qozone, $onet, $onode, 0 ]; + $packet{to} = [ $Qdzone, $dnet, $dnode, 0 ]; + $packet{product} = $prodL; + $packet{revision} = "$revMaj"; + $packet{type} = "FTS-0001"; + } + $packet{date} = [ $year, $month, $day ]; + $packet{time} = [ $hour, $minute, $second ]; + + # read messages + while(1) { + # check message type + if(read(PKT, $buf, 2) != 2) { + die("Corrupted packet file $filename: Too short!"); + close(PKT); + return(undef); + } + my $type = unpack("v", $buf); + if($type == 0) { + close(PKT); + return(\@messages); + } elsif($type != 2) { + die("Unsupported message type $type!"); + close(PKT); + return(undef); + } + + # read message (FTS-0001) + if(read(PKT, $buf, 0x20) != 0x20) { + die("Corrupted packet file $filename: Too short!"); + close(PKT); + return(undef); + } + + # parse message + my %message; + my ($onode, $dnode, $onet, $dnet, $attr, $cost, $dt) = unpack( + "v v v v v v Z20", $buf); + do { + local $/ = "\0"; + $message{tname} = ; chop($message{tname}); + $message{fname} = ; chop($message{fname}); + $message{subj} = ; chop($message{subj}); + $message{body} = ; chop($message{body}); + }; + $message{from} = [ 0, $onet, $onode, 0 ]; + $message{to} = [ 0, $dnet, $dnode, 0 ]; + + # generate attribute word + $message{attr} = { }; + if($attr & 4) { # 2^2 + $message{attr}->{state} = 1; # received + } elsif($attr & 8) { # 2^3 + $message{attr}->{state} = 2; # sent + } else { + $message{attr}->{state} = 0; # local + } + + if($attr & 2) { # 2^1 + $message{attr}->{transfer} = 1; # crash + } elsif($attr & 512) { # 2^9 + $message{attr}->{transfer} = 2; # hold + } else { + $message{attr}->{transfer} = 0; # default + } + + if($attr & 16) { # 2^4 + $message{attr}->{file} = 1; # file attached + } elsif($attr & 2048) { # 2^11 + $message{attr}->{file} = 2; # file request + } elsif($attr & 32768) { # 2^15 + $message{attr}->{file} = 3; # update req. + } else { + $message{attr}->{file} = 0; # nothing + } + + my @dt = MISC::read_datestring($dt); + $message{date} = [ $dt[0], $dt[1], $dt[2] ]; + $message{time} = [ $dt[3], $dt[4], $dt[5] ]; + + # save message + $message{packet} = \%packet; + push @messages, \%message; + } +} + +sub write_packet_file($$) +{ + my ($filename, $messages) = @_; + + die("write_packet_file not implemented"); +} + +1; diff --git a/modules/MISC.pm b/modules/MISC.pm new file mode 100644 index 0000000..a5190ed --- /dev/null +++ b/modules/MISC.pm @@ -0,0 +1,183 @@ +#!/usr/bin/perl -w +use strict; +use v5.012; + +# ========================================================================= +# miscellanous helper functions +# %charsets: map ftn CHRS names to common charset names and back +# +# read_datestring(): turn a date/time string into list +# (y,m,d,h,m,s) = read_datestring($string) +# +# format converters (die on error) +# fido2text(): convert [ zone,net,node,point ] to "zone:net/node.point" +# text2fido(): convert "zone:net/node.point" to [ zone,net,node,point ] +# netnodelist2text(): convert [ [net,node], ... ] to "net/node,..." +# text2netnodelist(): convert "net/node,..." to [ [net,node], ... ] +# +# date2text(): convert [ year,month,day ] to "yyyy-mm-dd" +# text2date(): convert "yyyy-mm-dd" to [ year,month,day ] +# time2text(): convert [ hour,minute,second] to "hh:mm:ss" +# text2time(): convert "hh:mm:ss" to [ hour,minute,second ] +# ========================================================================= + +package MISC; + +# see FTS-5003 +our %charsets = ( + 'from' => { + # obsolete ascii replacement maps (treated as ascii) + 'ASCII 1' => 'ascii', + 'DUTCH 1' => 'ascii', + 'FINNISH 1' => 'ascii', + 'FRENCH 1' => 'ascii', + 'CANADIAN 1' => 'ascii', + 'GERMAN 1' => 'ascii', + 'ITALIAN 1' => 'ascii', + 'NORWEIG 1' => 'ascii', + 'PORTU 1' => 'ascii', + 'SPANISH 1' => 'ascii', + 'SWEDISH 1' => 'ascii', + 'SWISS 1' => 'ascii', + 'UK 1' => 'ascii', + 'ISO-10 1' => 'ascii', + + # codepage mappings + 'CP437 2' => 'cp437', + 'IBMPC 2' => 'cp437', + 'IBMPC' => 'cp437', + 'CP848 2' => 'cp848', + 'CP850 2' => 'cp850', + 'CP852 2' => 'cp852', + 'CP866 2' => 'cp866', + '+7_FIDO 2' => 'cp866', + 'CP1250 2' => 'cp1250', + 'CP1251 2' => 'cp1251', + 'CP1252 2' => 'cp1252', + 'CP10000 2' => 'MacRoman', + 'LATIN-1 2' => 'iso-8859-1', + 'LATIN-2 2' => 'iso-8859-2', + 'LATIN-5 2' => 'iso-8859-9', + 'LATIN-9 2' => 'iso-8859-15', + + # utf-8 + 'UTF-8 2' => 'utf-8', + 'UTF-8 4' => 'utf-8', + }, + 'to' => { + # if not listed here, use inverse 'from' mappings + 'cp437' => 'CP437 2', + 'cp866' => 'CP866 2', + 'utf-8' => 'UTF-8 4', + }, +); + +sub read_datestring($) +{ + my %months = ( + "Jan" => 0, "Feb" => 1, "Mar" => 2, "Apr" => 3, + "May" => 4, "Jun" => 5, "Jul" => 6, "Aug" => 7, + "Sep" => 8, "Oct" => 9, "Nov" => 10, "Dec" => 11, + ); + + $_ = shift; + my ($year, $month, $day, $hour, $minute, $second); + if(/(\w{3}) (\s\d|\d\d) (\w{3}) (\d{2}) (\d{2}):(\d{2})/) { + # SEAdog format: "Mon 1 Jan 86 02:34" + ($year, $month, $day) = ($4, $months{$3}, $2); + ($hour, $minute, $second) = ($5, $6, 0); + } elsif(/(\s\d|\d\d) (\w{3}) (\d{2}) (\d{2}):(\d{2}):(\d{2})/) { + # format: "21 Feb 14 02:30:31" + ($year, $month, $day) = ($3, $months{$2}, $1); + ($hour, $minute, $second) = ($4, $5, $6); + } else { + warn("Unknown date format '$_'"); + return(undef); + } + + if($year < 80) { + $year += 2000; # 21st century + } elsif($year < 200) { + $year += 1900; # 20th century (or non-y2k 21st century) + } + + # convert variables to integers and return + ($year, $month, $day) = (int($year), int($month), int($day)); + ($hour, $minute, $second) = (int($hour), int($minute), int($second)); + return($year, $month, $day, $hour, $minute, $second); +} + +sub fido2text($) +{ + return(undef) if(!defined $_[0]); + + my @fido = @{$_[0]}; + die("Invalid FTN address!") + unless(defined $fido[0] && defined $fido[1] && + defined $fido[2]); + + if($fido[3] && $fido[3] != 0) { + return("$fido[0]:$fido[1]/$fido[2].$fido[3]"); + } else { + return("$fido[0]:$fido[1]/$fido[2]"); + } +} + +sub text2fido($) +{ + return(undef) if(!defined $_[0]); + my $text = shift; + + if($text =~ /(\d+):(\d+)\/(\d+)\.(\d+)/) { + if($4 != 0) { + return([$1, $2, $3, $4]); + } else { + return([$1, $2, $3]); + } + } elsif($text =~ /(\d+):(\d+)\/(\d+)/) { + return([$1, $2, $3]); + } else { + die("Invalid FTN address '$text'!"); + } +} + +sub netnodelist2text($) +{ + return(undef) if(!defined $_[0]); + my @nnl = @{$_[0]}; + return(join(",", map { "$_->[0]/$_->[1]" } @nnl)); +} + +sub text2netnodelist($) +{ + my @result; + push(@result, [split(/\//, $_)]) foreach(split(/,/, $_[0])); + return(\@result); +} + +sub date2text($) +{ + my @date = @{$_[0]}; + return(sprintf("%04d-%02d-%02d", $date[0], $date[1], $date[2])); +} + +sub text2date($) +{ + return([$1, $2, $3]) if($_[0] =~ /(\d{4})-(\d{2})-(\d{2})/); + die("Invalid date '$_[0]'"); +} + +sub time2text($) +{ + my @time = @{$_[0]}; + return(sprintf("%02d:%02d:%02d", $time[0], $time[1], $time[2])); +} + +sub text2time($) +{ + return([$1, $2, $3]) if($_[0] =~ /(\d{2}):(\d{2}):(\d{2})/); + die("Invalid time '$_[0]'"); +} + +1; + diff --git a/modules/MSGBASE.pm b/modules/MSGBASE.pm new file mode 100644 index 0000000..8394d94 --- /dev/null +++ b/modules/MSGBASE.pm @@ -0,0 +1,230 @@ +#!/usr/bin/perl -w +use strict; +use v5.012; + +use DBI; + +use CONFIG; + +# Perl module to handle message base +# ========================================================================= +# +# area_list(): list existing areas +# @areas = area_list() +# returns array of strings or dies +# +# area_open(): open area, create if not exists +# $handle = area_open($name) +# returns handle or dies +# +# area_close(): close area +# area_close($handle) +# +# ------------------------------------------------------------------------- +# +# mail_add(): add mail to area +# mail_add($handle, $mail) +# $handle - handle to area +# $mail - mail-hashref +# returns true if successful, undef if duplicate, or dies on error +# +# mail_remove(): remove mail from area +# mail_remove($handle, $id) +# $handle - handle to area +# $id - 'id' field +# returns true if successful, undef if not found, or dies on error +# +# mail_search(): search for mails +# mail_search($handle, $data, $fields) +# $handle - handle to area +# $data - hashref { key => value, key => value, ... } +# $fields - (optional) arrayref of fieldnames, or undef for 'id' +# returns list of hashrefs { field => value } +# +# ========================================================================= + +package MSGBASE; + +sub area_list() +{ + my @areas; + + # SQLite: read folder to get list of databases + + if($CONFIG::config{dbase_driver} eq 'sqlite') { + opendir(MSGBASE, $CONFIG::config{dbase_path}) or + die("Can't open msgbase path: $!"); + while(readdir(MSGBASE)) { + next unless(/^(\S+)\.area$/); + push @areas, $1; + } + closedir(MSGBASE); + } else { + die("Unsupported database driver ". + "'$CONFIG::config{dbase_driver}'!"); + return(undef); + } + + return(@areas); +} + +sub area_open($) +{ + my ($area) = @_; + die("Don't use empty area name!") unless($area); + + # SQLite: connect to database file and create table, + # return hash containing area name, table name and db handle + + if($CONFIG::config{dbase_driver} eq 'sqlite') { + # SQLite: area equals database + my $file = "$CONFIG::config{dbase_path}/$area.area"; + my $table = $area; $table =~ s/\./_/g; + + my $dbh = DBI->connect("dbi:SQLite:dbname=$file", + $CONFIG::config{dbase_user}, + $CONFIG::config{dbase_pass}, + { 'AutoCommit' => 0, 'PrintError' => 1 } + ) or die("Can't connect to $file"); + $dbh->do("CREATE TABLE IF NOT EXISTS '$table' ( + 'id' INTEGER PRIMARY KEY, + 'from' TEXT, 'fname' TEXT, + 'to' TEXT, 'tname' TEXT, + 'date' TEXT, 'time' TEXT, + 'subj' TEXT, 'body' TEXT, + 'msgid' TEXT, 'reply' TEXT, + 'path' TEXT, 'seen' TEXT, + 'state' INTEGER, + 'transfer' INTEGER, + 'file' INTEGER + )") or die("Can't create table!"); + $dbh->commit or die("Can't commit!"); + my $handle = { + 'area' => $area, + 'table' => $table, + 'dbh' => $dbh, + }; + return($handle); + } else { + die("Unsupported database driver ". + "'$CONFIG::config{dbase_driver}'!"); + return(undef); + } + + die("Internal error!"); +} + +sub area_close($) +{ + my ($handle) = @_; + + # SQLite: commit and disconnect from database + + if($CONFIG::config{dbase_driver} eq 'sqlite') { + # SQLite: area equals database + $handle->{dbh}->commit(); + $handle->{dbh}->disconnect(); + return(1); + } else { + die("Unsupported database driver ". + "'$CONFIG::config{dbase_driver}'!"); + return(undef); + } + + die("Internal error!"); +} + +# ------------------------------------------------------------------------- + +sub mail_add($$) +{ + my ($handle, $mail) = @_; + + # dupe check + if($mail->{msgid}) { + my $dupes = $handle->{dbh}->selectrow_arrayref( + "SELECT msgid,fname,tname FROM + '$handle->{table}' WHERE msgid = ?;", + undef, + ( $mail->{msgid} ) + ); + if($dupes) { + warn(sprintf("DUPE: msgid='%s', '%s' => '%s'\n", + $dupes->[0], $dupes->[1], + $dupes->[2], $dupes->[3])); + return(undef); + } + } else { + warn("Adding mail without MSGID to $handle->{area}!"); + } + + # store mail in msgbase + my $rows = $handle->{dbh}->do("INSERT INTO $handle->{table} + ('from', 'fname', 'to', 'tname', 'date', 'time', + 'subj', 'body', 'msgid', 'reply', 'path', 'seen', + 'state', 'transfer', 'file') VALUES + (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);", + undef, + ( + MISC::fido2text($mail->{from}), $mail->{fname}, + MISC::fido2text($mail->{to}), $mail->{tname}, + MISC::date2text($mail->{date}), + MISC::time2text($mail->{time}), + $mail->{subj}, $mail->{body}, + $mail->{msgid}, $mail->{reply}, + MISC::netnodelist2text($mail->{path}), + MISC::netnodelist2text($mail->{seen}), + $mail->{attr}->{state}, + $mail->{attr}->{transfer}, + $mail->{attr}->{file}, + ) + ) or die("Failed to save mail!"); +} + +sub mail_remove($$) +{ + my ($handle, $id) = @_; + + my $rows = $handle->{dbh}->do( + "DELETE FROM $handle->{table} WHERE \"id\"=?;", + undef, + ( $id ), + ); + return($rows); +} + +sub mail_search($$;$) +{ + my ($handle, $data, $fields) = @_; + + # COLUMN clause + my $columns; + if(defined $fields) { + my @f = map { "\"$_\"" } @$fields; + $columns = join(",", @f); + } else { + $columns = "\"id\""; + } + + # WHERE clause + my (@k, @v); + foreach(keys %$data) { + if(defined $data->{$_}) { + push @k, "\"$_\" = ?"; + push @v, "$data->{$_}"; + } else { + push @k, "\"$_\" IS NULL"; + } + } + my $where = join(" AND ", @k); + + my $result = $handle->{dbh}->selectall_arrayref( + "SELECT $columns FROM $handle->{table} WHERE $where;", + { 'Slice' => {} }, + @v + ); + + return(@$result); +} + +1;