# Selima Website Content Management System
# AddCol.pm: The data collector/handler for SQL/XML/CSV data output ("Model").

#  Copyright (c) 2004-2018 imacat.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.

# Author: imacat <imacat@mail.imacat.idv.tw>
# First written: 2004-09-26

package Selima::AddCol;
use 5.008;
use strict;
use warnings;

use Date::Parse qw(str2time);
use Digest::MD5 qw(md5_hex);
use Encode qw(encode decode is_utf8 FB_CROAK);

use Selima::Array;
use Selima::DataVars qw($DBH :addcol :input :lninfo);
use Selima::Format;
use Selima::GetLang;
use Selima::LogIn;
use Selima::Picture;
use Selima::ShortCut;

use constant TYPE_NULL => 0;
use constant TYPE_NUM => 1;
use constant TYPE_STR => 2;
use constant TYPE_DATE => 3;
use constant TYPE_IPADDR => 4;
use constant TYPE_FILE => 5;
use constant TYPE_BOOL => 6;
use constant TYPE_EXPR => 7;

# Prototype declaration
sub valout_sql($);
sub valout_xml($);
sub valout_csv($);

# new: Initialize the columns deposit
sub new : method {
    local ($_, %_);
    my ($class, $table, $optype, $self);
    ($class, $table, $optype) = @_;
    $optype = ADDCOL_UPDATE if !defined $optype;
    $self = bless {}, $class;
    $self->{"cols"} = [];
    $self->{"table"} = $table;
    $self->{"optype"} = $optype;
    if (defined $DBH) {
        $self->{"allcols"} = [$DBH->cols($table)];
        $self->{"mlcols"} = [$DBH->cols_ml($table)];
    } else {
        $self->{"allcols"} = [];
        $self->{"mlcols"} = [];
    }
    return $self;
}

# addstr: Add a modified string column to the columns deposit
#   Input:  $name:   The column name.
#           $val:    The column value.
#           $curval: The current value to be compared.
sub addstr : method {
    local ($_, %_);
    my ($self, $name, $val, $curval, $cur_exists, %col);
    ($self, $name, $val, $curval) = @_;
    $cur_exists = (scalar(@_) == 4);
    $curval = decode("UTF-8", $curval, FB_CROAK) if !defined $DBH;
    # Adjust the column name for multi-lingual columns
    $name .= "_" . getlang LN_DATABASE
        if in_array($name, @{$self->{"mlcols"}});
    
    # The new column value
    %col = qw();
    $col{"name"}        = $name;
    $col{"mod"}         = 0;
    # No value is supplied
    if (!defined $val || $val eq "") {
        $col{"type"}    = TYPE_NULL;
        $col{"value"}   = undef;
    # A valid value
    } else {
        $col{"type"}    = TYPE_STR;
        $col{"value"}   = $val;
    }
    
    # Check if we should set it
    if ($self->{"optype"} == ADDCOL_INSERT) {
        # Always set the value for INSERT
        $col{"mod"} = 1;
    
    } else {
        # A current value is supplied
        if ($cur_exists) {
            # This column had a value previously
            if (defined $curval) {
                # It has no value now.  Remove it.
                if ($col{"type"} == TYPE_NULL) {
                    $col{"mod"} = 1;
                # A different new value.  Modify it.
                } elsif ($col{"value"} ne $curval) {
                    $col{"mod"} = 1;
                }
            # This column had no value previously
            } else {
                # But it has a value now.
                if ($col{"type"} != TYPE_NULL) {
                    $col{"mod"} = 1;
                }
            }
        # No current value to compare with.
        } else {
            # Set it anyway
            $col{"mod"} = 1;
        }
    }
    # Check if we should set it
    # Add this column
    push @{$self->{"cols"}}, {%col};
    return;
}

