#!/usr/local/bin/perl

#  Copyright (c) 2005-2008 Frédéric Senault.  All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. Neither the name of the author or any contributors may be used to
#    endorse or promote products derived from this software without
#    specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE AHTOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

use strict;

#Répertoire temporaire
my($tmpdir)="/news/tmp";

#Chemin d'autopost
my($pathap)="/usr/local/news/tools";

#Répertoire de datas pour autopost
my($path)="/news/autopost";

#Fichier log
my($log)="/var/log/news/autocron";

#Mode bavard
my($verbose)=1;

#Mode debug
my($debug)=(@ARGV && $ARGV[0] eq '-d');

#Heure d'expiration par défaut
my($exph)="06:59:00 GMT";

##############################################################################
my($autocronv)="1.0";
my($now,$j,$m,$a,$s,$n,$h);
my($tper,$file);
my(@per,@trash,$f);
my($r,$die,$exp);
my(@mois)=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');

$now=localtime;
($s,$n,$h,$j,$m,$a)=localtime;

$a+=1900;
if($debug) {
  open(FCH,"| cat") or die("Debug.");
} else {
  open(FCH,">> $log") or die("Erreur d'ouverture du log.  ($!)");
}
print FCH "********** $$ - $now\n" if ($verbose);

open(TAB,"$path/autoposttab") or &mydie(\*FCH,"Fichier $path/autoposttab inexistant.");

while(<TAB>) {
  s/\s*#.*//g;
  s/[\r\n]+//g;
  s/\t/ /g;
  if($_) {
    my($pj,$pm,$pa)=($j,$m,$a);
    print FCH "-- Evaluation de $_\n" if($debug);
    ($tper,$file,@trash)=split;
    @per=split(/,/,$tper,6);
    $f=0;
    while($f<scalar(@per) && $per[$f]!=$j) {$f++};
    if($f!=scalar(@per)) {
      if($f==scalar(@per)-1) {
        print "-- Expires mois suivant (".($m+1)."+1)\n" if($debug);
        if($m==11) {
          $pa++;
          $pm=0;
        } else {
          $pm++;
        }
        $pj=$per[0];
      } else {
        print "-- Expires ce mois (".($m+1).")\n" if($debug);
        $pj=$per[$f+1];
      }
      if(length($pj)==1) {
        $pj="0$pj";
      }
      $die=0;
      if(!$debug) {
        eval {
          open(EXP,"> $path/msginfo/$file.exp");
        };
        if($@) {
          print FCH "* Erreur d'ouverture du $path/msginfo/$file.exp. ($@)\n";
        } else {
          print EXP "$pj $mois[$pm] $pa $exph";
          close(EXP);
          $s=system("$pathap/autopost $file");
        }
      } else {
        $s=0;
        print "-- $pathap/autopost $file\n";
      }
      if(!$s) {
        print FCH "$$ - $now - $file : OK - expire $pj $mois[$pm] $pa $exph\n";
      } else {
        print FCH "$$ - $now - $file : erreur $s\n";
      }
    }
  }
}

close(FCH);

sub mydie {
  my($fh)=shift;
  my($msg)=shift;
  print $fh "* $msg  ($!)\n";
  print $fh "********** $$ - fin anormale\n";
  close($fh);
  die("$msg  ($!)");
}