##---------------------------------------------------------------------------##
##  File:
##	$Id: mhdb.pl,v 2.43 2011/01/03 06:42:39 ehood Exp $
##  Author:
##      Earl Hood       mhonarc@mhonarc.org
##  Description:
##      MHonArc library defining routines for outputing database.
##---------------------------------------------------------------------------##
##    MHonArc -- Internet mail-to-HTML converter
##    Copyright (C) 1995-2002	Earl Hood, mhonarc@mhonarc.org
##
##    This program is free software; you can redistribute it and/or modify
##    it under the terms of the GNU General Public License as published by
##    the Free Software Foundation; either version 2 of the License, or
##    (at your option) any later version.
##
##    This program is distributed in the hope that it will be useful,
##    but WITHOUT ANY WARRANTY; without even the implied warranty of
##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##    GNU General Public License for more details.
##
##    You should have received a copy of the GNU General Public License
##    along with this program; if not, write to the Free Software
##    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
##    02111-1307, USA
##---------------------------------------------------------------------------##

use File::Basename;

my $_true  = "1";
my $_false = "0";

##---------------------------------------------------------------------------
##	output_db() spits out the state of mhonarc to a file.  This
##	(database) file contains information to update mail threading
##	when incremental adding is done.  The actual database file
##	is a Perl program defining all the internal data structures.
##	All mhonarc does is 'require' it when updating.  This is
##	faster than having to extract the data from message files
##	-- which would require opening every file to perform
##	updates.
##
sub output_db {
    my ($pathname) = shift;
    my ($dirname)  = dirname($pathname);
    my ($db, $tmpfile) = file_temp('dbXXXXXXXXXX', $dirname);

    ## Invoke pre-save callback
    if (defined($CBDbPreSave) && defined(&$CBDbPreSave)) {
        return unless &$CBDbPreSave($pathname, $tmpfile);
    }

    if (!open($db, ">$tmpfile")) {
        warn qq/ERROR: Unable to create "$tmpfile": $!\n/;
        return 0;
    }
    binmode($db);    # Unix text format okay for Perl source on Windog

    print $db "## MHonArcDB (Automatically generated by MHonArc)\n";
    print_var($db, 'DbVERSION', \$VERSION);

## Meta-data
    print_var($db, 'ContentType',       \%ContentType);
    print_var($db, 'Date',              \%Date);
    print_var($db, 'Derived',           \%Derived);
    print_var($db, 'FollowOld',         \%Follow);
    print_var($db, 'From',              \%From);
    print_var($db, 'DoFromName',        \$DoFromName);
    print_var($db, 'FromName',          \%FromName) if $DoFromName;
    print_var($db, 'DoFromAddr',        \$DoFromAddr);
    print_var($db, 'FromAddr',          \%FromAddr) if $DoFromAddr;
    print_var($db, 'IndexNum',          \%IndexNum);
    print_var($db, 'MsgId',             \%MsgId);
    print_var($db, 'Refs',              \%Refs);
    print_var($db, 'Subject',           \%Subject);
    print_var($db, 'Time',              \%Time);
    print_var($db, 'ExtraHFields',      \@ExtraHFields);
    print_var($db, 'ExtraHFields',      \%ExtraHFields);
    print_var($db, 'TListOrder',        \@TListOrder);
    print_var($db, 'LastMsgNum',        \$LastMsgNum);
    print_var($db, 'MAXPGS',            \$MAXPGS);
    print_var($db, 'MULTIIDX',          \$MULTIIDX);
    print_var($db, 'NumOfMsgs',         \$NumOfMsgs);
    print_var($db, 'NumOfPages',        \$NumOfPages);
    print_var($db, 'NumOfPrintedPages', \$NumOfPrintedPages);
    print_var($db, 'PrintXComments',    \$PrintXComments);
    print_var($db, 'SaveRsrcs',         \$SaveRsrcs);

    if ($SaveRsrcs) {

## Resources
        print_var($db, 'CustomRcVars', \%CustomRcVars);
        print_var($db, 'FieldODefs',   \%FieldODefs);
        print_var($db, 'HFieldsExc',   \%HFieldsExc);
        print_var($db, 'HeadFields',   \%HeadFields);
        print_var($db, 'HeadHeads',    \%HeadHeads);
        print_var($db, 'Icons',        \%Icons);
        print_var($db, 'UDerivedFile', \%UDerivedFile);
        print_var($db, 'ZoneUD',       \%ZoneUD);

        unless ($IsDefault{'CHARSETALIASES'} && !$SaveMIMECharsetAliases) {
            print_var($db, 'SaveMIMECharsetAliases', \$_true);
            print_var(
                $db,
                'readmail::MIMECharsetAliases',
                \%readmail::MIMECharsetAliases
            );
        }
        unless ($IsDefault{'CHARSETCONVERTERS'}
            && !$SaveMIMECharSetConverters) {
            print_var($db, 'SaveMIMECharSetConverters', \$_true);
            print_var(
                $db,
                'readmail::MIMECharSetConverters',
                \%readmail::MIMECharSetConverters
            );
            print_var(
                $db,
                'readmail::MIMECharSetConvertersSrc',
                \%readmail::MIMECharSetConvertersSrc
            );
        }
        unless ($readmail::TextDefCharset eq 'us-ascii') {
            print_var($db, 'readmail::TextDefCharset',
                \$readmail::TextDefCharset);
        }
        unless ($IsDefault{'TEXTENCODE'} && !$SaveTextEncode) {
            print_var($db, 'SaveTextEncode',       \$_true);
            print_var($db, 'readmail::TextEncode', \$readmail::TextEncode);
            print_var($db, 'readmail::TextEncoderFunc',
                \$readmail::TextEncoderFunc);
            print_var($db, 'readmail::TextEncoderSrc',
                \$readmail::TextEncoderSrc);
        }
        unless ($IsDefault{'MIMEDECODERS'} && !$SaveMIMEDecoders) {
            print_var($db, 'SaveMIMEDecoders', \$_true);
            print_var($db, 'readmail::MIMEDecoders',
                \%readmail::MIMEDecoders);
            print_var($db, 'readmail::MIMEDecodersSrc',
                \%readmail::MIMEDecodersSrc);
        }
        unless ($IsDefault{'MIMEFILTERS'} && !$SaveMIMEFilters) {
            print_var($db, 'SaveMIMEFilters',       \$_true);
            print_var($db, 'readmail::MIMEFilters', \%readmail::MIMEFilters);
            print_var($db, 'readmail::MIMEFiltersSrc',
                \%readmail::MIMEFiltersSrc);
        }
        unless ($IsDefault{'MIMEARGS'} && !$SaveMIMEFiltersArgs) {
            print_var($db, 'SaveMIMEFiltersArgs', \$_true);
            print_var($db, 'readmail::MIMEFiltersArgs',
                \%readmail::MIMEFiltersArgs);
        }
        if (%readmail::MIMEExcs) {
            print_var($db, 'readmail::MIMEExcs', \%readmail::MIMEExcs)
                unless $IsDefault{'MIMEEXCS'};
        }
        if (%readmail::MIMEIncs) {
            print_var($db, 'readmail::MIMEIncs', \%readmail::MIMEIncs)
                unless $IsDefault{'MIMEINCS'};
        }
        unless ($IsDefault{'MIMEALTPREFS'} && !$SaveMIMEAltPrefs) {
            print_var($db, 'SaveMIMEAltPrefs', \$_true);
            print_var($db, 'MIMEAltPrefs',     \@MIMEAltPrefs);
        }

        print_var($db, 'DateFields', \@DateFields)
            unless $IsDefault{'DATEFIELDS'};
        print_var($db, 'FieldOrder', \@FieldOrder);
        print_var($db, 'FromFields', \@FromFields)
            unless $IsDefault{'FROMFIELDS'};
        print_var($db, 'Months',    \@Months)    if scalar(@Months);
        print_var($db, 'months',    \@months)    if scalar(@months);
        print_var($db, 'OtherIdxs', \@OtherIdxs) if scalar(@OtherIdxs);
        print_var($db, 'PerlINC',   \@PerlINC)   if scalar(@PerlINC);
        print_var($db, 'Weekdays',  \@Weekdays)  if scalar(@Weekdays);
        print_var($db, 'weekdays',  \@weekdays)  if scalar(@weekdays);

## I should use a hash for this stuff instead of individual variables.
## A legacy of Perl 4 days and a program getting larger than expected.

        print_var($db, 'AddressModify', \$AddressModify)
            unless $IsDefault{'AddressModify'};
        print_var($db, 'AddrModifyBodies', \$AddrModifyBodies);
        print_var($db, 'AttachmentDir',    \$AttachmentDir);
        print_var($db, 'AttachmentUrl',    \$AttachmentUrl);
        print_var($db, 'CheckNoArchive',   \$CheckNoArchive);
        print_var($db, 'DOCURL',           \$DOCURL);
        print_var($db, 'NODOC',            \$NODOC);
        print_var($db, 'DecodeHeads',      \$DecodeHeads);
        print_var($db, 'DoFolRefs',        \$DoFolRefs);
        print_var($db, 'ExpireDate',       \$ExpireDate);
        print_var($db, 'ExpireTime',       \$ExpireTime);
        print_var($db, 'FastTempFiles',    \$FastTempFiles);
        print_var($db, 'FollowSymlinks',   \$FollowSymlinks);
        print_var($db, 'FROM',             \$FROM);
        print_var($db, 'GMTDateFmt',       \$GMTDateFmt);
        print_var($db, 'GzipExe',          \$GzipExe);
        print_var($db, 'GzipFiles',        \$GzipFiles);
        print_var($db, 'GzipLinks',        \$GzipLinks);
        print_var($db, 'HtmlExt',          \$HtmlExt);
        print_var($db, 'IconURLPrefix',    \$IconURLPrefix);
        print_var($db, 'IDXSIZE',          \$IDXSIZE);
        print_var($db, 'KeepOnRmm',        \$KeepOnRmm);
        print_var($db, 'Lang',             \$Lang);
        print_var($db, 'LocalDateFmt',     \$LocalDateFmt);
        print_var($db, 'MAILTOURL',        \$MAILTOURL)
            unless $IsDefault{'MAILTOURL'};
        print_var($db, 'MAIN',            \$MAIN);
        print_var($db, 'MAXSIZE',         \$MAXSIZE);
        print_var($db, 'MHPATTERN',       \$MHPATTERN);
        print_var($db, 'MODTIME',         \$MODTIME);
        print_var($db, 'MSGFOOT',         \$MSGFOOT);
        print_var($db, 'MsgGMTDateFmt',   \$MsgGMTDateFmt);
        print_var($db, 'MSGHEAD',         \$MSGHEAD);
        print_var($db, 'MsgExcFilter',    \$MsgExcFilter);
        print_var($db, 'MsgLocalDateFmt', \$MsgLocalDateFmt);
        print_var($db, 'MsgPrefix',       \$MsgPrefix);
        print_var($db, 'NewsUrl',  \$NewsUrl) unless $IsDefault{'NEWSURL'};
        print_var($db, 'NOMAILTO', \$NOMAILTO);
        print_var($db, 'NONEWS',   \$NONEWS);
        print_var($db, 'NOURL',    \$NOURL);
        print_var($db, 'NoMsgPgs', \$NoMsgPgs);
        print_var($db, 'NoSubjectThreads', \$NoSubjectThreads);
        print_var($db, 'NoSubjectTxt',     \$NoSubjectTxt);
        print_var($db, 'NoteDir',          \$NoteDir);
        print_var($db, 'POSIXstrftime',    \$POSIXstrftime);
        print_var($db, 'THREAD',           \$THREAD);
        print_var($db, 'SubArtRxp',        \$SubArtRxp);
        print_var($db, 'SubReplyRxp',      \$SubReplyRxp);
        print_var($db, 'SubStripCode',     \$SubStripCode);
        print_var($db, 'UseLocalTime',     \$UseLocalTime);
        print_var($db, 'UsingLASTPG',      \$UsingLASTPG);
        print_var($db, 'VarExp',           \$VarExp);

        print_var($db, 'MSGPGSSMARKUP',  \$MSGPGSSMARKUP);
        print_var($db, 'IDXPGSSMARKUP',  \$IDXPGSSMARKUP);
        print_var($db, 'TIDXPGSSMARKUP', \$TIDXPGSSMARKUP);
        print_var($db, 'SSMARKUP',       \$SSMARKUP);
        print_var($db, 'SpamMode',       \$SpamMode);

        if (!$IsDefault{'TEXTCLIPFUNC'}) {
            print_var($db, 'TextClipFunc', \$TextClipFunc);
            print_var($db, 'TextClipSrc',  \$TextClipSrc);
        }

# Main index resources
        print_var($db, 'AUTHSORT', \$AUTHSORT);
        print_var($db, 'NOSORT',   \$NOSORT);
        print_var($db, 'REVSORT',  \$REVSORT);
        print_var($db, 'SUBSORT',  \$SUBSORT);

        print_var($db, 'AUTHBEG',  \$AUTHBEG)  unless $IsDefault{'AUTHBEG'};
        print_var($db, 'AUTHEND',  \$AUTHEND)  unless $IsDefault{'AUTHEND'};
        print_var($db, 'DAYBEG',   \$DAYBEG)   unless $IsDefault{'DAYBEG'};
        print_var($db, 'DAYEND',   \$DAYEND)   unless $IsDefault{'DAYEND'};
        print_var($db, 'IDXLABEL', \$IDXLABEL) unless $IsDefault{'IDXLABEL'};
        print_var($db, 'IDXNAME',  \$IDXNAME);
        print_var($db, 'IDXPGBEG', \$IDXPGBEG) unless $IsDefault{'IDXPGBEG'};
        print_var($db, 'IDXPGEND', \$IDXPGEND) unless $IsDefault{'IDXPGEND'};
        print_var($db, 'IDXPREFIX',   \$IDXPREFIX);
        print_var($db, 'LIBEG',       \$LIBEG) unless $IsDefault{'LIBEG'};
        print_var($db, 'LIEND',       \$LIEND) unless $IsDefault{'LIEND'};
        print_var($db, 'LITMPL',      \$LITMPL) unless $IsDefault{'LITMPL'};
        print_var($db, 'FIRSTPGLINK', \$FIRSTPGLINK)
            unless $IsDefault{'FIRSTPGLINK'};
        print_var($db, 'LASTPGLINK', \$LASTPGLINK)
            unless $IsDefault{'LASTPGLINK'};
        print_var($db, 'NEXTPGLINK', \$NEXTPGLINK)
            unless $IsDefault{'NEXTPGLINK'};
        print_var($db, 'NEXTPGLINKIA', \$NEXTPGLINKIA)
            unless $IsDefault{'NEXTPGLINKIA'};
        print_var($db, 'PREVPGLINK', \$PREVPGLINK)
            unless $IsDefault{'PREVPGLINK'};
        print_var($db, 'PREVPGLINKIA', \$PREVPGLINKIA)
            unless $IsDefault{'PREVPGLINKIA'};
        print_var($db, 'SUBJECTBEG', \$SUBJECTBEG)
            unless $IsDefault{'SUBJECTBEG'};
        print_var($db, 'SUBJECTEND', \$SUBJECTEND)
            unless $IsDefault{'SUBJECTEND'};
        print_var($db, 'TITLE', \$TITLE);

# Thread index resources
        print_var($db, 'TNOSORT',  \$TNOSORT);
        print_var($db, 'TREVERSE', \$TREVERSE);
        print_var($db, 'TSUBSORT', \$TSUBSORT);

        print_var($db, 'TCONTBEG', \$TCONTBEG) unless $IsDefault{'TCONTBEG'};
        print_var($db, 'TCONTEND', \$TCONTEND) unless $IsDefault{'TCONTEND'};
        print_var($db, 'TFOOT',    \$TFOOT)    unless $IsDefault{'TFOOT'};
        print_var($db, 'THEAD',    \$THEAD)    unless $IsDefault{'THEAD'};
        print_var($db, 'TIDXLABEL', \$TIDXLABEL)
            unless $IsDefault{'TIDXLABEL'};
        print_var($db, 'TIDXNAME',  \$TIDXNAME);
        print_var($db, 'TIDXPGBEG', \$TIDXPGBEG)
            unless $IsDefault{'TIDXPGBEG'};
        print_var($db, 'TIDXPGEND', \$TIDXPGEND)
            unless $IsDefault{'TIDXPGEND'};
        print_var($db, 'TIDXPREFIX', \$TIDXPREFIX);
        print_var($db, 'TINDENTBEG', \$TINDENTBEG)
            unless $IsDefault{'TINDENTBEG'};
        print_var($db, 'TINDENTEND', \$TINDENTEND)
            unless $IsDefault{'TINDENTEND'};
        print_var($db, 'TLEVELS',    \$TLEVELS);
        print_var($db, 'TLIEND',     \$TLIEND) unless $IsDefault{'TLIEND'};
        print_var($db, 'TLINONE',    \$TLINONE) unless $IsDefault{'TLINONE'};
        print_var($db, 'TLINONEEND', \$TLINONEEND)
            unless $IsDefault{'TLINONEEND'};
        print_var($db, 'TLITXT', \$TLITXT) unless $IsDefault{'TLITXT'};
        print_var($db, 'TFIRSTPGLINK', \$TFIRSTPGLINK)
            unless $IsDefault{'TFIRSTPGLINK'};
        print_var($db, 'TLASTPGLINK', \$TLASTPGLINK)
            unless $IsDefault{'TLASTPGLINK'};
        print_var($db, 'TNEXTPGLINK', \$TNEXTPGLINK)
            unless $IsDefault{'TNEXTPGLINK'};
        print_var($db, 'TNEXTPGLINKIA', \$TNEXTPGLINKIA)
            unless $IsDefault{'TNEXTPGLINKIA'};
        print_var($db, 'TPREVPGLINK', \$TPREVPGLINK)
            unless $IsDefault{'TPREVPGLINK'};
        print_var($db, 'TPREVPGLINKIA', \$TPREVPGLINKIA)
            unless $IsDefault{'TPREVPGLINKIA'};
        print_var($db, 'TSINGLETXT', \$TSINGLETXT)
            unless $IsDefault{'TSINGLETXT'};
        print_var($db, 'TSUBJECTBEG', \$TSUBJECTBEG)
            unless $IsDefault{'TSUBJECTBEG'};
        print_var($db, 'TSUBJECTEND', \$TSUBJECTEND)
            unless $IsDefault{'TSUBJECTEND'};
        print_var($db, 'TSUBLISTBEG', \$TSUBLISTBEG)
            unless $IsDefault{'TSUBLISTBEG'};
        print_var($db, 'TSUBLISTEND', \$TSUBLISTEND)
            unless $IsDefault{'TSUBLISTEND'};
        print_var($db, 'TTITLE',  \$TTITLE);
        print_var($db, 'TTOPBEG', \$TTOPBEG) unless $IsDefault{'TTOPBEG'};
        print_var($db, 'TTOPEND', \$TTOPEND) unless $IsDefault{'TTOPEND'};

        print_var($db, 'TSLICESINGLETXT', \$TSLICESINGLETXT)
            unless $IsDefault{'TSLICESINGLETXT'};
        print_var($db, 'TSLICETOPBEG', \$TSLICETOPBEG)
            unless $IsDefault{'TSLICETOPBEG'};
        print_var($db, 'TSLICETOPEND', \$TSLICETOPEND)
            unless $IsDefault{'TSLICETOPEND'};
        print_var($db, 'TSLICESUBLISTBEG', \$TSLICESUBLISTBEG)
            unless $IsDefault{'TSLICESUBLISTBEG'};
        print_var($db, 'TSLICESUBLISTEND', \$TSLICESUBLISTEND)
            unless $IsDefault{'TSLICESUBLISTEND'};
        print_var($db, 'TSLICELEVELS', \$TSLICELEVELS)
            unless $IsDefault{'TSLICELEVELS'};
        print_var($db, 'TSLICELITXT', \$TSLICELITXT)
            unless $IsDefault{'TSLICELITXT'};
        print_var($db, 'TSLICELIEND', \$TSLICELIEND)
            unless $IsDefault{'TSLICELIEND'};
        print_var($db, 'TSLICELINONE', \$TSLICELINONE)
            unless $IsDefault{'TSLICELINONE'};
        print_var($db, 'TSLICELINONEEND', \$TSLICELINONEEND)
            unless $IsDefault{'TSLICELINONEEND'};
        print_var($db, 'TSLICESUBJECTBEG', \$TSLICESUBJECTBEG)
            unless $IsDefault{'TSLICESUBJECTBEG'};
        print_var($db, 'TSLICESUBJECTEND', \$TSLICESUBJECTEND)
            unless $IsDefault{'TSLICESUBJECTEND'};
        print_var($db, 'TSLICEINDENTBEG', \$TSLICEINDENTBEG)
            unless $IsDefault{'TSLICEINDENTBEG'};
        print_var($db, 'TSLICEINDENTEND', \$TSLICEINDENTEND)
            unless $IsDefault{'TSLICEINDENTEND'};
        print_var($db, 'TSLICECONTBEG', \$TSLICECONTBEG)
            unless $IsDefault{'TSLICECONTBEG'};
        print_var($db, 'TSLICECONTEND', \$TSLICECONTEND)
            unless $IsDefault{'TSLICECONTEND'};
        print_var($db, 'TSLICESINGLETXTCUR', \$TSLICESINGLETXTCUR)
            unless $IsDefault{'TSLICESINGLETXTCUR'};
        print_var($db, 'TSLICETOPBEGCUR', \$TSLICETOPBEGCUR)
            unless $IsDefault{'TSLICETOPBEGCUR'};
        print_var($db, 'TSLICETOPENDCUR', \$TSLICETOPENDCUR)
            unless $IsDefault{'TSLICETOPENDCUR'};
        print_var($db, 'TSLICELITXTCUR', \$TSLICELITXTCUR)
            unless $IsDefault{'TSLICELITXTCUR'};
        print_var($db, 'TSLICELIENDCUR', \$TSLICELIENDCUR)
            unless $IsDefault{'TSLICELIENDCUR'};

## Other resources
        print_var($db, 'BOTLINKS', \$BOTLINKS) unless $IsDefault{'BOTLINKS'};
        print_var($db, 'FIELDSBEG', \$FIELDSBEG)
            unless $IsDefault{'FIELDSBEG'};
        print_var($db, 'FIELDSEND', \$FIELDSEND)
            unless $IsDefault{'FIELDSEND'};
        print_var($db, 'FLDBEG', \$FLDBEG) unless $IsDefault{'FLDBEG'};
        print_var($db, 'FLDEND', \$FLDEND) unless $IsDefault{'FLDEND'};
        print_var($db, 'FOLUPBEGIN', \$FOLUPBEGIN)
            unless $IsDefault{'FOLUPBEGIN'};
        print_var($db, 'FOLUPEND', \$FOLUPEND) unless $IsDefault{'FOLUPEND'};
        print_var($db, 'FOLUPLITXT', \$FOLUPLITXT)
            unless $IsDefault{'FOLUPLITXT'};
        print_var($db, 'HEADBODYSEP', \$HEADBODYSEP)
            unless $IsDefault{'HEADBODYSEP'};
        print_var($db, 'LABELBEG', \$LABELBEG) unless $IsDefault{'LABELBEG'};
        print_var($db, 'LABELEND', \$LABELEND) unless $IsDefault{'LABELEND'};
        print_var($db, 'MSGBODYEND', \$MSGBODYEND)
            unless $IsDefault{'MSGBODYEND'};
        print_var($db, 'MSGIDLINK', \$MSGIDLINK)
            unless $IsDefault{'MSGIDLINK'};
        print_var($db, 'MSGPGBEG', \$MSGPGBEG) unless $IsDefault{'MSGPGBEG'};
        print_var($db, 'MSGPGEND', \$MSGPGEND) unless $IsDefault{'MSGPGEND'};
        print_var($db, 'NEXTBUTTON', \$NEXTBUTTON)
            unless $IsDefault{'NEXTBUTTON'};
        print_var($db, 'NEXTBUTTONIA', \$NEXTBUTTONIA)
            unless $IsDefault{'NEXTBUTTONIA'};
        print_var($db, 'NEXTLINK', \$NEXTLINK) unless $IsDefault{'NEXTLINK'};
        print_var($db, 'NEXTLINKIA', \$NEXTLINKIA)
            unless $IsDefault{'NEXTLINKIA'};
        print_var($db, 'NOTE',     \$NOTE)     unless $IsDefault{'NOTE'};
        print_var($db, 'NOTEIA',   \$NOTEIA)   unless $IsDefault{'NOTEIA'};
        print_var($db, 'NOTEICON', \$NOTEICON) unless $IsDefault{'NOTEICON'};
        print_var($db, 'NOTEICONIA', \$NOTEICONIA)
            unless $IsDefault{'NOTEICONIA'};
        print_var($db, 'PREVBUTTON', \$PREVBUTTON)
            unless $IsDefault{'PREVBUTTON'};
        print_var($db, 'PREVBUTTONIA', \$PREVBUTTONIA)
            unless $IsDefault{'PREVBUTTONIA'};
        print_var($db, 'PREVLINK', \$PREVLINK) unless $IsDefault{'PREVLINK'};
        print_var($db, 'PREVLINKIA', \$PREVLINKIA)
            unless $IsDefault{'PREVLINKIA'};
        print_var($db, 'REFSBEGIN', \$REFSBEGIN)
            unless $IsDefault{'REFSBEGIN'};
        print_var($db, 'REFSEND', \$REFSEND) unless $IsDefault{'REFSEND'};
        print_var($db, 'REFSLITXT', \$REFSLITXT)
            unless $IsDefault{'REFSLITXT'};
        print_var($db, 'SUBJECTHEADER', \$SUBJECTHEADER)
            unless $IsDefault{'SUBJECTHEADER'};
        print_var($db, 'TNEXTBUTTON', \$TNEXTBUTTON)
            unless $IsDefault{'TNEXTBUTTON'};
        print_var($db, 'TNEXTBUTTONIA', \$TNEXTBUTTONIA)
            unless $IsDefault{'TNEXTBUTTONIA'};
        print_var($db, 'TNEXTINBUTTON', \$TNEXTINBUTTON)
            unless $IsDefault{'TNEXTINBUTTON'};
        print_var($db, 'TNEXTINBUTTONIA', \$TNEXTINBUTTONIA)
            unless $IsDefault{'TNEXTINBUTTONIA'};
        print_var($db, 'TNEXTINLINK', \$TNEXTINLINK)
            unless $IsDefault{'TNEXTINLINK'};
        print_var($db, 'TNEXTINLINKIA', \$TNEXTINLINKIA)
            unless $IsDefault{'TNEXTINLINKIA'};
        print_var($db, 'TNEXTLINK', \$TNEXTLINK)
            unless $IsDefault{'TNEXTLINK'};
        print_var($db, 'TNEXTLINKIA', \$TNEXTLINKIA)
            unless $IsDefault{'TNEXTLINKIA'};
        print_var($db, 'TOPLINKS', \$TOPLINKS) unless $IsDefault{'TOPLINKS'};
        print_var($db, 'TPREVBUTTON', \$TPREVBUTTON)
            unless $IsDefault{'TPREVBUTTON'};
        print_var($db, 'TPREVBUTTONIA', \$TPREVBUTTONIA)
            unless $IsDefault{'TPREVBUTTONIA'};
        print_var($db, 'TPREVINBUTTON', \$TPREVINBUTTON)
            unless $IsDefault{'TPREVINBUTTON'};
        print_var($db, 'TPREVINBUTTONIA', \$TPREVINBUTTONIA)
            unless $IsDefault{'TPREVINBUTTONIA'};
        print_var($db, 'TPREVINLINK', \$TPREVINLINK)
            unless $IsDefault{'TPREVINLINK'};
        print_var($db, 'TPREVINLINKIA', \$TPREVINLINKIA)
            unless $IsDefault{'TPREVINLINKIA'};
        print_var($db, 'TPREVLINK', \$TPREVLINK)
            unless $IsDefault{'TPREVLINK'};
        print_var($db, 'TPREVLINKIA', \$TPREVLINKIA)
            unless $IsDefault{'TPREVLINKIA'};
        print_var($db, 'TSLICEBEG', \$TSLICEBEG)
            unless $IsDefault{'TSLICEBEG'};
        print_var($db, 'TSLICEEND', \$TSLICEEND)
            unless $IsDefault{'TSLICEEND'};
        print_var($db, 'TTOPBUTTON', \$TTOPBUTTON)
            unless $IsDefault{'TTOPBUTTON'};
        print_var($db, 'TTOPBUTTONIA', \$TTOPBUTTONIA)
            unless $IsDefault{'TTOPBUTTONIA'};
        print_var($db, 'TENDBUTTON', \$TENDBUTTON)
            unless $IsDefault{'TENDBUTTON'};
        print_var($db, 'TENDBUTTONIA', \$TENDBUTTONIA)
            unless $IsDefault{'TENDBUTTONIA'};
        print_var($db, 'TTOPLINK', \$TTOPLINK) unless $IsDefault{'TTOPLINK'};
        print_var($db, 'TTOPLINKIA', \$TTOPLINKIA)
            unless $IsDefault{'TTOPLINKIA'};
        print_var($db, 'TENDLINK', \$TENDLINK) unless $IsDefault{'TENDLINK'};
        print_var($db, 'TENDLINKIA', \$TENDLINKIA)
            unless $IsDefault{'TENDLINKIA'};
        print_var($db, 'TNEXTTOPBUTTON', \$TNEXTTOPBUTTON)
            unless $IsDefault{'TNEXTTOPBUTTON'};
        print_var($db, 'TNEXTTOPBUTTONIA', \$TNEXTTOPBUTTONIA)
            unless $IsDefault{'TNEXTTOPBUTTONIA'};
        print_var($db, 'TNEXTTOPLINK', \$TNEXTTOPLINK)
            unless $IsDefault{'TNEXTTOPLINK'};
        print_var($db, 'TNEXTTOPLINKIA', \$TNEXTTOPLINKIA)
            unless $IsDefault{'TNEXTTOPLINKIA'};
        print_var($db, 'TPREVTOPBUTTON', \$TPREVTOPBUTTON)
            unless $IsDefault{'TPREVTOPBUTTON'};
        print_var($db, 'TPREVTOPBUTTONIA', \$TPREVTOPBUTTONIA)
            unless $IsDefault{'TPREVTOPBUTTONIA'};
        print_var($db, 'TPREVTOPLINK', \$TPREVTOPLINK)
            unless $IsDefault{'TPREVTOPLINK'};
        print_var($db, 'TPREVTOPLINKIA', \$TPREVTOPLINKIA)
            unless $IsDefault{'TPREVTOPLINKIA'};

        print_var($db, 'DbFilePerms',     \$DbFilePerms);
        print_var($db, 'FilePerms',       \$FilePerms);
        print_var($db, 'TSliceNBefore',   \$TSliceNBefore);
        print_var($db, 'TSliceNAfter',    \$TSliceNAfter);
        print_var($db, 'TSliceInclusive', \$TSliceInclusive);
        print_var($db, 'UMASK',           \$UMASK);

    }

    ## Invoke save callback
    if (defined($CBDbSave) && defined(&$CBDbSave)) {
        &$CBDbSave($db);
    }

    ## Make sure file ends with a true value
    print $db "1;\n";

    close($db);

    if (!rename($tmpfile, $pathname)) {
        warn qq/ERROR: Unable to rename "$tmpfile" to "$pathname": $!\n/;
        return 0;
    }
    file_chmod($pathname, $DbFilePermsOct);
    1;
}

