--- /dev/null
+#!/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;
--- /dev/null
+#!/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} = <PKT>; chop($message{tname});
+ $message{fname} = <PKT>; chop($message{fname});
+ $message{subj} = <PKT>; chop($message{subj});
+ $message{body} = <PKT>; 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;
--- /dev/null
+#!/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;
+
--- /dev/null
+#!/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;
projects / fido.git / commitdiff