# addstr_empty: Add a modified string column to the columns deposit,
#               where empty string is allowed
#   Input:  $name:   The column name.
#           $val:    The column value.
#           $curval: The current value to be compared.
sub addstr_empty : method {
    local ($_, %_);
    my ($self, $name, $val, $curval, $cur_exists, %col);
    ($self, $name, $val, $curval) = @_;
    $cur_exists = (scalar(@_) == 4);
    $curval = decode("UTF-8", $curval, FB_CROAK) if !defined $DBH;
    # Adjust the column name for multi-lingual columns
    $name .= "_" . getlang LN_DATABASE
        if in_array($name, @{$self->{"mlcols"}});
    
    # The new column value
    %col = qw();
    $col{"name"}        = $name;
    $col{"mod"}         = 0;
    # No value is supplied
    if (!defined $val) {
        $col{"type"}    = TYPE_NULL;
        $col{"value"}   = undef;
    # A valid value
    } else {
        $col{"type"}    = TYPE_STR;
        $col{"value"}   = $val;
    }
    
    # Check if we should set it
    if ($self->{"optype"} == ADDCOL_INSERT) {
        # Always set the value for INSERT
        $col{"mod"} = 1;
    
    } else {
        # A current value is supplied
        if ($cur_exists) {
            # This column had a value previously
            if (defined $curval) {
                # It has no value now.  Remove it.
                if ($col{"type"} == TYPE_NULL) {
                    $col{"mod"} = 1;
                # A different new value.  Modify it.
                } elsif ($col{"value"} ne $curval) {
                    $col{"mod"} = 1;
                }
            # This column had no value previously
            } else {
                # But it has a value now.
                if ($col{"type"} != TYPE_NULL) {
                    $col{"mod"} = 1;
                }
            }
        # No current value to compare with.
        } else {
            # Set it anyway
            $col{"mod"} = 1;
        }
    }
    # Check if we should set it
    # Add this column
    push @{$self->{"cols"}}, {%col};
    return;
}

# addurl: Add a modified URL to the columns deposit,
#         where "http://" also means empty
#   Input:  $name:   The column name.
#           $val:    The column value.
#           $curval: The current value to be compared.
sub addurl : method {
    local ($_, %_);
    my ($self, $name, $val, $curval, $cur_exists, %col);
    ($self, $name, $val, $curval) = @_;
    $cur_exists = (scalar(@_) == 4);
    $curval = decode("UTF-8", $curval, FB_CROAK) if !defined $DBH;
    # Adjust the column name for multi-lingual columns
    $name .= "_" . getlang LN_DATABASE
        if in_array($name, @{$self->{"mlcols"}});
    
    # The new column value
    %col = qw();
    $col{"name"}        = $name;
    $col{"mod"}         = 0;
    # No value is supplied
    if (!defined $val || $val eq "" || $val eq "http://") {
        $col{"type"}    = TYPE_NULL;
        $col{"value"}   = undef;
    # A valid value
    } else {
        $col{"type"}    = TYPE_STR;
        $col{"value"}   = $val;
    }
    
    # Check if we should set it
    if ($self->{"optype"} == ADDCOL_INSERT) {
        # Always set the value for INSERT
        $col{"mod"} = 1;
    
    } else {
        # A current value is supplied
        if ($cur_exists) {
            # This column had a value previously
            if (defined $curval) {
                # It has no value now.  Remove it.
                if ($col{"type"} == TYPE_NULL) {
                    $col{"mod"} = 1;
                # A different new value.  Modify it.
                } elsif ($col{"value"} ne $curval) {
                    $col{"mod"} = 1;
                }
            # This column had no value previously
            } else {
                # But it has a value now.
                if ($col{"type"} != TYPE_NULL) {
                    $col{"mod"} = 1;
                }
            }
        # No current value to compare with.
        } else {
            # Set it anyway
            $col{"mod"} = 1;
        }
    }
    # Add this column
    push @{$self->{"cols"}}, {%col};
    return;
}

