projects / OpenSPARC-T2-DV / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / mhdb.pl
CommitLineData
86530b38
AT		 1##---------------------------------------------------------------------------##
2## File:
3## $Id: mhdb.pl,v 2.22 2002/07/27 05:13:13 ehood Exp $
4## Author:
5## Earl Hood mhonarc@mhonarc.org
6## Description:
7## MHonArc library defining routines for outputing database.
8##---------------------------------------------------------------------------##
9## MHonArc -- Internet mail-to-HTML converter
10## Copyright (C) 1995-2002 Earl Hood, mhonarc@mhonarc.org
11##
12## This program is free software; you can redistribute it and/or modify
13## it under the terms of the GNU General Public License as published by
14## the Free Software Foundation; either version 2 of the License, or
15## (at your option) any later version.
16##
17## This program is distributed in the hope that it will be useful,
18## but WITHOUT ANY WARRANTY; without even the implied warranty of
19## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20## GNU General Public License for more details.
21##
22## You should have received a copy of the GNU General Public License
23## along with this program; if not, write to the Free Software
24## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25## 02111-1307, USA
26##---------------------------------------------------------------------------##
27
28##---------------------------------------------------------------------------
29## output_db() spits out the state of mhonarc to a file. This
30## (database) file contains information to update mail threading
31## when incremental adding is done. The actual database file
32## is a Perl program defining all the internal data structures.
33## All mhonarc does is 'require' it when updating. This is
34## faster than having to extract the data from message files
35## -- which would require opening every file to perform
36## updates.
37##
38sub output_db {
39 my($pathname) = shift;
40 my $tmpfile = $pathname . "$$";
41
42 ## Invoke pre-save callback
43 if (defined($CBDbPreSave) && defined(&$CBDbPreSave)) {
44 return unless &$CBDbPreSave($pathname, $tmpfile);
45 }
46
47 local(*DB);
48 if (!open(DB, ">$tmpfile")) {
49 warn qq/ERROR: Unable to create "$tmpfile": $!\n/;
50 return 0;
51 }
52 binmode(DB); # Unix text format okay for Perl source on Windog
53
54print DB "## MHonArcDB (Automatically generated by MHonArc)\n";
55print_var(\*DB,'DbVERSION', \$VERSION);
56
57## Meta-data
58print_var(\*DB,'ContentType', \%ContentType);
59print_var(\*DB,'Date', \%Date);
60print_var(\*DB,'Derived', \%Derived);
61print_var(\*DB,'FollowOld', \%Follow);
62print_var(\*DB,'From', \%From);
63print_var(\*DB,'IndexNum', \%IndexNum);
64print_var(\*DB,'MsgId', \%MsgId);
65print_var(\*DB,'Refs', \%Refs);
66print_var(\*DB,'Subject', \%Subject);
67print_var(\*DB,'TListOrder', \@TListOrder);
68print_var(\*DB,'NumOfMsgs', \$NumOfMsgs);
69print_var(\*DB,'NumOfPages', \$NumOfPages);
70print_var(\*DB,'SaveRsrcs', \$SaveRsrcs);
71
72if ($SaveRsrcs) {
73
74## Resources
75print_var(\*DB,'CustomRcVars',\%CustomRcVars);
76print_var(\*DB,'FieldODefs', \%FieldODefs);
77print_var(\*DB,'HFieldsExc', \%HFieldsExc);
78print_var(\*DB,'HeadFields', \%HeadFields);
79print_var(\*DB,'HeadHeads', \%HeadHeads);
80print_var(\*DB,'Icons', \%Icons);
81print_var(\*DB,'UDerivedFile',\%UDerivedFile);
82print_var(\*DB,'ZoneUD', \%ZoneUD);
83
84unless ($IsDefault{'CHARSETCONVERTERS'}) {
85 print_var(\*DB,'readmail::MIMECharSetConverters',
86 \%readmail::MIMECharSetConverters);
87 print_var(\*DB,'readmail::MIMECharSetConvertersSrc',
88 \%readmail::MIMECharSetConvertersSrc);
89}
90unless ($IsDefault{'MIMEDECODERS'}) {
91 print_var(\*DB,'readmail::MIMEDecoders',
92 \%readmail::MIMEDecoders);
93 print_var(\*DB,'readmail::MIMEDecodersSrc',
94 \%readmail::MIMEDecodersSrc);
95}
96unless ($IsDefault{'MIMEFILTERS'}) {
97 print_var(\*DB,'readmail::MIMEFilters',
98 \%readmail::MIMEFilters);
99 print_var(\*DB,'readmail::MIMEFiltersSrc',
100 \%readmail::MIMEFiltersSrc);
101}
102print_var(\*DB,'readmail::MIMEFiltersArgs',
103 \%readmail::MIMEFiltersArgs)
104 unless $IsDefault{'MIMEARGS'};
105if (%readmail::MIMEExcs) {
106 print_var(\*DB,'readmail::MIMEExcs',
107 \%readmail::MIMEExcs)
108 unless $IsDefault{'MIMEEXCS'};
109}
110unless ($IsDefault{'MIMEALTPREFS'}) {
111 print_var(\*DB,'MIMEAltPrefs',
112 \@MIMEAltPrefs);
113}
114
115print_var(\*DB,'DateFields', \@DateFields) unless $IsDefault{'DATEFIELDS'};
116print_var(\*DB,'FieldOrder', \@FieldOrder);
117print_var(\*DB,'FromFields', \@FromFields) unless $IsDefault{'FROMFIELDS'};
118print_var(\*DB,'Months', \@Months) if scalar(@Months);
119print_var(\*DB,'months', \@months) if scalar(@months);
120print_var(\*DB,'OtherIdxs', \@OtherIdxs) if scalar(@OtherIdxs);
121print_var(\*DB,'PerlINC', \@PerlINC) if scalar(@PerlINC);
122print_var(\*DB,'Weekdays', \@Weekdays) if scalar(@Weekdays);
123print_var(\*DB,'weekdays', \@weekdays) if scalar(@weekdays);
124
125## I should use a hash for this stuff instead of individual variables.
126## A legacy of Perl 4 days and a program getting larger than expected.
127
128print_var(\*DB,'AddressModify', \$AddressModify)
129 unless $IsDefault{'AddressModify'};
130print_var(\*DB,'CheckNoArchive', \$CheckNoArchive);
131print_var(\*DB,'DOCURL', \$DOCURL);
132print_var(\*DB,'NODOC', \$NODOC);
133print_var(\*DB,'DecodeHeads', \$DecodeHeads);
134print_var(\*DB,'DoFolRefs', \$DoFolRefs);
135print_var(\*DB,'ExpireDate', \$ExpireDate);
136print_var(\*DB,'ExpireTime', \$ExpireTime);
137print_var(\*DB,'FROM', \$FROM);
138print_var(\*DB,'GMTDateFmt', \$GMTDateFmt);
139print_var(\*DB,'GzipExe', \$GzipExe);
140print_var(\*DB,'GzipFiles', \$GzipFiles);
141print_var(\*DB,'GzipLinks', \$GzipLinks);
142print_var(\*DB,'HtmlExt', \$HtmlExt);
143print_var(\*DB,'IDXSIZE', \$IDXSIZE);
144print_var(\*DB,'KeepOnRmm', \$KeepOnRmm);
145print_var(\*DB,'LocalDateFmt', \$LocalDateFmt);
146print_var(\*DB,'MAILTOURL', \$MAILTOURL) unless $IsDefault{'MAILTOURL'};
147print_var(\*DB,'MAIN', \$MAIN);
148print_var(\*DB,'MAXSIZE', \$MAXSIZE);
149print_var(\*DB,'MHPATTERN', \$MHPATTERN);
150print_var(\*DB,'MODTIME', \$MODTIME);
151print_var(\*DB,'MSGFOOT', \$MSGFOOT);
152print_var(\*DB,'MsgGMTDateFmt', \$MsgGMTDateFmt);
153print_var(\*DB,'MSGHEAD', \$MSGHEAD);
154print_var(\*DB,'MsgExcFilter', \$MsgExcFilter);
155print_var(\*DB,'MsgLocalDateFmt',\$MsgLocalDateFmt);
156print_var(\*DB,'MsgPrefix', \$MsgPrefix);
157print_var(\*DB,'MULTIIDX', \$MULTIIDX);
158print_var(\*DB,'NOMAILTO', \$NOMAILTO);
159print_var(\*DB,'NONEWS', \$NONEWS);
160print_var(\*DB,'NOURL', \$NOURL);
161print_var(\*DB,'NoMsgPgs', \$NoMsgPgs);
162print_var(\*DB,'NoSubjectThreads', \$NoSubjectThreads);
163print_var(\*DB,'NoSubjectTxt', \$NoSubjectTxt);
164print_var(\*DB,'NoteDir', \$NoteDir);
165print_var(\*DB,'POSIXstrftime', \$POSIXstrftime);
166print_var(\*DB,'THREAD', \$THREAD);
167print_var(\*DB,'SubArtRxp', \$SubArtRxp);
168print_var(\*DB,'SubReplyRxp', \$SubReplyRxp);
169print_var(\*DB,'SubStripCode', \$SubStripCode);
170print_var(\*DB,'UseLocalTime', \$UseLocalTime);
171print_var(\*DB,'UsingLASTPG', \$UsingLASTPG);
172print_var(\*DB,'VarExp', \$VarExp);
173
174print_var(\*DB,'MSGPGSSMARKUP', \$MSGPGSSMARKUP);
175print_var(\*DB,'IDXPGSSMARKUP', \$IDXPGSSMARKUP);
176print_var(\*DB,'TIDXPGSSMARKUP', \$TIDXPGSSMARKUP);
177print_var(\*DB,'SSMARKUP', \$SSMARKUP);
178print_var(\*DB,'SpamMode', \$SpamMode);
179
180if (!$IsDefault{'TEXTCLIPFUNC'}) {
181 print_var(\*DB,'TextClipFunc', \$TextClipFunc);
182 print_var(\*DB,'TextClipSrc', \$TextClipSrc);
183};
184
185# Main index resources
186print_var(\*DB,'AUTHSORT', \$AUTHSORT);
187print_var(\*DB,'NOSORT', \$NOSORT);
188print_var(\*DB,'REVSORT', \$REVSORT);
189print_var(\*DB,'SUBSORT', \$SUBSORT);
190
191print_var(\*DB,'AUTHBEG', \$AUTHBEG) unless $IsDefault{'AUTHBEG'};
192print_var(\*DB,'AUTHEND', \$AUTHEND) unless $IsDefault{'AUTHEND'};
193print_var(\*DB,'DAYBEG', \$DAYBEG) unless $IsDefault{'DAYBEG'};
194print_var(\*DB,'DAYEND', \$DAYEND) unless $IsDefault{'DAYEND'};
195print_var(\*DB,'IDXLABEL', \$IDXLABEL) unless $IsDefault{'IDXLABEL'};
196print_var(\*DB,'IDXNAME', \$IDXNAME);
197print_var(\*DB,'IDXPGBEG', \$IDXPGBEG) unless $IsDefault{'IDXPGBEG'};
198print_var(\*DB,'IDXPGEND', \$IDXPGEND) unless $IsDefault{'IDXPGEND'};
199print_var(\*DB,'IDXPREFIX', \$IDXPREFIX);
200print_var(\*DB,'LIBEG', \$LIBEG) unless $IsDefault{'LIBEG'};
201print_var(\*DB,'LIEND', \$LIEND) unless $IsDefault{'LIEND'};
202print_var(\*DB,'LITMPL', \$LITMPL) unless $IsDefault{'LITMPL'};
203print_var(\*DB,'FIRSTPGLINK', \$FIRSTPGLINK) unless $IsDefault{'FIRSTPGLINK'};
204print_var(\*DB,'LASTPGLINK', \$LASTPGLINK) unless $IsDefault{'LASTPGLINK'};
205print_var(\*DB,'NEXTPGLINK', \$NEXTPGLINK) unless $IsDefault{'NEXTPGLINK'};
206print_var(\*DB,'NEXTPGLINKIA', \$NEXTPGLINKIA)
207 unless $IsDefault{'NEXTPGLINKIA'};
208print_var(\*DB,'PREVPGLINK', \$PREVPGLINK) unless $IsDefault{'PREVPGLINK'};
209print_var(\*DB,'PREVPGLINKIA', \$PREVPGLINKIA)
210 unless $IsDefault{'PREVPGLINKIA'};
211print_var(\*DB,'SUBJECTBEG', \$SUBJECTBEG) unless $IsDefault{'SUBJECTBEG'};
212print_var(\*DB,'SUBJECTEND', \$SUBJECTEND) unless $IsDefault{'SUBJECTEND'};
213print_var(\*DB,'TITLE', \$TITLE);
214
215# Thread index resources
216print_var(\*DB,'TNOSORT', \$TNOSORT);
217print_var(\*DB,'TREVERSE', \$TREVERSE);
218print_var(\*DB,'TSUBSORT', \$TSUBSORT);
219
220print_var(\*DB,'TCONTBEG', \$TCONTBEG) unless $IsDefault{'TCONTBEG'};
221print_var(\*DB,'TCONTEND', \$TCONTEND) unless $IsDefault{'TCONTEND'};
222print_var(\*DB,'TFOOT', \$TFOOT) unless $IsDefault{'TFOOT'};
223print_var(\*DB,'THEAD', \$THEAD) unless $IsDefault{'THEAD'};
224print_var(\*DB,'TIDXLABEL', \$TIDXLABEL) unless $IsDefault{'TIDXLABEL'};
225print_var(\*DB,'TIDXNAME', \$TIDXNAME);
226print_var(\*DB,'TIDXPGBEG', \$TIDXPGBEG) unless $IsDefault{'TIDXPGBEG'};
227print_var(\*DB,'TIDXPGEND', \$TIDXPGEND) unless $IsDefault{'TIDXPGEND'};
228print_var(\*DB,'TIDXPREFIX', \$TIDXPREFIX);
229print_var(\*DB,'TINDENTBEG', \$TINDENTBEG) unless $IsDefault{'TINDENTBEG'};
230print_var(\*DB,'TINDENTEND', \$TINDENTEND) unless $IsDefault{'TINDENTEND'};
231print_var(\*DB,'TLEVELS', \$TLEVELS);
232print_var(\*DB,'TLIEND', \$TLIEND) unless $IsDefault{'TLIEND'};
233print_var(\*DB,'TLINONE', \$TLINONE) unless $IsDefault{'TLINONE'};
234print_var(\*DB,'TLINONEEND', \$TLINONEEND) unless $IsDefault{'TLINONEEND'};
235print_var(\*DB,'TLITXT', \$TLITXT) unless $IsDefault{'TLITXT'};
236print_var(\*DB,'TFIRSTPGLINK', \$TFIRSTPGLINK)
237 unless $IsDefault{'TFIRSTPGLINK'};
238print_var(\*DB,'TLASTPGLINK', \$TLASTPGLINK)
239 unless $IsDefault{'TLASTPGLINK'};
240print_var(\*DB,'TNEXTPGLINK', \$TNEXTPGLINK) unless $IsDefault{'TNEXTPGLINK'};
241print_var(\*DB,'TNEXTPGLINKIA',\$TNEXTPGLINKIA)
242 unless $IsDefault{'TNEXTPGLINKIA'};
243print_var(\*DB,'TPREVPGLINK', \$TPREVPGLINK) unless $IsDefault{'TPREVPGLINK'};
244print_var(\*DB,'TPREVPGLINKIA',\$TPREVPGLINKIA)
245 unless $IsDefault{'TPREVPGLINKIA'};
246print_var(\*DB,'TSINGLETXT', \$TSINGLETXT) unless $IsDefault{'TSINGLETXT'};
247print_var(\*DB,'TSUBJECTBEG', \$TSUBJECTBEG) unless $IsDefault{'TSUBJECTBEG'};
248print_var(\*DB,'TSUBJECTEND', \$TSUBJECTEND) unless $IsDefault{'TSUBJECTEND'};
249print_var(\*DB,'TSUBLISTBEG', \$TSUBLISTBEG) unless $IsDefault{'TSUBLISTBEG'};
250print_var(\*DB,'TSUBLISTEND', \$TSUBLISTEND) unless $IsDefault{'TSUBLISTEND'};
251print_var(\*DB,'TTITLE', \$TTITLE);
252print_var(\*DB,'TTOPBEG', \$TTOPBEG) unless $IsDefault{'TTOPBEG'};
253print_var(\*DB,'TTOPEND', \$TTOPEND) unless $IsDefault{'TTOPEND'};
254
255print_var(\*DB,'TSLICESINGLETXT', \$TSLICESINGLETXT)
256 unless $IsDefault{'TSLICESINGLETXT'};
257print_var(\*DB,'TSLICETOPBEG', \$TSLICETOPBEG)
258 unless $IsDefault{'TSLICETOPBEG'};
259print_var(\*DB,'TSLICETOPEND', \$TSLICETOPEND)
260 unless $IsDefault{'TSLICETOPEND'};
261print_var(\*DB,'TSLICESUBLISTBEG', \$TSLICESUBLISTBEG)
262 unless $IsDefault{'TSLICESUBLISTBEG'};
263print_var(\*DB,'TSLICESUBLISTEND', \$TSLICESUBLISTEND)
264 unless $IsDefault{'TSLICESUBLISTEND'};
265print_var(\*DB,'TSLICELEVELS', \$TSLICELEVELS)
266 unless $IsDefault{'TSLICELEVELS'};
267print_var(\*DB,'TSLICELITXT', \$TSLICELITXT)
268 unless $IsDefault{'TSLICELITXT'};
269print_var(\*DB,'TSLICELIEND', \$TSLICELIEND)
270 unless $IsDefault{'TSLICELIEND'};
271print_var(\*DB,'TSLICELINONE', \$TSLICELINONE)
272 unless $IsDefault{'TSLICELINONE'};
273print_var(\*DB,'TSLICELINONEEND', \$TSLICELINONEEND)
274 unless $IsDefault{'TSLICELINONEEND'};
275print_var(\*DB,'TSLICESUBJECTBEG', \$TSLICESUBJECTBEG)
276 unless $IsDefault{'TSLICESUBJECTBEG'};
277print_var(\*DB,'TSLICESUBJECTEND', \$TSLICESUBJECTEND)
278 unless $IsDefault{'TSLICESUBJECTEND'};
279print_var(\*DB,'TSLICEINDENTBEG', \$TSLICEINDENTBEG)
280 unless $IsDefault{'TSLICEINDENTBEG'};
281print_var(\*DB,'TSLICEINDENTEND', \$TSLICEINDENTEND)
282 unless $IsDefault{'TSLICEINDENTEND'};
283print_var(\*DB,'TSLICECONTBEG', \$TSLICECONTBEG)
284 unless $IsDefault{'TSLICECONTBEG'};
285print_var(\*DB,'TSLICECONTEND', \$TSLICECONTEND)
286 unless $IsDefault{'TSLICECONTEND'};
287print_var(\*DB,'TSLICESINGLETXTCUR', \$TSLICESINGLETXTCUR)
288 unless $IsDefault{'TSLICESINGLETXTCUR'};
289print_var(\*DB,'TSLICETOPBEGCUR', \$TSLICETOPBEGCUR)
290 unless $IsDefault{'TSLICETOPBEGCUR'};
291print_var(\*DB,'TSLICETOPENDCUR', \$TSLICETOPENDCUR)
292 unless $IsDefault{'TSLICETOPENDCUR'};
293print_var(\*DB,'TSLICELITXTCUR', \$TSLICELITXTCUR)
294 unless $IsDefault{'TSLICELITXTCUR'};
295print_var(\*DB,'TSLICELIENDCUR', \$TSLICELIENDCUR)
296 unless $IsDefault{'TSLICELIENDCUR'};
297
298## Other resources
299print_var(\*DB,'BOTLINKS', \$BOTLINKS) unless $IsDefault{'BOTLINKS'};
300print_var(\*DB,'FIELDSBEG', \$FIELDSBEG) unless $IsDefault{'FIELDSBEG'};
301print_var(\*DB,'FIELDSEND', \$FIELDSEND) unless $IsDefault{'FIELDSEND'};
302print_var(\*DB,'FLDBEG', \$FLDBEG) unless $IsDefault{'FLDBEG'};
303print_var(\*DB,'FLDEND', \$FLDEND) unless $IsDefault{'FLDEND'};
304print_var(\*DB,'FOLUPBEGIN', \$FOLUPBEGIN) unless $IsDefault{'FOLUPBEGIN'};
305print_var(\*DB,'FOLUPEND', \$FOLUPEND) unless $IsDefault{'FOLUPEND'};
306print_var(\*DB,'FOLUPLITXT', \$FOLUPLITXT) unless $IsDefault{'FOLUPLITXT'};
307print_var(\*DB,'HEADBODYSEP', \$HEADBODYSEP) unless $IsDefault{'HEADBODYSEP'};
308print_var(\*DB,'LABELBEG', \$LABELBEG) unless $IsDefault{'LABELBEG'};
309print_var(\*DB,'LABELEND', \$LABELEND) unless $IsDefault{'LABELEND'};
310print_var(\*DB,'MSGBODYEND', \$MSGBODYEND) unless $IsDefault{'MSGBODYEND'};
311print_var(\*DB,'MSGIDLINK', \$MSGIDLINK) unless $IsDefault{'MSGIDLINK'};
312print_var(\*DB,'MSGPGBEG', \$MSGPGBEG) unless $IsDefault{'MSGPGBEG'};
313print_var(\*DB,'MSGPGEND', \$MSGPGEND) unless $IsDefault{'MSGPGEND'};
314print_var(\*DB,'NEXTBUTTON', \$NEXTBUTTON) unless $IsDefault{'NEXTBUTTON'};
315print_var(\*DB,'NEXTBUTTONIA', \$NEXTBUTTONIA)
316 unless $IsDefault{'NEXTBUTTONIA'};
317print_var(\*DB,'NEXTLINK', \$NEXTLINK) unless $IsDefault{'NEXTLINK'};
318print_var(\*DB,'NEXTLINKIA', \$NEXTLINKIA) unless $IsDefault{'NEXTLINKIA'};
319print_var(\*DB,'NOTE', \$NOTE) unless $IsDefault{'NOTE'};
320print_var(\*DB,'NOTEIA', \$NOTEIA) unless $IsDefault{'NOTEIA'};
321print_var(\*DB,'NOTEICON', \$NOTEICON) unless $IsDefault{'NOTEICON'};
322print_var(\*DB,'NOTEICONIA', \$NOTEICONIA) unless $IsDefault{'NOTEICONIA'};
323print_var(\*DB,'PREVBUTTON', \$PREVBUTTON) unless $IsDefault{'PREVBUTTON'};
324print_var(\*DB,'PREVBUTTONIA', \$PREVBUTTONIA)
325 unless $IsDefault{'PREVBUTTONIA'};
326print_var(\*DB,'PREVLINK', \$PREVLINK) unless $IsDefault{'PREVLINK'};
327print_var(\*DB,'PREVLINKIA', \$PREVLINKIA) unless $IsDefault{'PREVLINKIA'};
328print_var(\*DB,'REFSBEGIN', \$REFSBEGIN) unless $IsDefault{'REFSBEGIN'};
329print_var(\*DB,'REFSEND', \$REFSEND) unless $IsDefault{'REFSEND'};
330print_var(\*DB,'REFSLITXT', \$REFSLITXT) unless $IsDefault{'REFSLITXT'};
331print_var(\*DB,'SUBJECTHEADER',\$SUBJECTHEADER)
332 unless $IsDefault{'SUBJECTHEADER'};
333print_var(\*DB,'TNEXTBUTTON', \$TNEXTBUTTON) unless $IsDefault{'TNEXTBUTTON'};
334print_var(\*DB,'TNEXTBUTTONIA',\$TNEXTBUTTONIA)
335 unless $IsDefault{'TNEXTBUTTONIA'};
336print_var(\*DB,'TNEXTINBUTTON', \$TNEXTINBUTTON)
337 unless $IsDefault{'TNEXTINBUTTON'};
338print_var(\*DB,'TNEXTINBUTTONIA', \$TNEXTINBUTTONIA)
339 unless $IsDefault{'TNEXTINBUTTONIA'};
340print_var(\*DB,'TNEXTINLINK', \$TNEXTINLINK)
341 unless $IsDefault{'TNEXTINLINK'};
342print_var(\*DB,'TNEXTINLINKIA', \$TNEXTINLINKIA)
343 unless $IsDefault{'TNEXTINLINKIA'};
344print_var(\*DB,'TNEXTLINK', \$TNEXTLINK) unless $IsDefault{'TNEXTLINK'};
345print_var(\*DB,'TNEXTLINKIA', \$TNEXTLINKIA) unless $IsDefault{'TNEXTLINKIA'};
346print_var(\*DB,'TOPLINKS', \$TOPLINKS) unless $IsDefault{'TOPLINKS'};
347print_var(\*DB,'TPREVBUTTON', \$TPREVBUTTON) unless $IsDefault{'TPREVBUTTON'};
348print_var(\*DB,'TPREVBUTTONIA',\$TPREVBUTTONIA)
349 unless $IsDefault{'TPREVBUTTONIA'};
350print_var(\*DB,'TPREVINBUTTON', \$TPREVINBUTTON)
351 unless $IsDefault{'TPREVINBUTTON'};
352print_var(\*DB,'TPREVINBUTTONIA', \$TPREVINBUTTONIA)
353 unless $IsDefault{'TPREVINBUTTONIA'};
354print_var(\*DB,'TPREVINLINK', \$TPREVINLINK)
355 unless $IsDefault{'TPREVINLINK'};
356print_var(\*DB,'TPREVINLINKIA', \$TPREVINLINKIA)
357 unless $IsDefault{'TPREVINLINKIA'};
358print_var(\*DB,'TPREVLINK', \$TPREVLINK) unless $IsDefault{'TPREVLINK'};
359print_var(\*DB,'TPREVLINKIA', \$TPREVLINKIA) unless $IsDefault{'TPREVLINKIA'};
360print_var(\*DB,'TSLICEBEG', \$TSLICEBEG) unless $IsDefault{'TSLICEBEG'};
361print_var(\*DB,'TSLICEEND', \$TSLICEEND) unless $IsDefault{'TSLICEEND'};
362print_var(\*DB,'TSliceNBefore',\$TSliceNBefore);
363print_var(\*DB,'TSliceNAfter', \$TSliceNAfter);
364print_var(\*DB,'TSliceInclusive', \$TSliceInclusive);
365print_var(\*DB,'TNEXTTOPBUTTON', \$TNEXTTOPBUTTON)
366 unless $IsDefault{'TNEXTTOPBUTTON'};
367print_var(\*DB,'TNEXTTOPBUTTONIA', \$TNEXTTOPBUTTONIA)
368 unless $IsDefault{'TNEXTTOPBUTTONIA'};
369print_var(\*DB,'TNEXTTOPLINK', \$TNEXTTOPLINK)
370 unless $IsDefault{'TNEXTTOPLINK'};
371print_var(\*DB,'TNEXTTOPLINKIA', \$TNEXTTOPLINKIA)
372 unless $IsDefault{'TNEXTTOPLINKIA'};
373print_var(\*DB,'TPREVTOPBUTTON', \$TPREVTOPBUTTON)
374 unless $IsDefault{'TPREVTOPBUTTON'};
375print_var(\*DB,'TPREVTOPBUTTONIA', \$TPREVTOPBUTTONIA)
376 unless $IsDefault{'TPREVTOPBUTTONIA'};
377print_var(\*DB,'TPREVTOPLINK', \$TPREVTOPLINK)
378 unless $IsDefault{'TPREVTOPLINK'};
379print_var(\*DB,'TPREVTOPLINKIA', \$TPREVTOPLINKIA)
380 unless $IsDefault{'TPREVTOPLINKIA'};
381print_var(\*DB,'UMASK', \$UMASK);
382
383}
384
385 ## Invoke save callback
386 if (defined($CBDbSave) && defined(&$CBDbSave)) {
387 &$CBDbSave(\*DB);
388 }
389
390 ## Make sure file ends with a true value
391 print DB "1;\n";
392
393 close(DB);
394
395 if (!rename($tmpfile, $pathname)) {
396 warn qq/ERROR: Unable to rename "$tmpfile" to "$pathname": $!\n/;
397 return 0;
398 }
399 1;
400}
401
402##---------------------------------------------------------------------------
403
404sub escape_str {
405 my($str) = $_[0];
406 $str =~ s/(['\\])/\\$1/g;
407 $str;
408}
409
410##---------------------------------------------------------------------------
411
412sub print_var {
413 my($fh, $name, $ref, $d) = @_;
414
415 if (ref($ref) eq 'SCALAR') {
416 print $fh qq/\$$name='/, escape_str($$ref), qq/'/;
417 print $fh qq/ unless defined(\$$name)/ if $d;
418 print $fh qq/;\n/;
419 return;
420 }
421
422 if (ref($ref) eq 'HASH') {
423 my($key, $value, $sep);
424 if (defined($name)) {
425 print $fh "%$name=(\n";
426 $sep = "\n";
427 } else {
428 print $fh '{';
429 $sep = "";
430 }
431 while (($key, $value) = each(%$ref)) {
432 print $fh qq/'/, escape_str($key), qq/',/;
433 if (ref($value)) {
434 print_var($fh, undef, $value, 0);
435 print $fh ",\n";
436 next;
437 }
438 if (defined($value)) {
439 print $fh qq/'/, escape_str($value), qq/',/, $sep;
440 } else {
441 print $fh 'undef,', $sep;
442 }
443 }
444 if (defined($name)) {
445 print $fh ");\n";
446 } else {
447 print $fh '}';
448 }
449 return;
450 }
451
452 if (ref($ref) eq 'ARRAY') {
453 local $_;
454 my $sep;
455 if (defined($name)) {
456 print $fh "\@$name=(\n";
457 $sep = "\n";
458 } else {
459 print $fh '[';
460 $sep = "";
461 }
462 foreach (@$ref) {
463 if (ref($_)) {
464 print_var($fh, undef, $_, 0);
465 print $fh ",\n";
466 next;
467 }
468 if (defined($_)) {
469 print $fh qq/'/, escape_str($_), qq/',/, $sep;
470 } else {
471 print $fh 'undef,', $sep;
472 }
473 }
474 if (defined($name)) {
475 print $fh ");\n";
476 } else {
477 print $fh ']';
478 }
479 return;
480 }
481
482 print $fh qq/\$$name='/, escape_str($ref), qq/'/;
483 print $fh qq/ unless defined(\$$name)/ if $d;
484 print $fh qq/;\n/;
485}
486
487##---------------------------------------------------------------------------##
4881;
Full OpenSPARC design & verification tarball including full HDL.