[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","type=s","cotis!","crypt!");
  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 login,pass 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 login,pass of each adherents
  56  while (my @row = $sth->fetchrow_array ){
  57    if (defined $optctl{'crypt'}){
  58      print "$row[0]:",crypt($row[1],join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64]),"\n";
  59    }else{
  60      print "$row[0]:$row[1]\n";
  61    }
  62  }
  63  
  64  $dbh->disconnect();
  65  
  66  sub usage{
  67    print "$0 [--help] [--host] [--db] [--user] [--pass] [--cotis] [--crypt]\n";
  68    print " cotis : select only adherents with cotisations up-to-date\n";
  69    print "\n";
  70    exit (1);
  71  }