# addpass: Add a modified password to the columns deposit,
#          where "" means "not changed".  Passwords are never empty.
#   Input:  $name:   The column name.
#           $purge:  If we should purge the password.
#           $val:    The column value.
#           $curval: The current value to be compared.
sub addpass : method {
    local ($_, %_);
    my ($self, $name, $purge, $val, $curval, $cur_exists, %col);
    ($self, $name, $purge, $val, $curval) = @_;
    $cur_exists = (@_ == 5);
    $curval = decode("UTF-8", $curval, FB_CROAK) if !defined $DBH;
    # Adjust the column name for multi-lingual columns
    $name .= "_" . getlang LN_DATABASE
        if in_array($name, @{$self->{"mlcols"}});
    
    # The new column value
    %col = qw();
    $col{"name"}        = $name;
    $col{"mod"}         = 0;
    # Purge the password with a dummy one
    if ($purge) {
        $col{"type"}    = TYPE_STR;
        $col{"value"}   = "x" x 32;
    # No value is supplied
    } elsif (!defined $val || $val eq "") {
        $col{"type"}    = TYPE_NULL;
        $col{"value"}   = undef;
    # A valid value
    } else {
        $col{"type"}    = TYPE_STR;
        %_ = map { ${$_}{"name"} => $_ } @{$self->{"cols"}};
        $col{"value"}   = md5_hex(${$_{"id"}}{"value"} . ":magicat:" . $val);
    }
    
    # Check if we should set it
    if ($self->{"optype"} == ADDCOL_INSERT) {
        # Always set the value for INSERT
        $col{"mod"} = 1;
    
    } else {
        # A current value is supplied
        if ($cur_exists) {
            # A different new value.  Modify it.
            if ($col{"type"} != TYPE_NULL && $col{"value"} ne $curval) {
                $col{"mod"} = 1;
            }
        # No current value to compare with.
        } else {
            # Set it anyway
            $col{"mod"} = 1;
        }
    }
    # Add this column
    push @{$self->{"cols"}}, {%col};
    return;
}

# addpic: Add a picture to the columns deposit
#   Input:  $name:   The column name.
#           $val:    The column value.
#           $curval: The current value to be compared.
sub addpic : method {
    local ($_, %_);
    my ($self, $name, $val, $curval, $cur_exists, %col, $PICS);
    ($self, $name, $val, $curval) = @_;
    $cur_exists = (scalar(@_) == 4);
    $curval = decode("UTF-8", $curval, FB_CROAK) if !defined $DBH;
    $PICS = pic_deposit;
    # Set the 3rd argument as the current value
    if ($cur_exists) {
        # Get the picture content
        $curval = ${$$PICS{$curval}}{"content"}
            if defined $curval;
    }
    # Adjust the column name for multi-lingual columns
    $name .= "_" . getlang LN_DATABASE
        if in_array($name, @{$self->{"mlcols"}});
    
    # The new column value
    %col = qw();
    $col{"name"}        = $name;
    $col{"mod"}         = 0;
    # No value is supplied
    if (!defined $val) {
        $col{"type"}    = TYPE_NULL;
        $col{"value"}   = undef;
    # A valid value
    } else {
        $col{"type"}    = TYPE_FILE;
        $col{"value"}   = ${$$PICS{$val}}{"content"}
    }
    
    # Check if we should set it
    if ($self->{"optype"} == ADDCOL_INSERT) {
        # Always set the value for INSERT
        $col{"mod"} = 1;
    
    } else {
        # A current value is supplied
        if ($cur_exists) {
            # This column had a value previously
            if (defined $curval) {
                # It has no value now.  Remove it.
                if ($col{"type"} == TYPE_NULL) {
                    $col{"mod"} = 1;
                # A different new value.  Modify it.
                } elsif ($col{"value"} ne $curval) {
                    $col{"mod"} = 1;
                }
            # This column had no value previously
            } else {
                # But it has a value now.
                if ($col{"type"} != TYPE_NULL) {
                    $col{"mod"} = 1;
                }
            }
        # No current value to compare with.
        } else {
            # Set it anyway
            $col{"mod"} = 1;
        }
    }
    # Add this column
    push @{$self->{"cols"}}, {%col};
    return;
}