##---------------------------------------------------------------------------

sub escape_str {
    my ($str) = $_[0];
    $str =~ s/(['\\])/\\$1/g;
    $str;
}

##---------------------------------------------------------------------------

sub print_var {
    my ($fh, $name, $ref, $d) = @_;

    if (ref($ref) eq 'SCALAR') {
        if (defined($$ref)) {
            print $fh qq/\$$name='/, escape_str($$ref), qq/'/;
        } else {
            print $fh '$', $name, '=undef';
        }
        print $fh qq/ unless defined(\$$name)/ if $d;
        print $fh qq/;\n/;
        return;
    }

    if (ref($ref) eq 'HASH') {
        my ($key, $value, $sep);
        if (defined($name)) {
            print $fh "%$name=(\n";
            $sep = "\n";
        } else {
            print $fh '{';
            $sep = "";
        }
        while (($key, $value) = each(%$ref)) {
            print $fh qq/'/, escape_str($key), qq/',/;
            if (ref($value)) {
                print_var($fh, undef, $value, 0);
                print $fh ",\n";
                next;
            }
            if (defined($value)) {
                print $fh qq/'/, escape_str($value), qq/',/, $sep;
            } else {
                print $fh 'undef,', $sep;
            }
        }
        if (defined($name)) {
            print $fh ");\n";
        } else {
            print $fh '}';
        }
        return;
    }

    if (ref($ref) eq 'ARRAY') {
        local $_;
        my $sep;
        if (defined($name)) {
            print $fh "\@$name=(\n";
            $sep = "\n";
        } else {
            print $fh '[';
            $sep = "";
        }
        foreach (@$ref) {
            if (ref($_)) {
                print_var($fh, undef, $_, 0);
                print $fh ",\n";
                next;
            }
            if (defined($_)) {
                print $fh qq/'/, escape_str($_), qq/',/, $sep;
            } else {
                print $fh 'undef,', $sep;
            }
        }
        if (defined($name)) {
            print $fh ");\n";
        } else {
            print $fh ']';
        }
        return;
    }

    print $fh qq/\$$name='/, escape_str($ref), qq/'/;
    print $fh qq/ unless defined(\$$name)/ if $d;
    print $fh qq/;\n/;
}

##---------------------------------------------------------------------------##
1;
