##---------------------------------------------------------------------------## ## File: ## $Id: mhdb.pl,v 2.39 2005/07/08 06:34:03 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; ##--------------------------------------------------------------------------- ## 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,'IndexNum', \%IndexNum); print_var($db,'MsgId', \%MsgId); print_var($db,'Refs', \%Refs); print_var($db,'Subject', \%Subject); print_var($db,'ExtraHFields',\@ExtraHFields); print_var($db,'ExtraHFields',\%ExtraHFields); print_var($db,'TListOrder', \@TListOrder); 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'}) { print_var($db,'readmail::MIMECharsetAliases', \%readmail::MIMECharsetAliases); } unless ($IsDefault{'CHARSETCONVERTERS'}) { 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'}) { print_var($db,'readmail::TextEncode', \$readmail::TextEncode); print_var($db,'readmail::TextEncoderFunc', \$readmail::TextEncode); print_var($db,'readmail::TextEncodeSrc', \$readmail::TextEncode); } 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'}; } if (%readmail::MIMEIncs) { print_var($db,'readmail::MIMEIncs', \%readmail::MIMEIncs) unless $IsDefault{'MIMEINCS'}; } 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,'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,'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;