contrib/makeexpctl.in

   1 #!/usr/local/bin/perl
   2 # fixscript will replace this line with require innshellvars.pl
   3
   4 # Create expire.ctl script based on recently read articles.  Argument gives
   5 # scale factor to use to adjust expires.
   6
   7 $readfile="$inn::pathdb/readgroups";
   8
   9 $expirectl=$inn::expirectl;
  10 if (open(RDF, $readfile)) {
  11     while (<RDF>) {
  12         chop;
  13         @foo=split(/ /); # foo[0] should be group, foo[1] lastreadtime
  14         if ($foo[1] < $oldtime) {
  15             next; # skip entries that are too old.
  16         }
  17         $groups{$foo[0]} = $foo[1];
  18     }
  19     close(RDF);
  20 }
  21
  22 $scale = $ARGV[0];
  23 if ($scale <= 0) {
  24     die "invalid scale parameter\n";
  25 }
  26
  27 rename($expirectl, "$expirectl.OLD") || die "rename $expirectl failed!\n";
  28 open(OUTFILE, ">$expirectl") || die "open $expirectl for write failed!\n";
  29
  30 print OUTFILE <<'EOF' ;
  31 ##  expire.ctl - expire control file
  32 ##  Format:
  33 ##      /remember/:<keep>
  34 ##      <patterns>:<modflag>:<keep>:<default>:<purge>
  35 ##  First line gives history retention; other lines specify expiration
  36 ##  for newsgroups.  Must have a "*:A:..." line which is the default.
  37 ##      <patterns>      wildmat-style patterns for the newsgroups
  38 ##      <modflag>       Pick one of M U A -- modifies pattern to be only
  39 ##                      moderated, unmoderated, or all groups
  40 ##      <keep>          Mininum number of days to keep article
  41 ##      <default>       Default number of days to keep the article
  42 ##      <purge>         Flush article after this many days
  43 ##  <keep>, <default>, and <purge> can be floating-point numbers or the
  44 ##  word "never."  Times are based on when received unless -p is used;
  45 ##  see expire.8
  46
  47 # How long to remember old history entries for.
  48 /remember/:2
  49 #
  50 EOF
  51
  52 # defaults for most groups.
  53 printline("*", "A", 1);
  54 printline("alt*,misc*,news*,rec*,sci*,soc*,talk*,vmsnet*","U",3);
  55 printline("alt*,misc*,news*,rec*,sci*,soc*,talk*,vmsnet*","M",5);
  56 printline("comp*,gnu*,info*,ok*,ecn*,uok*", "U", 5);
  57 printline("comp*,gnu*,info*,ok*,ecn*,uok*", "M", 7);
  58 # and now handle each group that's regularly read,
  59 # assinging them 3* normal max expire
  60 foreach $i (keys %groups) {
  61     printline($i, "A", 21);
  62 }
  63 # and now put some overrides for groups which are too likely to fill spool if
  64 # we let them go to autoexpire.
  65 printline("*binaries*,*pictures*", "A", 0.5);
  66 printline("control*","A",1);
  67 printline("control.cancel","A",0.5);
  68 printline("news.lists.filters,alt.nocem.misc","A",1);
  69
  70 close(OUTFILE);
  71 exit(1);
  72
  73 sub printline {
  74     local($grpstr, $mflag, $len) = @_;
  75     print OUTFILE $grpstr,":",$mflag,":",$len*$scale,":",$len*$scale,":",$len*$scale,"\n";
  76 }