# addnum: Add a modified numeric column to the columns deposit
#   Input:  $name:   The column name.
#           $val:    The column value.
#           $curval: The current value to be compared.
sub addnum : method {
    local ($_, %_);
    my ($self, $name, $val, $curval, $cur_exists, %col);
    ($self, $name, $val, $curval) = @_;
    $cur_exists = (scalar(@_) == 4);
    $curval = decode("UTF-8", $curval, FB_CROAK) if !defined $DBH;
    # Adjust the column name for multi-lingual columns
    $name .= "_" . getlang LN_DATABASE
        if in_array($name, @{$self->{"mlcols"}});
    
    # The new column value
    %col = qw();
    $col{"name"}        = $name;
    $col{"mod"}         = 0;
    # No value is supplied
    if (!defined $val || $val eq "") {
        $col{"type"}    = TYPE_NULL;
        $col{"value"}   = undef;
    # A valid value
    } else {
        $col{"type"}    = TYPE_NUM;
        $col{"value"}   = $val;
    }
    
    # Check if we should set it
    if ($self->{"optype"} == ADDCOL_INSERT) {
        # Always set the value for INSERT
        $col{"mod"} = 1;
    
    } else {
        # A current value is supplied
        if ($cur_exists) {
            # This column had a value previously
            if (defined $curval) {
                # It has no value now.  Remove it.
                if ($col{"type"} == TYPE_NULL) {
                    $col{"mod"} = 1;
                # A different new value.  Modify it.
                } elsif ($col{"value"} != $curval) {
                    $col{"mod"} = 1;
                }
            # This column had no value previously
            } else {
                # But it has a value now.
                if ($col{"type"} != TYPE_NULL) {
                    $col{"mod"} = 1;
                }
            }
        # No current value to compare with.
        } else {
            # Set it anyway
            $col{"mod"} = 1;
        }
    }
    # Add this column
    push @{$self->{"cols"}}, {%col};
    return;
}

# adddate: Add a modified date column to the columns deposit
#          Mostly the same as addstr().  Different when out.
#   Input:  $name:   The column name.
#           $val:    The column value.
#           $curval: The current value to be compared.
sub adddate : method {
    local ($_, %_);
    my ($self, $name, $val, $curval, $cur_exists, %col);
    ($self, $name, $val, $curval) = @_;
    $cur_exists = (scalar(@_) == 4);
    $curval = decode("UTF-8", $curval, FB_CROAK) if !defined $DBH;
    # Adjust the column name for multi-lingual columns
    $name .= "_" . getlang LN_DATABASE
        if in_array($name, @{$self->{"mlcols"}});
    
    # The new column value
    %col = qw();
    $col{"name"}        = $name;
    $col{"mod"}         = 0;
    # No value is supplied
    if (!defined $val || $val eq "") {
        $col{"type"}    = TYPE_NULL;
        $col{"value"}   = undef;
    # A valid value
    } else {
        $col{"type"}    = TYPE_DATE;
        $col{"value"}   = $val;
    }
    
    # Check if we should set it
    if ($self->{"optype"} == ADDCOL_INSERT) {
        # Always set the value for INSERT
        $col{"mod"} = 1;
    
    } else {
        # A current value is supplied
        if ($cur_exists) {
            # This column had a value previously
            if (defined $curval) {
                # It has no value now.  Remove it.
                if ($col{"type"} == TYPE_NULL) {
                    $col{"mod"} = 1;
                # A different new value.  Modify it.
                } elsif (str2time($col{"value"}) != $curval) {
                    $col{"mod"} = 1;
                }
            # This column had no value previously
            } else {
                # But it has a value now.
                if ($col{"type"} != TYPE_NULL) {
                    $col{"mod"} = 1;
                }
            }
        # No current value to compare with.
        } else {
            # Set it anyway
            $col{"mod"} = 1;
        }
    }
    # Add this column
    push @{$self->{"cols"}}, {%col};
    return;
}

