# $Id: faqfile.pl,v 1.20 1994/02/22 01:39:57 jik Exp $
# 
# Copyright (c) 1992 Jonathan I. Kamens.  See the GNU Public License
# (any version) for terms of distribution.

package faqfile;

$default_interval = 0;
$default_sigfile = "none";
$default_force = 0;
$check_duplicates = 1;
$; = "\034";
# Set this only at the beginning of FAQ config file operations!
$file_version = 1;

sub parse_faq {
    # The format of an individual FAQ specification line in the config
    # file is as follows:
    # 
    # idname file timestamp interval sigfile force parent
    # 
    # The fields are separated by blank space.  If the $file_version
    # variable is greater than 1, An entire field can be
    # quoted by enclosing it in single or double quotes and any
    # character can be quoted by preceding it by backslash.
    # Otherwise, fields cannot include spaces or tabs, and backslashes
    # are treated literally.
    # 
    # A blank field should be indiated with a single period.
    # 
    # idname -- The string to use as the unique name of the FAQ in the
    #   Message ID of the posted article.
    # file -- The file containing the text of the FAQ.  This should be
    # 	readable from the current directory.
    # timestamp -- The timestamp of when the article was last posted.
    # 	If unspecified, the article is assumed not to have been
    #   posted.  This field is filled in automatically by the program
    #   when it rewrites the config file after doing a set of
    #   postings.
    # interval -- If a number, the number of days to wait after the
    #   last posting before posting the FAQ again.  Defaults to the
    #   interval hard-coded into the program, or to the interval
    #   specified with the "-interval" command-line option.
    #   
    #   If not a number, and the $file_version variable is greater
    #   than 1, then a perl expression to be evaluated to determine
    #   whether or not to post the FAQ.  When the expression is
    #   evaluated, the following variables will be defined:
    #   
    #     $minute	the current minute in the hour, 0 through 59
    #     $hour		the current hour, 0 through 23
    #     $mday		the current day of the month, 0 through 31
    #     $month	the current month, 0 through 11
    #     $year		the current year
    #     $wday         the current day of the week, 0 through 6 (0 is
    #                   Sunday)
    #     $yday         the current day in the year
    #     $interval	the number of days since the last posting, or
    #                   undef if there is no previous posting timestamp
    #   
    #   The expression should evaluate to true if the FAQ should be
    #   posted.
    #
    # sigfile -- The signature file to append to the bottom of the
    #   message, with "-- \n" prepended to it.  If unspecified,
    #   defaults to the hard-coded path or to the file specified with
    #   "-sigfile".  If "none", don't include a signature file.  So,
    #   you can't have a signature file named "none" in the current
    #   working directory; use "./none". So sue me.
    # force -- If specified, then treat the contents as a number.  If
    #   it is 0, then never force the posting of this article.  If it
    #   is a 1, then force the posting of this article just once, and
    #   replace the 1 with an empty field ('.') when done doing so.
    #   If it is a 2, then always force the posting of this article.
    #   If it is a 3, then force the posting of this article just
    #   once, and replace the 3 with -2 when done doing so.  If it is
    #   a -1 or -2, then force the article NOT to be posted, no matter
    #   what.  Any other values are illegal.  If not specified, the
    #   hard-coded force parameter or the presence or absence of
    #   "-force" on the command line is used to decide whether or not
    #   to force.
    # parent -- The ID name of the parent article of this one, if any.
    # 	The parent's FAQ specification must appear earlier in the
    #   config file than the child's.  If a parent is specified, then
    #   the child article will not be posted unless the parent was
    #   posted successfully.  Note that *if* the parent posts
    #   successfully, the child won't post unless its interval has
    #   expired, so if you want the child to post whenever the parent
    #   did, make sure to use "force" (see above).
    # 
    # Blank lines, lines with only whitespace, and lines starting with
    # '#' in the config file are ignored.
    local($line) = @_;
    local($whitespace);
    local(@fields);

    return undef if (($line =~ /^[ \t]*$/) || ($line =~ /^\#/));

    if ($file_version < 2) {
	@fields = split(' ', $line);
    }
    else {
	($whitespace, @fields) = &split_fields($line);
    }

    if (! @fields) {
	warn "Malformatted FAQ specification \"$line\".  Ignoring FAQ.\n";
	return undef;
    }
    elsif (@fields != 7) {
	warn "Wrong number of fields in FAQ specification \"$line\".  Ignoring FAQ.\n";
	return undef;
    }

    local($idname) = shift @fields;

    if ($idname eq "") {
	warn "No ID name specified in FAQ specification \"$line\".  Ignoring FAQ.\n";
	return undef;
    }

    if ($check_duplicates && $faqs{$idname,"file"}) {
	warn "Duplicate ID name $idname.  Ignoring FAQ.\n";
	return undef;
    }
    local($file) = shift @fields;

    if ($file eq "") {
	warn "No file specified in FAQ specification in \"$line\".  Ignoring FAQ.\n";
	return undef;
    }

    local($timestamp) = shift @fields;
    if ($timestamp eq ".") {
	$timestamp = undef;
    }
    elsif ($timestamp !~ /^[0-9]+$/) {
	warn "Timestamp \"$timestamp\" in FAQ specification \"$line\" is invalid.  Ignoring FAQ.\n";
	return undef;
    }

    local($interval) = shift @fields;
    if ($interval eq ".") {
	$interval = undef;
    }
    elsif ($interval !~ /^[0-9.]+$/) {
	if ($file_version < 2) {
	    warn "Interval \"$interval\" in FAQ specification \"$line\" is invalid.  Ignoring FAQ.\n";
	    return undef;
	}
    }

    local($sigfile) = shift @fields;
    ($sigfile = undef) if ($sigfile eq ".");

    local($force) = shift @fields;
    if ($force eq ".") {
	$force = undef;
    }
    elsif (($force !~ /^(-|)[0-9]+$/) || ($force < -2) || ($force > 3)) {
	warn "Force parameter \"$force\" in FAQ specification \"$line\" is invalid.  Ignoring FAQ.\n";
	return undef;
    }

    local($parent) = shift @fields;
    if ($parent eq ".") {
	$parent = undef;
    }
    elsif (! $faqs{$parent,"file"}) {
	warn "FAQ specification \"$line\" has unknown parent \"$parent\".  Ignoring FAQ.\n";
	return undef;
    }

    $faqs{$idname,"file"} = $file;
    $faqs{$idname,"timestamp"} = $timestamp;
    $faqs{$idname,"interval"} = $interval;
    $faqs{$idname,"sigfile"} = $sigfile;
    $faqs{$idname,"force"} = $force;
    $faqs{$idname,"parent"} = $parent;
    if ($file_version > 1) {
	$faqs{$idname,'whitespace'} = $whitespace;
    }
    else {
	$faqs{$idname,"configline"} = $line;
    }

    return($idname, eval "\"$file\"", $timestamp, 
	   $interval ? $interval : $default_interval,
	   $sigfile ? $sigfile : $default_sigfile,
	   $force ? $force : $default_force, $parent);
}

sub get_file {
    $faqs{$_[0],"file"};
}

sub get_timestamp {
    $faqs{$_[0],"timestamp"};
}

sub get_interval {
    if ($faqs{$_[0],"file"}) {
	$faqs{$_[0],"interval"} || $default_interval;
    }
    else {
	undef;
    }
}

sub get_sigfile {
    if ($faqs{$_[0],"file"}) {
	$faqs{$_[0],"sigfile"} || $default_sigfile;
    }
    else {
	undef;
    }
}

sub get_force {
    if ($faqs{$_[0],"file"}) {
	$faqs{$_[0],"force"} || $default_force;
    }
    else {
	undef;
    }
}

sub get_parent {
    $faqs{$_[0],"parent"};
}

sub set_posted {
    $faqs{$_[0],"posted"}++;
}

sub set_name {
    local($old, $new) = @_;

    for ("file", "timestamp", "interval", "sigfile", "force", "parent",
	 "configline") {
	$faqs{$new,$_} = $faqs{$old,$_};
    }
    &delete($old);
}

sub set_file {
    return if (! $_[1]);
    $faqs{$_[0],"file"} = $_[1];
}

sub set_timestamp {
    local($idname, $timestamp) = @_;
    ($timestamp = ".") if (! $timestamp);
    $faqs{$idname,"timestamp"} = $timestamp;
}

sub set_interval {
    local($idname, $interval) = @_;
    ($interval = ".") if (! $interval);
    $faqs{$idname,"interval"} = $interval;
}

sub set_sigfile {
    local($idname, $sigfile) = @_;
    ($sigfile = ".") if (! $sigfile);
    $faqs{$_[0],"sigfile"} = $sigfile;
}

sub set_force {
    local($idname, $force) = @_;
    ($force = ".") if (! $force);
    $faqs{$idname,"force"} = $force;
}

sub set_parent {
    local($idname, $parent) = @_;
    ($parent = ".") if (! $parent);
    $faqs{$idname,"parent"} = $parent;
}

sub configline {
    local($id) = $_[0];
    local($_);
    local($fi, $t, $i, $s, $fo, $p) = 
	($faqs{$id,"file"}, $faqs{$id,"timestamp"}, $faqs{$id,"interval"},
	 $faqs{$id,"sigfile"}, $faqs{$id,"force"}, $faqs{$id,"parent"});

    $t = "." if (! $t);
    $i = "." if (! $i);
    $s = "." if (! $s);
    $fo = "." if (! $fo);
    $p = "." if (! $p);

    if ($file_version > 1) {
	local($line, @whitespace);
	@whitespace = split($;, $faqs{$id,"whitespace"});
	$line = shift @whitespace;
	for ($id, $fi, $t, $i, $s, $fo, $p) {
	    s/[\'\"\\ \t]/$1/g;
	    $line .= $_ . (shift @whitespace);
	}
	# Catch any whitespace at the end of the line
	$line .= (shift @whitespace) if (@whitespace);
	# This needs to be "return $line" rather than just "$line", because
	# it's local to this block, because of a bug in Perl 4.036, which
	# Larry said he'll figure out how ti fix in Perl 5.
	return $line;
    }
    else {
	if ($faqs{$id,"configline"} !~ s/^(\s*)[^\s]+(\s+)[^\s]+(\s+)[^\s]+(\s+)[^\s]+(\s+)[^\s]+(\s+)[^\s]+(\s+)[^\s]+(\s*)$/$1$id$2$fi$3$t$4$i$5$s$6$fo$7$p$8/) {
	    die sprintf("possible internal error in faqfile'configline\n(For archive name %s, configline is\n%s", $id, $faqs{$id,"configline"});
	}
	$faqs{$id,"configline"};
    }
}
    
sub was_posted {
    $faqs{$_[0],"posted"};
}

sub timestamp {
    $faqs{$_[0],"timestamp"};
}

sub new_configline {
    local($idname, $file, $timestamp, $interval, $sigfile, $force, $parent) =
	@_;
    local($_);

    if ($file_version > 1) {
	for ($idname, $file, $timestamp, $interval, $sigfile, $force, 
	     $parent) {
	    s/([\'\"\\ \t])/$1/g;
	}
    }

    sprintf("%s\t%s\t%s\t%s\t%s\t%s\t%s", $idname, $file,
	    $timestamp ? $timestamp : ".", $interval ? $interval : ".",
	    $sigfile ? $sigfile : ".", $force ? $force : ".",
	    $parent ? $parent : ".");
}

sub delete {
    local($name) = @_;

    for ("file", "timestamp", "interval", "sigfile", "force", "parent",
	 "configline", "whitespace") {
	delete $faqs{$name,$_};
    }
}

sub split_fields {
    local($_) = $_[0];
    local(@fields);
    local(@whitespace);
    local($whitespace);

    while (1) {
	if (s/^(\s*)([\"\'])(([^\2\\]|\\.)*)\2//) {
	    push(@whitespace, $1);
	    push(@fields, $3);
	}
	elsif (/^\s*[^\'\"]/ && s/^(\s*)(([^\\ \t]|\\.)+)//) {
	    push(@whitespace, $1);
	    push(@fields, $2);
	}
	else {
	    return undef if (/\S/);
	    push(@whitespace, $_);
	    last;
	}
    }
    
    grep(s/\\(.)/$1/g, @fields);
    $whitespace = join($;, @whitespace);

    ($whitespace, @fields);
}

sub should_post {
    local($idname, $time) = @_;
    local($parent);
    local($post_interval);
    local($timestamp);
    local($second, $minute, $hour, $mday, $month, $year, $wday, $yday, 
	  $interval);
    local($do_post);
    local($force);

    # Uses the following criteria to determine whether or not an FAQ
    # should be posted:
    # 1. If its force field is negative, don't post.
    # 2. If it has a parent that wasn't posted, don't post.
    # 3. If the force field is positive, post.
    # 4. If its interval field contains just a number which is smaller
    #    than the number of days since the last posting, then post.
    # 5. If the interval field contains something other than a number,
    #    then evaluate it as described in the comments above and post if
    #    it is true.  This only works if $file_version > 1.
    # 6. Otherwise, don't post.

    if (($force = &get_force($idname)) < 0) {
	return(0, "force field is negative");
    }
    elsif (($parent = &get_parent($idname)) && !&was_posted($parent)) {
	return(0, "parent was not posted");
    }
    elsif ($force) {
	return(1, "force field is positive");
    }
    $post_interval = &get_interval($idname);
    $timestamp = &get_timestamp($idname);
    if ($timestamp) {
        # "3600" means 1 hour, a tolerance to allow daily posts
	$interval = (time - $timestamp + 3600) / (60 * 60 * 24);
    }
    if ($post_interval =~ /^[0-9]+$/) {
	local($scheduled);
	return(1, "no previous timestamp") if (! $interval);
	return(1, "posting interval expired") if ($interval > $post_interval);
	$scheduled = &date($timestamp + 60 * 60 * 24 * $post_interval);
	return(0, "scheduled to be posted on or around $scheduled");
    }
    else {
	($second, $minute, $hour, $mday, $month, $year, $wday, $yday) =
	    localtime($time || time);
	$year += 1900;
	$do_post = eval $post_interval;
	if ($@) {
	    local($foo) = "Interval expression \"$post_interval\" had error during eval: $@";
	    
	    warn "$foo.\n";
	    return(0, $foo);
	}
	return(1, "interval expression \"$post_interval\" is true")
	    if $do_post;
	return(0, "interval expression \"$post_interval\" is false");
    }
}

sub expire_search {
    local($idname, $time) = @_;
    local($count);
    local($timeout, $reason);

    return undef if (! &get_interval($idname));

    $time = time if (! $time);

    while (1) {
	$time += 60 * 60 * 24; # one day
	($timeout, $reason) = &should_post($idname, $time);
	return $time if ($timeout);
	warn "Finished $count iterations for $idname in \&faqfile'expire_search; Possibly looping?\n"
	    if ((++$count % 100) == 0);
    }
}

@months = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug',
	   'Sep', 'Oct', 'Nov', 'Dec');

sub date {
    ($sec, $min, $hour, $mday, $mon, $year) = localtime($_[0]);
    sprintf("%s %d, %d", $months[$mon], $mday, 1900 + $year);
}

1;