comptes

   1 #!/usr/bin/env perl
   2 # The MIT License (MIT)
   3 #
   4 # Copyright (c) 2011-2015 Ismaël Bouya http://www.normalesup.org/~bouya/
   5 #
   6 # Permission is hereby granted, free of charge, to any person obtaining a copy
   7 # of this software and associated documentation files (the "Software"), to deal
   8 # in the Software without restriction, including without limitation the rights
   9 # to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  10 # copies of the Software, and to permit persons to whom the Software is
  11 # furnished to do so, subject to the following conditions:
  12 #
  13 # The above copyright notice and this permission notice shall be included in
  14 # all copies or substantial portions of the Software.
  15 #
  16 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  17 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  18 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  19 # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  20 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  21 # OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  22 # THE SOFTWARE.
  23
  24 use Switch;
  25 use strict;
  26
  27 my $file = "comptes.data";
  28
  29 my @actions=('Ajouter un participant');
  30 my %participants = ();
  31 my @transactions = ();
  32 my @descriptions = ();
  33 my $evenement_def;
  34 my @remboursements = ();
  35 my %initiales = ();
  36
  37 if($#ARGV == 0) {
  38   open FILE, $ARGV[0] || die "Impossible de lire le fichier";
  39   $evenement_def = <FILE>;
  40   chomp($evenement_def);
  41   while(my $noms = <FILE>) {
  42     if($noms eq "\n") { last; }
  43     my ($numero,$nom) = split(/ /,$noms,2);
  44     chomp($nom);
  45     $participants{$nom} = $numero;
  46   }
  47   while(my $transaction = <FILE>) {
  48     if($transaction eq "\n") { last; }
  49     chomp($transaction);
  50     push(@transactions,$transaction);
  51     my $description = <FILE>;
  52     chomp($description);
  53     push(@descriptions,$description);
  54   }
  55   while(my $remboursement = <FILE>) {
  56     if($remboursement eq "\n") { last; }
  57     chomp($remboursement);
  58     my @remb = split(/ /, $remboursement);
  59     push(@remboursements,\@remb);
  60   }
  61   $file = $ARGV[0];
  62 }
  63
  64 sub choose_action {
  65   my @actions = ('Ajouter un participant');
  66   my $action;
  67
  68   if (keys(%participants) > 0) {
  69     $actions[1] = "Ajouter une dépense";
  70     $actions[2] = "Enregistrer";
  71   }
  72   if(scalar(@transactions) > 0) {
  73     $actions[2] = "Enregistrer";
  74     $actions[3] = "Voir les frais de quelqu'un (dépenses - dettes)";
  75     $actions[4] = "Voir les frais de tout le monde";
  76     $actions[5] = "Equilibrage";
  77     $actions[6] = "Voir une transaction";
  78   }
  79   if(scalar(@remboursements) > 0) {
  80     $actions[7] = "Afficher les remboursements";
  81   }
  82
  83   while(1) {
  84     my $i = 1;
  85     my $var;
  86     my @vart = ( @actions, 'Sortir' );
  87     my $message = '';
  88     foreach $var ( @vart ) {
  89       $message .= $i++.') '.$var."\n";
  90     }
  91     print $message;
  92     $var = <STDIN>;
  93     chop($var);
  94     if(/\D/ || $var < 1 || $var > $i) {
  95       print "Mauvaise entrée\n";
  96       next;
  97     }
  98     $action = $vart[$var-1];
  99     last;
 100   }
 101
 102   return $action;
 103 }
 104
 105 sub pp {
 106   my ($price, $noteur) = @_;
 107
 108   if (!$noteur) {
 109     return sprintf("%.2f", $price)." EUR";
 110   } else {
 111     return sprintf("%.2f", $price);
 112   }
 113 }
 114
 115 sub compute_initiales {
 116   %initiales = ();
 117 }
 118
 119 sub add_participant {
 120   print "Nom du participant ?\n";
 121   my $participant = <STDIN>;
 122   chomp($participant);
 123   $participant =~ s/\s/_/g;
 124   $participants{$participant} = keys(%participants)+1;
 125   compute_initiales();
 126 }
 127
 128 sub select_menu {
 129   my (@vart) = @_;
 130   while(1) {
 131     my $i = 1;
 132     my $var;
 133     foreach $var ( @vart ) {
 134       print $i++.') '.$var."\n";
 135     }
 136     $var = <STDIN>;
 137     chop($var);
 138     if(/\D/ || $var < 1 || $var > scalar @vart) {
 139       print "Mauvaise entrée\n";
 140       next;
 141     }
 142     return $vart[$var-1];
 143   }
 144 }
 145
 146 sub select_participant {
 147   my ($annuler, @supplementaires) = @_;
 148   while(1) {
 149     my $i = 1;
 150     my $var;
 151     my @vart = ( keys(%participants), @supplementaires, ($annuler) );
 152     foreach $var ( @vart ) {
 153       print $i++.') '.$var."\n";
 154     }
 155     $var = <STDIN>;
 156     chop($var);
 157     if(/\D/ || $var < 1 || $var > scalar @vart) {
 158       print "Mauvaise entrée\n";
 159       next;
 160     }
 161     if ($var != scalar @vart) {
 162       return $vart[$var-1];
 163     } else {
 164       return;
 165     }
 166   }
 167 }
 168
 169 sub select_transaction {
 170   my $transaction;
 171   while(1) {
 172     my $i = 1;
 173     my $var;
 174     my @vart = ( @descriptions, "Annuler" );
 175     foreach $var ( @vart ) {
 176       print $i++.') '.$var."\n";
 177     }
 178     $var = <STDIN>;
 179     chop($var);
 180     if(/\D/ || $var < 1 || $var > $i) {
 181       print "Mauvaise entrée\n";
 182       next;
 183     }
 184     $transaction = $var-1;
 185     last;
 186   }
 187
 188   my ($payeur, $prix, $total_parts, $split, $parts) = &parse_transaction($transactions[$transaction]);
 189   return ($descriptions[$transaction], $payeur, $prix, $total_parts, $split, $parts);
 190 }
 191
 192 sub add_transaction {
 193   print "Qui a payé ?\n";
 194   my $paye = select_participant("Annuler");
 195   if(!$paye) {
 196     print "Annulé";
 197     return;
 198   }
 199   print "Quoi ?\n";
 200   my $description = <STDIN>;
 201   chomp($description);
 202   print "Combien ?\n";
 203   my $prix = <STDIN>;
 204   chomp($prix);
 205   print "Pour qui ?\n";
 206   my $repartition = "";
 207   my $total_parts = 0;
 208   DESTS: while(1) {
 209     my $dest = select_participant("Fini", "Ajouter à tous");
 210     switch($dest) {
 211       case undef {
 212         if($repartition eq "") {
 213           print "Annulé\n";
 214           return;
 215         }
 216         elsif($total_parts == 0) {
 217           print "Le nombre total de parts est nul, il faut en ajouter !\n";
 218           next DESTS;
 219         }
 220         else {
 221           push(@transactions, $participants{$paye}.' '.$prix.$repartition);
 222           push(@descriptions, $description);
 223           return;
 224         }
 225       }
 226       case "Ajouter à tous" {
 227         print "Nombre de parts ?\n";
 228         my $parts = <STDIN>;
 229         chomp($parts);
 230         if(!($parts == 0)) {
 231           foreach my $participant (keys(%participants)) {
 232             $repartition .= ' '.$participants{$participant}.':'.scalar($parts);
 233             $total_parts += scalar($parts);
 234           }
 235         }
 236       }
 237       else {
 238         print "Nombre de parts ?\n";
 239         my $parts = <STDIN>;
 240         chomp($parts);
 241         if(!($parts == 0)) {
 242           $repartition .= ' '.$participants{$dest}.':'.scalar($parts);
 243           $total_parts += scalar($parts);
 244         }
 245       }
 246     }
 247   }
 248 }
 249
 250 sub find_participant {
 251   my ($participant_number) = @_;
 252
 253   foreach my $name (keys(%participants)) {
 254     if ($participant_number == $participants{$name}) {
 255       return $name;
 256     }
 257   }
 258 }
 259
 260 sub parse_transaction {
 261   my ($transaction) = @_;
 262   my @table_trans = split(/ /,$transaction);
 263
 264   my $payeur = shift(@table_trans);
 265   $payeur = find_participant($payeur);
 266   my $prix = shift(@table_trans);
 267   my %parts;
 268   my %split;
 269   my $total_parts = 0;
 270   foreach my $repartition (@table_trans) {
 271     my ($participant, $part) = split(/:/, $repartition);
 272     $participant = find_participant($participant);
 273     $parts{$participant} ||= 0;
 274     $parts{$participant} += $part;
 275     $total_parts += $part;
 276   }
 277   if (!$parts{$payeur}) {
 278     $parts{$payeur} = 0;
 279   }
 280   foreach my $participant (keys(%parts)) {
 281     $split{$participant} = - ($parts{$participant} * $prix) / $total_parts;
 282     if ($participant eq $payeur) {
 283       $split{$participant} += $prix;
 284     }
 285   }
 286
 287   return ($payeur, $prix, $total_parts, \%split, \%parts);
 288 }
 289
 290 sub max_length {
 291   my (@strings) = @_;
 292   my @string_lengths = sort { length($a) <=> length($b) } @strings;
 293   return length($string_lengths[-1]);
 294 }
 295
 296 sub list_transactions_for_participants {
 297   my (@participants) = @_;
 298   my $one_participant = 0;
 299   if (scalar @participants == 0) {
 300     @participants = keys(%participants);
 301   }
 302   if (scalar @participants == 1) {
 303     $one_participant = 1;
 304   }
 305
 306   my %depenses;
 307   my %solde;
 308
 309   my @zipped = map {($transactions[$_], $descriptions[$_])} (0 .. $#descriptions);
 310   while (scalar(@zipped) > 0) {
 311     my $transaction = shift @zipped;
 312     my $description = shift @zipped;
 313     my ($payeur, $prix, $total_parts, $parsed_transaction, $parts) = &parse_transaction($transaction);
 314     $depenses{$payeur} ||= 0;
 315     $depenses{$payeur} += $prix;
 316
 317     my @intersection = grep( $parsed_transaction->{$_}, @participants);
 318     if (scalar @intersection) {
 319       my $phantom = " " x length($description.":");
 320       my $max_participant_length = max_length(@intersection);
 321
 322       print $description.":";
 323       foreach my $participant (@intersection) {
 324         $solde{$participant} ||= 0;
 325         $solde{$participant} += $parsed_transaction->{$participant};
 326
 327         if ($one_participant) {
 328           print " ".pp($parsed_transaction->{$participant});
 329           if ($payeur eq $participant) {
 330             print " (a payé, ".pp($prix).")";
 331           }
 332           print "\n";
 333         } else {
 334           my $participant_padding = " " x ($max_participant_length - length($participant));
 335           print "  ".$participant.$participant_padding." ".pp($parsed_transaction->{$participant});
 336           if ($payeur eq $participant) {
 337             print " (a payé, ".pp($prix).")";
 338           }
 339           print "\n".$phantom;
 340         }
 341       }
 342       if (!$one_participant) {
 343         print "\n";
 344       }
 345     }
 346   }
 347
 348   foreach my $personne (@participants) {
 349     my $d = $depenses{$personne} || 0;
 350     my $s = $solde{$personne} || 0;
 351     if ($d) {
 352       print $personne." a payé ".pp($d);
 353     } else {
 354       print $personne." n'a rien payé";
 355     }
 356     if ($s) {
 357       print " et a pour ".pp($d - $s)." de frais au total.\n";
 358     } else {
 359       print " et n'a pas eu de frais.\n";
 360     }
 361     print $personne." a donc un solde de ".pp($s)."\n";
 362   }
 363 }
 364
 365 sub compute_equity {
 366   my %depenses;
 367   my %frais;
 368   my %soldes;
 369   foreach my $transaction (@transactions) {
 370     my ($payeur, $prix, $total_parts, $split, $parts) = &parse_transaction($transaction);
 371     $depenses{$payeur} += $prix;
 372
 373     foreach my $personne (keys(%{$split})) {
 374       $soldes{$personne} += $split->{$personne};
 375     }
 376   }
 377   foreach my $personne (keys(%soldes)) {
 378     $frais{$personne} = $depenses{$personne} - $soldes{$personne};
 379   }
 380
 381   return (\%depenses, \%frais, \%soldes);
 382 }
 383
 384 sub delete_zeros {
 385   my ($soldes, @participants) = @_;
 386
 387   foreach my $participant (@participants) {
 388     delete $soldes->{$participant} if pp($soldes->{$participant}, 1) == 0;
 389   }
 390 }
 391
 392 sub compute_reimbursment {
 393   my ($a, $b, $soldes) = @_;
 394   my $s_a = $soldes->{$a};
 395   my $s_b = $soldes->{$b};
 396
 397   return if (pp($s_a, 1) * pp($s_b, 1) >= 0);
 398   my $debtor   = pp($s_a, 1) < 0 ? $a : $b;
 399   my $creditor = pp($s_a, 1) > 0 ? $a : $b;
 400   my $exchange = (abs($s_a) < abs($s_b)) ? abs($s_a) : abs($s_b);
 401
 402   my @remboursement = ($debtor, $creditor, $exchange);
 403   push @remboursements, \@remboursement;
 404   $soldes->{$creditor} -= $exchange;
 405   $soldes->{$debtor}   += $exchange;
 406   delete_zeros($soldes, $a, $b);
 407 }
 408
 409 sub select_exchange_couple {
 410   my ($soldes) = @_;
 411   my $bd; # biggest debtor
 412   my $sc; # smallest creditor
 413
 414   foreach my $p (keys(%{$soldes})) {
 415     $bd = $p if $soldes->{$p} < 0 && (!$bd || $soldes->{$p} < $soldes->{$bd});
 416     $sc = $p if $soldes->{$p} > 0 && (!$sc || $soldes->{$p} < $soldes->{$sc});
 417   }
 418
 419   return ($bd, $sc);
 420 }
 421
 422 sub print_remboursements {
 423   foreach my $remboursement (@remboursements) {
 424     my ($debtor, $creditor, $exchange) = (@{$remboursement});
 425     print $debtor." doit ".pp($exchange)." à ".$creditor."\n";
 426   }
 427   my $pause = <STDIN>;
 428 }
 429
 430 GLOBALE: while(1) {
 431   my $action = choose_action();
 432   switch ($action) {
 433     case "Ajouter un participant" {
 434       add_participant();
 435     }
 436     case "Ajouter une dépense" {
 437       add_transaction();
 438     }
 439     case "Voir les frais de quelqu'un (dépenses - dettes)" {
 440       my $personne = select_participant("Annuler");
 441       if(!$personne) {
 442         next GLOBALE;
 443       }
 444       list_transactions_for_participants(($personne));
 445       my $pause = <STDIN>;
 446     }
 447     case "Voir les frais de tout le monde" {
 448       list_transactions_for_participants(keys(%participants));
 449       my $pause = <STDIN>;
 450     }
 451     case "Voir une transaction" {
 452       my ($description, $payeur, $prix, $total_parts, $split, $parts) = select_transaction();
 453       print $description." (payé par ".$payeur."), ".pp($prix)."\n";
 454       foreach my $pers (keys(%{$split})) {
 455         print $pers.", ".$parts->{$pers}." part(s), soit ". pp($split->{$pers});
 456         if ($pers eq $payeur) {
 457           print " (".pp($prix)." - ".pp($prix - $split->{$pers}).")";
 458         }
 459         print "\n";
 460       }
 461     }
 462     case "Enregistrer" {
 463       print "Nom de l'événement ?";
 464       if(!($evenement_def eq "")) {
 465         print " [".$evenement_def."]";
 466       }
 467       print "\n";
 468       my $evenement = <STDIN>;
 469       chomp($evenement);
 470       if($evenement eq "") {
 471         $evenement = $evenement_def;
 472       }
 473       open FILE, ">".$file;
 474       print FILE $evenement."\n";
 475       my $key;
 476       foreach $key (keys(%participants)) {
 477         print FILE $participants{$key}." ".$key."\n";
 478       }
 479       print FILE "\n";
 480       for(my $i=0;$i<scalar(@transactions);$i++) {
 481         print FILE $transactions[$i]."\n";
 482         print FILE $descriptions[$i]."\n";
 483       }
 484       print FILE "\n";
 485       foreach my $remboursement (@remboursements) {
 486         print FILE join(" ", @{$remboursement})."\n";
 487       }
 488       close FILE;
 489     }
 490     case "Equilibrage" {
 491       my ($depenses, $frais, $soldes) = compute_equity();
 492       @remboursements = ();
 493
 494       foreach my $personne (keys(%participants)) {
 495         print $personne." a un solde de ".pp($soldes->{$personne})." (+" . pp($depenses->{$personne}). " / -". pp($frais->{$personne}) . ")\n";
 496       }
 497       my $pause = <STDIN>;
 498       print "Y-a-t-il des remboursements plus aisés ?\n";
 499       my $ouinon = select_menu("Oui", "Non");
 500
 501       AISE: while($ouinon eq "Oui") {
 502         print "Qui ?\n";
 503         my $personnea = select_participant("Fini");
 504         if(!$personnea) { last AISE; }
 505         print "Avec qui ?\n";
 506         my $personneb = select_participant("Annuler");
 507         if(!$personneb) { next AISE; }
 508         compute_reimbursment($personnea, $personneb, $soldes);
 509       }
 510       # Une boucle pour détecter si on a des couples qui s'annulent mutuellement
 511       delete_zeros($soldes, keys(%{$soldes}));
 512       COUPLE: foreach my $personnea (keys(%participants)) {
 513         next if(pp($soldes->{$personnea}, 1) == 0);
 514         foreach my $personneb (keys(%participants)) {
 515           next if (pp($soldes->{$personneb} + $soldes->{$personnea}, 1) != 0);
 516           compute_reimbursment($personnea, $personneb, $soldes);
 517           next COUPLE;
 518         }
 519       }
 520       REMB: while(1) {
 521         last REMB if(keys(%{$soldes}) == 0);
 522
 523         my ($biggest_debtor, $smallest_creditor) = select_exchange_couple($soldes);
 524         compute_reimbursment($biggest_debtor, $smallest_creditor, $soldes);
 525       }
 526       print_remboursements();
 527     }
 528     case "Afficher les remboursements" {
 529       print_remboursements();
 530     }
 531     case "Sortir" {
 532       last GLOBALE;
 533     }
 534   }
 535 }