# addipaddr: Add a modified IP address column to the columns deposit
#            Mostly the same as addstr().  Different when out.
#   Input:  $name:   The column name.
#           $val:    The column value.
#           $curval: The current value to be compared.
sub addipaddr : method {
    local ($_, %_);
    my ($self, $name, $val, $curval, $cur_exists, %col);
    ($self, $name, $val, $curval) = @_;
    $cur_exists = (scalar(@_) == 4);
    $curval = decode("UTF-8", $curval, FB_CROAK) if !defined $DBH;
    # Adjust the column name for multi-lingual columns
    $name .= "_" . getlang LN_DATABASE
        if in_array($name, @{$self->{"mlcols"}});
    
    # The new column value
    %col = qw();
    $col{"name"}        = $name;
    $col{"mod"}         = 0;
    # No value is supplied
    if (!defined $val || $val eq "") {
        $col{"type"}    = TYPE_NULL;
        $col{"value"}   = undef;
    # A valid value
    } else {
        $col{"type"}    = TYPE_IPADDR;
        $col{"value"}   = $val;
    }
    
    # Check if we should set it
    if ($self->{"optype"} == ADDCOL_INSERT) {
        # Always set the value for INSERT
        $col{"mod"} = 1;
    
    } else {
        # A current value is supplied
        if ($cur_exists) {
            # This column had a value previously
            if (defined $curval) {
                # It has no value now.  Remove it.
                if ($col{"type"} == TYPE_NULL) {
                    $col{"mod"} = 1;
                # A different new value.  Modify it.
                } elsif ($col{"value"} ne $curval) {
                    $col{"mod"} = 1;
                }
            # This column had no value previously
            } else {
                # But it has a value now.
                if ($col{"type"} != TYPE_NULL) {
                    $col{"mod"} = 1;
                }
            }
        # No current value to compare with.
        } else {
            # Set it anyway
            $col{"mod"} = 1;
        }
    }
    # Add this column
    push @{$self->{"cols"}}, {%col};
    return;
}

# addbool: Add a modified boolean column to the columns deposit
#   Input:  $name:   The column name.
#           $val:    The column value.
#           $curval: The current value to be compared.
sub addbool : method {
    local ($_, %_);
    my ($self, $name, $val, $curval, $cur_exists, %col);
    ($self, $name, $val, $curval) = @_;
    $cur_exists = (scalar(@_) == 4);
    $curval = decode("UTF-8", $curval, FB_CROAK) if !defined $DBH;
    # Adjust the column name for multi-lingual columns
    $name .= "_" . getlang LN_DATABASE
        if in_array($name, @{$self->{"mlcols"}});
    
    # The new column value
    %col = qw();
    $col{"name"}        = $name;
    $col{"mod"}         = 0;
    # No value supplied means "false"
    $col{"type"}        = TYPE_BOOL;
    $col{"value"}       = defined $val && $val;
    
    # Check if we should set it
    if ($self->{"optype"} == ADDCOL_INSERT) {
        # Always set the value for INSERT
        $col{"mod"} = 1;
    
    } else {
        # A current value is supplied
        if ($cur_exists) {
            # This column is previously true
            if ($curval) {
                # New value is false.  Disable it.
                if (!$col{"value"}) {
                    $col{"mod"} = 1;
                }
            # The current value is false
            } else {
                # But it is true now.
                if ($col{"value"}) {
                    $col{"mod"} = 1;
                }
            }
        # No current value to compare with.
        } else {
            # Set it anyway
            $col{"mod"} = 1;
        }
    }
    # Add this column
    push @{$self->{"cols"}}, {%col};
    return;
}

# addexpr: Add a expression column value to the columns deposit
#   Input:  $name:   The column name.
#           $val:    The column value.
sub addexpr : method {
    local ($_, %_);
    my ($self, $name, $val, %col);
    ($self, $name, $val) = @_;
    # Adjust the column name for multi-lingual columns
    $name .= "_" . getlang LN_DATABASE
        if in_array($name, @{$self->{"mlcols"}});
    
    # The new column value
    # Always set it, since it is not possible to compare the current value
    %col = qw();
    $col{"name"}        = $name;
    $col{"mod"}         = 1;
    $col{"type"}        = TYPE_EXPR;
    $col{"value"}       = $val;
    # Add this column
    push @{$self->{"cols"}}, {%col};
    return;
}

