[Sommaire] [Imprimer]

   1  #!/usr/bin/perl
   2  
   3  # Copyright (C) 2003 Jean-Louis BERGAMO <jlb@j1b.org>
   4  #
   5  # This program is free software; you can redistribute it and/or modify
   6  # it under the terms of the GNU General Public License as published by
   7  # the Free Software Foundation; either version 2 of the License, or
   8  # (at your option) any later version.
   9  #
  10  # This program is distributed in the hope that it will be useful,
  11  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  # GNU General Public License for more details.
  14  #
  15  # You should have received a copy of the GNU General Public License
  16  # along with this program; if not, write to the Free Software
  17  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  18  
  19  # ce script prend l'intergralite des adherents valide et les mets dans
  20  # une mailing-liste.  ce script est utilie si l'on souhaite avoir une
  21  # mailing-liste avec uniquement les adherents valides.
  22  
  23  use DBI;
  24  use strict;
  25  # get the command line option
  26  use Getopt::Long;
  27  
  28  # command line option hash table
  29  my %optctl=();
  30  # get command line options
  31  GetOptions(\%optctl,"help!","host=s","db=s","user=s","pass=s","ml=s","type=s","cotis!");
  32  if (defined $optctl{'help'}){
  33    &usage();
  34  }
  35  my $host=$optctl{'host'}||'localhost';
  36  my $dbname=$optctl{'db'}||'dolibarr';
  37  my $user=$optctl{'user'}||'dolibarr';
  38  my $pass=$optctl{'pass'}||'';
  39  my $type=$optctl{'type'}||'mysql';
  40  my $ml=$optctl{'ml'}||&usage();
  41  my @adh=();
  42  my @ml_adh=();
  43  
  44  my $dbh = DBI->connect("dbi:$type:dbname=$dbname;host=$host",$user,$pass) || die $DBI::errstr ;
  45  
  46  my $sql = 'SELECT email FROM llx_adherent WHERE statut=1';
  47  
  48  if (defined $optctl{'cotis'}){
  49    $sql.=" AND datefin > now()";
  50  }
  51  
  52  my $sth = $dbh->prepare("$sql") || die $dbh->errstr ;
  53  $sth->execute;
  54  
  55  # get emails of adherents
  56  while (my @row = $sth->fetchrow_array ){
  57  #    print "$row[0]\n";
  58      push (@adh,$row[0]);
  59  }
  60  
  61  # get emails of mailing-list suscribers
  62  @ml_adh=`/usr/sbin/list_members $ml`;
  63  chomp(@ml_adh);
  64  #foreach (@ml_adh){
  65  #    print $_;
  66  #}
  67  # do the diff
  68  foreach my $adh (@adh){
  69    if (!grep(/^$adh$/i,@ml_adh)){
  70      # user not subscribed
  71      print "register $adh : echo $adh | /usr/sbin/add_members -n - $ml\n";
  72      if (system("echo $adh | /usr/sbin/add_members -n - $ml")){
  73          die "can't execute echo $adh | /usr/sbin/add_members -n - $ml : $!";
  74      }
  75    }
  76  }
  77  
  78  # unsubcribe user not adherent
  79  foreach my $subs (@ml_adh){
  80    if (!grep(/^$subs$/i,@adh)){
  81      # unsubscrib user
  82      print "unsubscribe $subs : /usr/sbin/remove_members $ml $subs\n";
  83      if (system("/usr/sbin/remove_members $ml $subs")){
  84          die "can't execute /usr/sbin/remove_members $ml $subs : $!";
  85      }
  86    }
  87  }
  88  
  89  $dbh->disconnect();
  90  
  91  sub usage{
  92    print "$0 [--help] [--host] [--db] [--user] [--pass] [--cotis] --ml=mailinglist\n";
  93    print " ml is for mailing-list. others options are for database\n";
  94    print " cotis : select only adherents with cotisations up-to-date\n";
  95    print "\n";
  96    exit (1);
  97  }