home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / Perl_WWW_Utilities / MHonArc / lib / mhdb.pl < prev    next >
Encoding:
Perl Script  |  1996-03-12  |  5.9 KB  |  164 lines
  1. ##---------------------------------------------------------------------------##
  2. ##  File:
  3. ##      mhdb.pl
  4. ##  Author:
  5. ##      Earl Hood       ehood@convex.com
  6. ##  Description:
  7. ##      MHonArc library defining routines for outputing database.
  8. ##  Date:
  9. ##    Tue Mar 12 13:07:30 CST 1996
  10. ##---------------------------------------------------------------------------##
  11. ##    MHonArc -- Internet mail-to-HTML converter
  12. ##    Copyright (C) 1995    Earl Hood, ehood@convex.com
  13. ##
  14. ##    This program is free software; you can redistribute it and/or modify
  15. ##    it under the terms of the GNU General Public License as published by
  16. ##    the Free Software Foundation; either version 2 of the License, or
  17. ##    (at your option) any later version.
  18. ##
  19. ##    This program is distributed in the hope that it will be useful,
  20. ##    but WITHOUT ANY WARRANTY; without even the implied warranty of
  21. ##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22. ##    GNU General Public License for more details.
  23. ##
  24. ##    You should have received a copy of the GNU General Public License
  25. ##    along with this program; if not, write to the Free Software
  26. ##    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  27. ##---------------------------------------------------------------------------##
  28.  
  29. package main;
  30.  
  31. ##---------------------------------------------------------------------------
  32. ##    output_db() spits out the state of mhonarc to a file.  This
  33. ##    (database) file contains information to update mail threading
  34. ##    when incremental adding is done.  The actual database file
  35. ##    is a Perl program defining all the internal data structures.  All
  36. ##    mhonarc does is 'require' it when updating.  This is really
  37. ##    fast and avoids storing mail threading info in the HTML message
  38. ##    files -- which would require opening every file to perform
  39. ##    updates.
  40. ##
  41. sub output_db {
  42.     if (open(DB, "> ${OUTDIR}${DIRSEP}${DBFILE}")) {
  43.  
  44.     print DB "## MHonArc ($VERSION) database/state information\n",
  45.          "## This file is needed to perform updates to the archive\n",
  46.          "## DO NOT MODIFY.\n",
  47.          "##\n";
  48.     &print_var(DB, 'DbVERSION', *VERSION);
  49.  
  50.     &print_assoc(DB, 'ContentType', *ContentType);
  51.     &print_assoc(DB, 'Date', *Date);
  52.     &print_assoc(DB, 'Derived', *Derived);
  53.     &print_assoc(DB, 'FieldODefs', *FieldODefs);
  54.     &print_assoc(DB, 'FollowOld', *Follow);
  55.     &print_assoc(DB, 'From', *From);
  56.     &print_assoc(DB, 'HFieldsExc', *HFieldsExc);
  57.     &print_assoc(DB, 'HeadFields', *HeadFields);
  58.     &print_assoc(DB, 'HeadHeads', *HeadHeads);
  59.     &print_assoc(DB, 'Icons', *Icons);
  60.     &print_assoc(DB, 'IndexNum', *IndexNum);
  61.     &print_assoc(DB, 'MIMEFilters', *MIMEFilters);
  62.     &print_assoc(DB, 'MIMEFiltersArgs', *MIMEFiltersArgs);
  63.     &print_assoc(DB, 'MsgId', *MsgId);
  64.     &print_assoc(DB, 'Refs', *Refs);
  65.     &print_assoc(DB, 'Subject', *Subject);
  66.  
  67.     &print_array(DB, 'FieldOrder', *FieldOrder);
  68.     &print_array(DB, 'OtherIdxs', *OtherIdxs);
  69.     &print_array(DB, 'PerlINC', *PerlINC);
  70.     &print_array(DB, 'Requires', *Requires);
  71.  
  72.     &print_var(DB, 'BOTLINKS', *BOTLINKS);
  73.     &print_var(DB, 'DOCURL', *DOCURL);
  74.     &print_var(DB, 'FROM', *FROM);
  75.     &print_var(DB, 'IDXNAME', *IDXNAME);
  76.     &print_var(DB, 'IDXPGBEG', *IDXPGBEG);
  77.     &print_var(DB, 'IDXPGEND', *IDXPGEND);
  78.     &print_var(DB, 'IDXSIZE', *IDXSIZE);
  79.     &print_var(DB, 'LIBEG', *LIBEG);
  80.     &print_var(DB, 'LIEND', *LIEND);
  81.     &print_var(DB, 'LITMPL', *LITMPL);
  82.     &print_var(DB, 'MAILTOURL', *MAILTOURL);
  83.     &print_var(DB, 'MAXSIZE', *MAXSIZE);
  84.     &print_var(DB, 'MSGFOOT', *MSGFOOT);
  85.     &print_var(DB, 'MSGHEAD', *MSGHEAD);
  86.     &print_var(DB, 'MSGPGBEG', *MSGPGBEG);
  87.     &print_var(DB, 'MSGPGEND', *MSGPGEND);
  88.     &print_var(DB, 'NEXTBL', *NEXTBL);
  89.     &print_var(DB, 'NEXTBUTTON', *NEXTBUTTON);
  90.     &print_var(DB, 'NEXTBUTTONIA', *NEXTBUTTONIA);
  91.     &print_var(DB, 'NEXTFL', *NEXTFL);
  92.     &print_var(DB, 'NEXTLINK', *NEXTLINK);
  93.     &print_var(DB, 'NEXTLINKIA', *NEXTLINKIA);
  94.     &print_var(DB, 'NOMAILTO', *NOMAILTO);
  95.     &print_var(DB, 'NONEWS', *NONEWS);
  96.     &print_var(DB, 'NOSORT', *NOSORT);
  97.     &print_var(DB, 'NOURL', *NOURL);
  98.     &print_var(DB, 'NumOfMsgs', *NumOfMsgs);
  99.     &print_var(DB, 'PREVBUTTON', *PREVBUTTON);
  100.     &print_var(DB, 'PREVBUTTONIA', *PREVBUTTONIA);
  101.     &print_var(DB, 'PREVLINK', *PREVLINK);
  102.     &print_var(DB, 'PREVLINKIA', *PREVLINKIA);
  103.     &print_var(DB, 'REVSORT', *REVSORT);
  104.     &print_var(DB, 'SUBSORT', *SUBSORT);
  105.     &print_var(DB, 'TFOOT', *TFOOT);
  106.     &print_var(DB, 'THEAD', *THEAD);
  107.     &print_var(DB, 'THREAD', *THREAD);
  108.     &print_var(DB, 'TIDXNAME', *TIDXNAME);
  109.     &print_var(DB, 'TIDXPGBEG', *TIDXPGBEG);
  110.     &print_var(DB, 'TIDXPGEND', *TIDXPGEND);
  111.     &print_var(DB, 'TITLE', *TITLE);
  112.     &print_var(DB, 'TLEVELS', *TLEVELS);
  113.     &print_var(DB, 'TLITXT', *TLITXT);
  114.     &print_var(DB, 'TOPLINKS', *TOPLINKS);
  115.     &print_var(DB, 'TREVERSE', *TREVERSE);
  116.     &print_var(DB, 'TTITLE', *TTITLE);
  117.     &print_var(DB, 'UMASK', *UMASK);
  118.  
  119.     print DB "1;\n";
  120.     } else {
  121.     warn "Warning: Unable to create ${OUTDIR}${DIRSEP}${DBFILE}\n";
  122.     }
  123. }
  124. ##---------------------------------------------------------------------------
  125. sub print_assoc {
  126.     local($handle, $name, *assoc) = @_;
  127.  
  128.     print $handle "%$name = (\n";
  129.     foreach (keys %assoc) {
  130.     print $handle qq{'}, &escape_str($_), qq{', '},
  131.               &escape_str($assoc{$_}), qq{',\n};
  132.     }
  133.     print $handle ");\n";
  134. }
  135. ##---------------------------------------------------------------------------
  136. sub print_array {
  137.     local($handle, $name, *array) = @_;
  138.  
  139.     print $handle "\@$name = (\n";
  140.     foreach (@array) {
  141.     print $handle qq{'}, &escape_str($_), qq{',\n};
  142.     }
  143.     print $handle ");\n";
  144. }
  145. ##---------------------------------------------------------------------------
  146. sub print_var {
  147.     local($handle, $name, *var, $d) = @_;
  148.  
  149.     print $handle qq{\$$name = '}, &escape_str($var), qq{'};
  150.     print $handle qq{  unless defined(\$$name)}  if $d;
  151.     print $handle qq{;\n};
  152. }
  153. ##---------------------------------------------------------------------------
  154. sub escape_str {
  155.     local($str) = $_[0];
  156.  
  157.     $str =~ s/\\/\\\\/g;
  158.     $str =~ s/'/\\'/g;
  159.     $str;
  160. }
  161.  
  162. ##---------------------------------------------------------------------------##
  163. 1;
  164.