# modified: Return if this record is modified
sub modified : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Find any column that is modified
    foreach my $col (@{$self->{"cols"}}) {
        return 1 if ${$col}{"mod"};
    }
    return 0;
}

# ret: Retrieve the columns deposit as an SQL statement
#   Input:  $timestamp: Whether we should record timestamps or not
#                       Log in forms should not update their timestamps.
#   Output: An SQL statement in the corresponding query type.
sub ret : method {
    local ($_, %_);
    my ($self, $timestamp);
    ($self, $timestamp) = @_;
    $timestamp = 1 if !defined $timestamp;
    # Set the login user
    if ($timestamp) {
        $self->{"login"} = get_login_sn
            if !exists $self->{"login"};
    }
    if ($self->{"optype"} == ADDCOL_INSERT) {
        my (@names, @vals);
        @names = qw();
        @vals = qw();
        foreach my $col (@{$self->{"cols"}}) {
            # Skip columns that are not modified
            next unless ${$col}{"mod"};
            push @names, $DBH->quote_identifier(${$col}{"name"});
            push @vals, valout_sql($col);
        }
        # Add the timestamp
        if ($timestamp) {
            if (in_array("created", @{$self->{"allcols"}})) {
                push @names, $DBH->quote_identifier("created");
                push @vals, "now()";
            }
            if (in_array("createdby", @{$self->{"allcols"}})) {
                push @names, $DBH->quote_identifier("createdby");
                push @vals, $self->{"login"};
            }
            if (in_array("updated", @{$self->{"allcols"}})) {
                push @names, $DBH->quote_identifier("updated");
                push @vals, "now()";
            }
            if (in_array("updatedby", @{$self->{"allcols"}})) {
                push @names, $DBH->quote_identifier("updatedby");
                push @vals, $self->{"login"};
            }
        }
        # Decode from UTF-8, for easier post-processing
        return decode("UTF-8", "(" . join(", ", @names) . ")"
            . " VALUES (" . join(", ", @vals) . ")");
    
    } else {
        my @phrases;
        @phrases = qw();
        foreach my $col (@{$self->{"cols"}}) {
            # Skip columns that are not modified
            next unless ${$col}{"mod"};
            push @phrases, $DBH->quote_identifier(${$col}{"name"}) . "="
                . valout_sql($col);
        }
        # Add the timestamp
        if ($timestamp) {
            if (in_array("updated", @{$self->{"allcols"}})) {
                push @phrases, $DBH->quote_identifier("updated") . "=now()";
            }
            if (in_array("updatedby", @{$self->{"allcols"}})) {
                $_ = get_login_sn;
                $_ = $POST->param("sn") if !defined $_;
                push @phrases, $DBH->quote_identifier("updatedby") . "=$_";
            }
        }
        # Decode from UTF-8, for easier post-processing
        return decode("UTF-8", "SET " . join(", ", @phrases));
    }
}

# retxml: Retrieve the columns deposit as an XML record.
#   Input:  None.
#   Output: An XML record.
sub retxml : method {
    local ($_, %_);
    my ($self, @vals, $user);
    $self = $_[0];
    # XML has no engine.  Output the whole record anyway,
    #   no matter updated or not.
    @vals = map valout_xml($_), @{$self->{"cols"}};
    # Add the updated information
    if ($self->{"optype"} == ADDCOL_UPDATE) {
        $user = (exists $ENV{"REMOTE_USER"} && $ENV{"REMOTE_USER"} ne "")?
            $ENV{"REMOTE_USER"}: "(" . $ENV{"REMOTE_ADDR"} . ")";
        push @vals, "<col name=\"updated\" type=\"date\">" . h(fmttime) . "</col>\n";
        push @vals, "<col name=\"updatedby\">" . h($user) . "</col>\n";
    }
    return encode("UTF-8", "<record>\n" . join("", @vals) . "</record>\n", FB_CROAK);
}

# retcsv: Retrieve the columns deposit as a CSV row.
#   Input:  None.
#   Output: A CSV row.
sub retcsv : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # CSV has no engine.  Output the whole record anyway,
    #   no matter updated or not.
    return join(",", map valout_csv($_), @{$self->{"cols"}}) . "\n";
}


