#!/usr/bin/perl
# psl-subscribe - update psl subscription files                   -*- perl -*-

# (c) 1994-95 Olaf Titz <olaf.titz@inka.de> and INKA e.V.
# $Id: psl-subscribe,v 2.5 1996/01/07 18:24:58 olaf Exp $

# Usage: psl-subscribe server file...
# Take the respective server active file, look what's in to
# subscribe, and write a new articles file (taking the numbers from the
# old one) reflecting the current subscriptions.
# What to subscribe is given by pattern lists in the named files (e.g.
# feed subscription lists), they are ORed.
# The files are lists of subscription patterns (INN wildmat(3) style
# with ! for exclusions), e.g. GUP "groups" files.

# 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.

require "getopts.pl";
require "lockfiles.pl";
require "psl-parm.pl";

$opt_w = 1800;  # how long to wait (default 30 min) if server is locked
$opt_m = 2;     # and how often to repeat this (default 2)
# $opt_a        # get all articles, including old ones
# $opt_g        # automatically add new newsgroups

&Getopts("w:m:ag");
$aform = $opt_a ? "1" : "1-%d";
$server = shift || die "Usage: $0 <server> <file...>";

# ----------------------------------------------------------------------------
$nsubs = 1;
push(@asubl1, "control.*"); # we always want this
$rate[1] = -1e9;
while ($f = shift) {
    if (open(S, "<$f")) {
       print STDOUT "$f ";
       ++$nsubs; $r=0;
       local(*sub) = "asubl$nsubs";
       while (<S>) {
           chop;
           # attempt to rate the patterns
           /\*/ && do {$r-=5; $r-=10 if (/^!/);}; # prefer wildcards
           $r += length;
           push(@sub, &convpat($_));
       }
       close S;
       $rate[$nsubs] = $r;
    } else {
       print STDERR "Can't read subscription file $f\n";
    }
}
# reorder subscription lists
foreach $n (1...$nsubs) {
    $m = $n;
    foreach $i (1...$nsubs) {
       if ($rate[$i] < $rate[$m]) {
           $m = $i;
       }
    }
    local(*asub) = "asubl$m";
    local(*sub) = "subl$n";
    @sub = @asub;
    undef @asub;
    $rate[$m] = 1e9;
}

chdir("$workdir/$server") ||
    die "chdir($workdir/$server) failed";
while (--$opt_m) {
    if (&lockfile("LOCK.", "server")) {
       last;
    }
    if ($?<0) {
       print STDERR "Can't establish lock for $server";
    } else {
       print STDERR "$server is locked by pid $?\n";
       sleep $opt_w;
    }
}
if (!open(LOG, ">>$logfile")) {
    print STDERR "Can't open logfile for $server\n";
}
select(LOG); $|=1;
&process_server;

if ($opt_g) {
    chdir("$newslib") ||
       die "chdir($newslib) failed";
    $count = 0;
    while (1) {
       if (&lockfile("LOCK", "")) {
           last;
       }
       if ($?<0) {
           print STDERR "Can't lock the news system";
       } else {
           sleep 10;
       }
    }
    $tstr = sprintf("%d %s@%s (psl-subscribe)", time, $logname, $hostname);
    if (open(A, "+<$active")) {
       while (<A>) {
           ($g,$x,$y,$f) = split;
           $active{$g} = $f;
       }
       if (open(T, ">>active.times")) {
           foreach $g (keys %subscr) {
               if (!$active{$g}) { # add this group
                   $x = $subscr{$g};
                   print A "$g 0000000000 00001 $x\n";
                   &mkdirs($g);
                   print T "$g $tstr\n";
                   ++$count;
               }
            }
       } else {
           print STDERR "Can't open active.times file: $!\n";
       }
       print LOG "   $count groups added.\n";
    } else {
       print STDERR "Can't open the active file: $!\n";
    }
    unlink("LOCK");
}
close LOG;
unlink("$workdir/$server/LOCK.server");
exit 0;

# ----------------------------------------------------------------------------

sub process_server
{
    $count = 0;
    @_ = localtime; $_[5]+=1900 if ($_[5]<1901);
    printf (LOG "\n+++ psl-subscribe %02d.%02d.%04d %02d:%02d\n",
       $_[3], ++$_[4], $_[5], $_[2], $_[1]);
    if (!open(NSUB, ">$artfile+")) {
       print LOG "   open new file failed: $!\n";
       return;
    }
# this hook is for later
##    if (!open(SACT, ">>$sactfile")) {
##      print LOG "   open active file failed: $!\n";
##      return;
##   }
##   close SACT;
    if (!open(SACT, "<$sactfile")) {
       print LOG "   open active file failed: $!\n";
       return;
    }
    print STDOUT "\n$server";
    if (open(ART, "<$artfile")) {
       print STDOUT " O";
       while (<ART>) {
           ($g,$l) = split(/[\s:!]+/, $_);
           $grp{$g} = $l;
       }
       close ART;
    }
    if (open(SUB, "<$subfile")) {
       print STDOUT " S";
       while (<SUB>) {
           chop;
           push(@sublist, &convpat($_));
       }
       close SUB;
    } else {
       push(@sublist, &convpat("*"));
    }
    print STDOUT " A";
    while (<SACT>) {
       ($g,$x,$y,$f) = split;
       $s = &globsublistmat($g);
       if ($s) { # subscribe!
           ($l = $grp{$g}) || do {$l=sprintf($aform,$x);};
           printf(NSUB "%s: %s\n", $g, $l);
           ++$count;
           if ($opt_g) {
               $subscr{$g} = $f;
           }
       } elsif ($l=$grp{$g}) {
           printf(NSUB "%s! %s\n", $g, $l);
       }
       if ((++$progress)>50) {
           print STDOUT "."; $progress=0;
       }
    }
    close SACT;
    print STDOUT " $count\n";
    print LOG "   $count groups subscribed.\n";
    unlink("$artfile.old");
    rename("$artfile", "$artfile.old");
    rename("$artfile+", "$artfile");
}

# ----------------------------------------------------------------------------

sub convpat
# convert wildmat -> regexp
{
    local($_) = @_;
    s/(\W)/\\\1/g;
    s/\\\*/.\*/g;
    s/^\\!/!/;
    return $_;
}

sub sublistmat
# sublistmat(string, array) - test if string matches into array
{
    local($s,*sub) = @_;
    local($m,$p) = (0,0);
    foreach $i (@sub) {
       $p = $i;
       if ($p =~ s/^!//) {
           $m=0 if ($s =~ /^$p$/i);
       } else {
           $m=1 if ($s =~ /^$p$/i);
       }
    }
    return $m;
}

sub globsublistmat
# globsublistmat(string)
# test if string matches into @sublist *and* _either one_ of @subl1...
{
    local($s,$i) = @_;
    return 0 if (!$nsubs);
    return 0 unless &sublistmat($s,sublist);
    foreach $i (1...$nsubs) {
       return 1 if &sublistmat($s,"subl$i");
    }
    return 0;
}

sub mkdirs
# mkdirs(group)
# make the spool directory for "group"
# Assumes you have the news UID!
{
    local(@x) = split(/\./, $_[0]);
    local($i);
    foreach $i (0..$#x) {
       mkdir(join("/", ($newsarts, @x[0..$i])), 0775); # ignore error
    }
}

# ----------------------------------------------------------------------------

