data/members.import

   1 #!/usr/bin/perl
   2 our $partner = "cyclofficine_ivry";
   3
   4 our $VERSION = '2013.10.27';
   5 use strict;
   6 use warnings FATAL => qw(all);
   7 use utf8;
   8 use open qw/:std :utf8/;
   9 require Data::Dumper;
  10 require Encode;
  11 require IO::Wrap;
  12 require Text::CSV;
  13 #require Text::CSV::Encoded;
  14 require XML::Generator;
  15 require Text::Trim;
  16
  17 sub parse_date (@) {
  18         ($_) = @_;
  19         my ($jj,$mm,undef,$yy) = ($_ =~ m{^\s*([0-3]?[0-9])\s*/\s*([0-1]?[0-9])\s*/\s*(20)?([0-9][0-9])\s*$});
  20         return "20$yy-$mm-$jj";
  21  }
  22 sub parse_amount (@) {
  23         my ($_) = @_;
  24         my %amounts =
  25          ( "gratuit" => 0
  26          , "Gratuit" => 0
  27          , "offert"  => 0
  28          , "Offert"  => 0
  29          , "?"       => 0
  30          );
  31         $_ = Text::Trim::trim($_);
  32         if (exists $amounts{$_}) {
  33                 return $amounts{$_};
  34          }
  35         else {
  36                 ($_) = ($_ =~ m{^\s*([0-9]+),00\s*€?.$});
  37                 return $_;
  38          }
  39  }
  40 sub parse_payment_mean (@) {
  41         ($_) = @_;
  42         my %payment_means =
  43          ( "Espèces" => "cash"
  44          , "Offert"  => "cash"
  45          , "Chèque"  => "bank"
  46          );
  47         $_ = Text::Trim::trim($_);
  48         return exists $payment_means{$_}
  49          ? $payment_means{$_}
  50          : "cash";
  51  }
  52 sub parse_discount ($) {
  53         ($_) = @_;
  54         my %discounts =
  55          ( "Chômeur"          => "unemployed"
  56          , "Chmeur"           => "unemployed"
  57          , "Atelier vélo IdF" => "velorution_idf"
  58          , "Étudiant"         => "student"
  59          , "Etudiant"         => "student"
  60          , "etudiant"         => "student"
  61          , "Retraité"         => "retired"
  62          );
  63         $_ = Text::Trim::trim($_);
  64         return exists $discounts{$_}
  65          ? $discounts{$_}
  66          : "standard";
  67  }
  68 sub parse_gender (@) {
  69         ($_) = @_;
  70         my %genders =
  71          ( "Ass." => "association"
  72          , "M."   => "male"
  73          , "Mme"  => "female"
  74          , "Mme." => "female"
  75          );
  76         $_ = Text::Trim::trim($_);
  77         return exists $genders{$_}
  78          ? $genders{$_}
  79          : undef;
  80  }
  81
  82 our $last_number = -1;
  83 our $greatest_number = -1;
  84 sub member_of_csv_line (@) {
  85         my ($members, $csv_line, $csv_lines_rejected, $csv_lines_to_reparse) = @_;
  86         print STDERR ("member_of_csv_line: csv_line=".Data::Dumper::Dumper($csv_line));
  87         my $number = Text::Trim::trim($csv_line->{number});
  88         if (not $number) {
  89                 push @$csv_lines_rejected, $csv_line;
  90          }
  91         else {
  92                 my $member = {};
  93                 if (not $number or not ($number =~ m/^[0-9]+$/)) {
  94                         if (defined $csv_lines_to_reparse) {
  95                                 push @$csv_lines_to_reparse, $csv_line;
  96                                 return;
  97                          }
  98                         else {
  99                                 $greatest_number = $greatest_number + 1;
 100                                 print STDERR "WARNING: renumérotation: ".($number?$number:"undef")." -> $greatest_number\n";
 101                                 $csv_line->{comment}
 102                                  =($csv_line->{comment}?"$csv_line->{comment}. ":"")
 103                                  ."(n° malformé d'origine : ".($number?$number:"undef").")";
 104                                 $number = "$greatest_number";
 105                          }
 106                  }
 107                 if ($number =~ m/^[0-9]+$/) {
 108                         $number = $number + 0;
 109                         if ($last_number + 1 != $number + 0) {
 110                                 print STDERR "WARNING: discontinuité: attendu=".($last_number + 1)." eu=".($number + 0)."\n";
 111                          }
 112                         $last_number = $number;
 113                         $greatest_number = $number
 114                                 if $number > $greatest_number;
 115
 116                         if ($csv_line->{name} or $csv_line->{email}) {
 117                                 if (exists $members->{$number}) {
 118                                         $member = $members->{$number};
 119                                  }
 120                                 else {
 121                                         $member = {};
 122                                         $members->{$number} = $member;
 123                                  }
 124                                 $member->{number} = $number;
 125                                 $member->{name}
 126                                  = $csv_line->{name}
 127                                         unless $member->{name};
 128                                 $member->{firstname}
 129                                  = $csv_line->{firstname}
 130                                         unless $member->{firstname};
 131                                 $member->{email}
 132                                  = $csv_line->{email}
 133                                         unless $member->{email};
 134                                 $member->{cotisations}
 135                                  = []
 136                                         unless exists $member->{cotisations};
 137                                 push @{$member->{cotisations}},
 138                                  { amount   => parse_amount($csv_line->{cotisation_amount})
 139                                  , date     => parse_date($csv_line->{cotisation_date})
 140                                  , discount => parse_discount($csv_line->{cotisation_discount})
 141                                  , mean     => parse_payment_mean($csv_line->{cotisation_mean})
 142                                  };
 143                                 $member->{zip}
 144                                  =($csv_line->{zip}
 145                                  ? $csv_line->{zip}
 146                                  : undef)
 147                                         unless $member->{zip};
 148                                 $member->{gender}
 149                                  =($csv_line->{gender}
 150                                  ? parse_gender($csv_line->{gender})
 151                                  : undef)
 152                                         unless $member->{gender};
 153                                 $member->{city}
 154                                  =($csv_line->{city}
 155                                  ? $csv_line->{city}
 156                                  : ($member->{zip} and ($member->{zip} =~ m/^750[0-2][0-9]$/) ? "Paris" : undef))
 157                                  unless $member->{city};
 158                                 $member->{country}
 159                                  = ($member->{zip} and ($member->{zip} =~ m/^UK$/)
 160                                  ? "Royaume-Uni"
 161                                  : "France")
 162                                  unless $member->{country};
 163                                 $member->{phone}
 164                                  =($csv_line->{landline_phone}
 165                                  ? $csv_line->{landline_phone}
 166                                  :($csv_line->{mobile_phone}
 167                                  ? $csv_line->{mobile_phone}
 168                                  : undef))
 169                                         unless $member->{phone};
 170                                 $member->{street}
 171                                  =($csv_line->{street}
 172                                  ? $csv_line->{street}
 173                                  : undef)
 174                                         unless $member->{street};
 175                                 $member->{comment}
 176                                  =($csv_line->{comment}
 177                                  ? $csv_line->{comment}
 178                                  : undef)
 179                                         unless $member->{comment};
 180                          }
 181                         else {
 182                                 push @$csv_lines_rejected, $csv_line;
 183                          }
 184                  }
 185          }
 186  }
 187 sub xml_of_member (@) {
 188         my ($xml, $member, $xml_data, $xml_data_noupdate) = @_;
 189         print STDERR ("xml_of_member: member=".Data::Dumper::Dumper($member));
 190         push @$xml_data, $xml->record
 191          ( { id    => "res_partner_${partner}_".$member->{number}
 192                  , model => "res.partner"
 193                  }
 194          , $xml->field({name => "name"}, $member->{name} . ($member->{firstname} ? " ".$member->{firstname} : ""))
 195          , $xml->field({name => "member_ident"}, $member->{number})
 196          , $xml->field({name => "type"}, "default")
 197          , ($member->{zip}    ? $xml->field({name => "zip"}, $member->{zip}) : ())
 198          , ($member->{city}   ? $xml->field({name => "city"}, $member->{city}) : ())
 199          , ($member->{country}? $xml->field({name => "country_id", model => "res.country", search => "[('name','=','".$member->{country}."')]"}) : ())
 200          , ($member->{email}  ? $xml->field({name => "email"}, $member->{email}) : ())
 201          , ($member->{phone}  ? $xml->field({name => "phone"}, $member->{phone}) : ())
 202          , ($member->{street} ? $xml->field({name => "street"}, $member->{street}) : ())
 203          , ($member->{comment}? $xml->field({name => "comment"}, $member->{comment}) : ())
 204          );
 205         die unless $member->{cotisations};
 206         foreach my $cotisation (@{$member->{cotisations}}) {
 207                 push @$xml_data_noupdate, $xml->function
 208                  ( { model => "account.invoice"
 209                          , name  => "pay_and_reconcile"
 210                          }
 211                         , $xml->xmlcmnt('ids')
 212                         , $xml->function
 213                                  ( { model => "account.invoice"
 214                                          , name  => "draft2open"
 215                                          }
 216                                  , $xml->function
 217                                          ( { model => "res.partner"
 218                                                  , name  => "create_membership_invoice"
 219                                                  }
 220                                          , $xml->xmlcmnt('partner_id')
 221                                          , $xml->value({eval => "ref('res_partner_${partner}_".$member->{number}."')"})
 222                                          , $xml->xmlcmnt('product_id')
 223                                          , $xml->value({eval => "ref('product_".$cotisation->{discount}."_member')"})
 224                                          , $xml->xmlcmnt('context')
 225                                          , $xml->value({eval => "{'amount':".$cotisation->{amount}.", 'date_from':'".$cotisation->{date}."'}"})
 226                                          )
 227                                  )
 228                         , $xml->xmlcmnt('pay_amount')
 229                         , $xml->value ({eval => "$cotisation->{amount}"})
 230                         , $xml->xmlcmnt('pay_account_id')
 231                         , $xml->value ({model => "account.account", search => "[('name', '=', 'Cash')]"})
 232                         , $xml->xmlcmnt("mean: $cotisation->{mean}")
 233                         , $xml->xmlcmnt('period_id')
 234                         , $xml->value ({model => "account.period", search => "[('name', '=', time.strftime('%m/%Y'))]"})
 235                         , $xml->xmlcmnt('pay_journal_id')
 236                         , $xml->value ({model => "account.journal", search => "[('name', '=', 'Cash')]"})
 237                         , $xml->xmlcmnt('writeoff_acc_id')
 238                         , $xml->value ({model => "account.account", search => "[('name', '=', 'Cash')]"})
 239                         , $xml->xmlcmnt('writeoff_period_id')
 240                         , $xml->value ({model => "account.period", search => "[('name', '=', time.strftime('%m/%Y'))]"})
 241                         , $xml->xmlcmnt('writeoff_journal_id')
 242                         , $xml->value ({model => "account.journal", search => "[('name', '=', 'Cash')]"})
 243                         , $xml->xmlcmnt('context')
 244                         , $xml->value ({eval => "{}"})
 245                         , $xml->xmlcmnt('name')
 246                         , $xml->value ({eval => "str('Import de paiement automatique')"})
 247                  );
 248          }
 249  }
 250
 251 sub main () {
 252         my $csv = Text::CSV->new
 253          ({binary => 1
 254          , eol => $/
 255          , sep_char => ';'
 256          });
 257         my $xml = XML::Generator->new
 258          ( escape      => 'always'
 259          , conformance => 'strict'
 260          , empty       => 'self'
 261          , pretty      => 2
 262          );
 263         my $in = IO::Wrap::wraphandle(\*STDIN);
 264
 265         my $csv_head = $csv->getline($in);
 266         #print STDERR ("head: ", join("|", @$csv_head), "\n");
 267         #$csv->column_names(@$csv_head);
 268         $csv->column_names (qw (
 269          number
 270          cotisation_date
 271          cotisation_amount
 272          cotisation_mean
 273          cotisation_discount
 274          gender
 275          firstname
 276          name
 277          birth
 278          email
 279          landline_phone
 280          mobile_phone
 281          street
 282          zip
 283          city
 284          comment
 285          ));
 286         my $xml_data = [];
 287         my $xml_data_noupdate = [];
 288         my $csv_lines_rejected = [];
 289         my $csv_lines_to_reparse = [];
 290         my $members = {};
 291         while (my $csv_line = $csv->getline_hr($in)) {
 292                 #print STDERR ("csv_line: ", join("|", @$csv_line), "\n");
 293                 member_of_csv_line($members, $csv_line, $csv_lines_rejected, $csv_lines_to_reparse);
 294          }
 295         print STDERR "csv_lines_to_reparse=".Data::Dumper::Dumper($csv_lines_to_reparse);
 296         foreach my $csv_line (@$csv_lines_to_reparse) {
 297                 member_of_csv_line($members, $csv_line, $csv_lines_rejected, undef);
 298          }
 299         foreach my $number (sort {$a <=> $b} (keys %$members)) {
 300                 xml_of_member($xml, $members->{$number}, $xml_data, $xml_data_noupdate);
 301          }
 302         push @$xml_data_noupdate, $xml->record
 303          ( { id    => "remembership.member_ident_sequence"
 304                  , model => "ir.sequence"
 305                  }
 306          , $xml->field({name => "number_next"}, $greatest_number + 1)
 307          );
 308         binmode STDOUT, ':utf8';
 309         print $xml->openerp
 310          ( $xml->data(@$xml_data)
 311          , $xml->data
 312                  ( {noupdate => "1"}
 313                  , @$xml_data_noupdate )
 314          );
 315
 316         my $out = IO::Wrap::wraphandle(\*STDERR);
 317         print STDERR "csv_lines_rejected=".Data::Dumper::Dumper($csv_lines_rejected);
 318  }
 319
 320 main;