###########################
# Private subroutines, not to be called as methods
###########################
# valout_sql: Output a value in a proper SQL format.
sub valout_sql($) {
    local ($_, %_);
    my ($col, $val);
    $col = $_[0];
    # Encode first.  $DBH->quote() does encode() anyway
    if (defined $$col{"value"}) {
        $val = $$col{"value"};
        $val = encode("UTF-8", $val) if is_utf8($val);
    }
    return "NULL"
        if $$col{"type"} == TYPE_NULL;
    return $val
        if $$col{"type"} == TYPE_NUM;
    return $DBH->quote($val)
        if $$col{"type"} == TYPE_STR;
    return "'" . $val . "'"
        if $$col{"type"} == TYPE_DATE;
    return $DBH->quote_blob($val)
        if $$col{"type"} == TYPE_FILE;
    return "'" . $val . "'"
        if $$col{"type"} == TYPE_IPADDR;
    return $val? "TRUE": "FALSE"
        if $$col{"type"} == TYPE_BOOL;
    return $val
        if $$col{"type"} == TYPE_EXPR;
}

# valout_xml: Output a value in a proper XML format.
sub valout_xml($) {
    local ($_, %_);
    $_ = $_[0];
    return ""
        if $$_{"type"} == TYPE_NULL;
    return "<col name=\"" . h($$_{"name"}) . "\">"
            . h($$_{"value"}) . "</col>\n"
        if $$_{"type"} == TYPE_NUM;
    return "<col name=\"" . h($$_{"name"}) . "\">"
            . h($$_{"value"}) . "</col>\n"
        if $$_{"type"} == TYPE_STR;
    return "<col name=\"" . h($$_{"name"}) . "\" type=\"date\">"
            . h(fmttime $$_{"value"}) . "</col>\n"
        if $$_{"type"} == TYPE_DATE;
    return "<col name=\"" . h($$_{"name"}) . "\">"
            . h(fmttime $$_{"value"}) . "</col>\n"
        if $$_{"type"} == TYPE_FILE;
    return "<col name=\"" . h($$_{"name"}) . "\">"
            . h($$_{"value"}) . "</col>\n"
        if $$_{"type"} == TYPE_IPADDR;
    return "<col name=\"" . h($$_{"name"}) . "\">"
            . h($$_{"value"}? "TRUE": "FALSE") . "</col>\n"
        if $$_{"type"} == TYPE_BOOL;
    # XML has no engine.  The following is emulated.
    if ($$_{"type"} == TYPE_EXPR) {
        return "<col name=\"" . h($$_{"name"}) . "\" type=\"date\">"
                . h(fmttime) . "</col>\n"
            if lc $$_{"value"} eq "now" || lc $$_{"value"} eq "now()";
    }
}

# valout_csv: Output a value in a proper CSV format.
sub valout_csv($) {
    local ($_, %_);
    $_ = $_[0];
    return "NULL"
        if $$_{"type"} == TYPE_NULL;
    return $$_{"value"}
        if $$_{"type"} == TYPE_NUM;
    if ($$_{"type"} == TYPE_STR) {
        $_ = $$_{"value"};
        s/\\/\\\\/g;
        s/"/\\"/g;
        s/\n/\\n/g;
        s/\r/\\r/g;
        s/\t/\\t/g;
        s/\0/\\0/g;
        return "\"" . $_ . "\"";
    }
    return "\"" . $$_{"value"} . "\""
        if $$_{"type"} == TYPE_DATE;
    return "\"" . $$_{"value"} . "\""
        if $$_{"type"} == TYPE_IPADDR;
    return $$_{"value"}? "TRUE": "FALSE"
        if $$_{"type"} == TYPE_BOOL;
    # CSV has no engine.  The following is emulated.
    if ($$_{"type"} == TYPE_EXPR) {
        return "\"" . fmttime() . "\""
            if $$_{"value"} =~ /^now(?:\(\))?$/i;
    }
}

return 1;