tools/perl-5.8.0/lib/site_perl/5.8.0/mhdb.pl

##---------------------------------------------------------------------------##
##  File:
##      $Id: mhdb.pl,v 2.22 2002/07/27 05:13:13 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
##---------------------------------------------------------------------------##

##---------------------------------------------------------------------------
##      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 $tmpfile = $pathname . "$$";

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

    local(*DB);
    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,'IndexNum',    \%IndexNum);
print_var(\*DB,'MsgId',       \%MsgId);
print_var(\*DB,'Refs',        \%Refs);
print_var(\*DB,'Subject',     \%Subject);
print_var(\*DB,'TListOrder',  \@TListOrder);
print_var(\*DB,'NumOfMsgs',   \$NumOfMsgs);
print_var(\*DB,'NumOfPages',  \$NumOfPages);
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{'CHARSETCONVERTERS'}) {
    print_var(\*DB,'readmail::MIMECharSetConverters',
                    \%readmail::MIMECharSetConverters);
    print_var(\*DB,'readmail::MIMECharSetConvertersSrc',
                    \%readmail::MIMECharSetConvertersSrc);
}
unless ($IsDefault{'MIMEDECODERS'}) {
    print_var(\*DB,'readmail::MIMEDecoders',
                    \%readmail::MIMEDecoders);
    print_var(\*DB,'readmail::MIMEDecodersSrc',
                    \%readmail::MIMEDecodersSrc);
}
unless ($IsDefault{'MIMEFILTERS'}) {
    print_var(\*DB,'readmail::MIMEFilters',
                    \%readmail::MIMEFilters);
    print_var(\*DB,'readmail::MIMEFiltersSrc',
                    \%readmail::MIMEFiltersSrc);
}
print_var(\*DB,'readmail::MIMEFiltersArgs',
                \%readmail::MIMEFiltersArgs)
                unless $IsDefault{'MIMEARGS'};
if (%readmail::MIMEExcs) {
    print_var(\*DB,'readmail::MIMEExcs',
                    \%readmail::MIMEExcs)
                    unless $IsDefault{'MIMEEXCS'};
}
unless ($IsDefault{'MIMEALTPREFS'}) {
    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,'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,'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,'IDXSIZE',        \$IDXSIZE);
print_var(\*DB,'KeepOnRmm',      \$KeepOnRmm);
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,'MULTIIDX',       \$MULTIIDX);
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,'TSliceNBefore',\$TSliceNBefore);
print_var(\*DB,'TSliceNAfter', \$TSliceNAfter);
print_var(\*DB,'TSliceInclusive', \$TSliceInclusive);
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,'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;
    }
    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') {
        print $fh qq/\$$name='/, escape_str($$ref), qq/'/;
        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;