2 # The MIT License (MIT)
4 # Copyright (c) 2011-2015 Ismaël Bouya http://www.normalesup.org/~bouya/
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:
13 # The above copyright notice and this permission notice shall be included in
14 # all copies or substantial portions of the Software.
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
25 # Feel like tipping/donating? https://www.immae.eu/licenses_and_tipping
30 my $file = "comptes.data";
32 my @actions=('Ajouter un participant');
33 my %participants = ();
34 my @transactions = ();
35 my @descriptions = ();
37 my @remboursements = ();
41 open FILE
, $ARGV[0] || die "Impossible de lire le fichier";
42 $evenement_def = <FILE
>;
43 chomp($evenement_def);
44 while(my $noms = <FILE
>) {
45 if($noms eq "\n") { last; }
46 my ($numero,$nom) = split(/ /,$noms,2);
48 $participants{$nom} = $numero;
50 while(my $transaction = <FILE
>) {
51 if($transaction eq "\n") { last; }
53 push(@transactions,$transaction);
54 my $description = <FILE
>;
56 push(@descriptions,$description);
58 while(my $remboursement = <FILE
>) {
59 if($remboursement eq "\n") { last; }
60 chomp($remboursement);
61 my @remb = split(/ /, $remboursement);
62 push(@remboursements,\
@remb);
68 my @actions = ('Ajouter un participant');
71 if (keys(%participants) > 0) {
72 $actions[1] = "Ajouter une dépense";
73 $actions[2] = "Enregistrer";
75 if(scalar(@transactions) > 0) {
76 $actions[2] = "Enregistrer";
77 $actions[3] = "Voir les frais de quelqu'un (dépenses - dettes)";
78 $actions[4] = "Voir les frais de tout le monde";
79 $actions[5] = "Equilibrage";
80 $actions[6] = "Voir une transaction";
82 if(scalar(@remboursements) > 0) {
83 $actions[7] = "Afficher les remboursements";
89 my @vart = ( @actions, 'Sortir' );
91 foreach $var ( @vart ) {
92 $message .= $i++.') '.$var."\n";
97 if(/\D/ || $var < 1 || $var > $i) {
98 print "Mauvaise entrée\n";
101 $action = $vart[$var-1];
109 my ($price, $noteur) = @_;
112 return sprintf("%.2f", $price)." EUR";
114 return sprintf("%.2f", $price);
118 sub compute_initiales
{
122 sub add_participant
{
123 print "Nom du participant ?\n";
124 my $participant = <STDIN
>;
126 $participant =~ s/\s/_/g;
127 $participants{$participant} = keys(%participants)+1;
136 foreach $var ( @vart ) {
137 print $i++.') '.$var."\n";
141 if(/\D/ || $var < 1 || $var > scalar @vart) {
142 print "Mauvaise entrée\n";
145 return $vart[$var-1];
149 sub select_participant
{
150 my ($annuler, @supplementaires) = @_;
154 my @vart = ( keys(%participants), @supplementaires, ($annuler) );
155 foreach $var ( @vart ) {
156 print $i++.') '.$var."\n";
160 if(/\D/ || $var < 1 || $var > scalar @vart) {
161 print "Mauvaise entrée\n";
164 if ($var != scalar @vart) {
165 return $vart[$var-1];
172 sub select_transaction
{
177 my @vart = ( @descriptions, "Annuler" );
178 foreach $var ( @vart ) {
179 print $i++.') '.$var."\n";
183 if(/\D/ || $var < 1 || $var > $i) {
184 print "Mauvaise entrée\n";
187 $transaction = $var-1;
191 my ($payeur, $prix, $total_parts, $split, $parts) = &parse_transaction
($transactions[$transaction]);
192 return ($descriptions[$transaction], $payeur, $prix, $total_parts, $split, $parts);
195 sub add_transaction
{
196 print "Qui a payé ?\n";
197 my $paye = select_participant
("Annuler");
203 my $description = <STDIN
>;
208 print "Pour qui ?\n";
209 my $repartition = "";
212 my $dest = select_participant
("Fini", "Ajouter à tous");
215 if($repartition eq "") {
219 elsif($total_parts == 0) {
220 print "Le nombre total de parts est nul, il faut en ajouter !\n";
224 push(@transactions, $participants{$paye}.' '.$prix.$repartition);
225 push(@descriptions, $description);
229 case
"Ajouter à tous" {
230 print "Nombre de parts ?\n";
234 foreach my $participant (keys(%participants)) {
235 $repartition .= ' '.$participants{$participant}.':'.scalar($parts);
236 $total_parts += scalar($parts);
241 print "Nombre de parts ?\n";
245 $repartition .= ' '.$participants{$dest}.':'.scalar($parts);
246 $total_parts += scalar($parts);
253 sub find_participant
{
254 my ($participant_number) = @_;
256 foreach my $name (keys(%participants)) {
257 if ($participant_number == $participants{$name}) {
263 sub parse_transaction
{
264 my ($transaction) = @_;
265 my @table_trans = split(/ /,$transaction);
267 my $payeur = shift(@table_trans);
268 $payeur = find_participant
($payeur);
269 my $prix = shift(@table_trans);
273 foreach my $repartition (@table_trans) {
274 my ($participant, $part) = split(/:/, $repartition);
275 $participant = find_participant
($participant);
276 $parts{$participant} ||= 0;
277 $parts{$participant} += $part;
278 $total_parts += $part;
280 if (!$parts{$payeur}) {
283 foreach my $participant (keys(%parts)) {
284 $split{$participant} = - ($parts{$participant} * $prix) / $total_parts;
285 if ($participant eq $payeur) {
286 $split{$participant} += $prix;
290 return ($payeur, $prix, $total_parts, \
%split, \
%parts);
295 my @string_lengths = sort { length($a) <=> length($b) } @strings;
296 return length($string_lengths[-1]);
299 sub list_transactions_for_participants
{
300 my (@participants) = @_;
301 my $one_participant = 0;
302 if (scalar @participants == 0) {
303 @participants = keys(%participants);
305 if (scalar @participants == 1) {
306 $one_participant = 1;
312 my @zipped = map {($transactions[$_], $descriptions[$_])} (0 .. $#descriptions);
313 while (scalar(@zipped) > 0) {
314 my $transaction = shift @zipped;
315 my $description = shift @zipped;
316 my ($payeur, $prix, $total_parts, $parsed_transaction, $parts) = &parse_transaction
($transaction);
317 $depenses{$payeur} ||= 0;
318 $depenses{$payeur} += $prix;
320 my @intersection = grep( $parsed_transaction->{$_}, @participants);
321 if (scalar @intersection) {
322 my $phantom = " " x
length($description.":");
323 my $max_participant_length = max_length
(@intersection);
325 print $description.":";
326 foreach my $participant (@intersection) {
327 $solde{$participant} ||= 0;
328 $solde{$participant} += $parsed_transaction->{$participant};
330 if ($one_participant) {
331 print " ".pp
($parsed_transaction->{$participant});
332 if ($payeur eq $participant) {
333 print " (a payé, ".pp
($prix).")";
337 my $participant_padding = " " x
($max_participant_length - length($participant));
338 print " ".$participant.$participant_padding." ".pp
($parsed_transaction->{$participant});
339 if ($payeur eq $participant) {
340 print " (a payé, ".pp
($prix).")";
345 if (!$one_participant) {
351 foreach my $personne (@participants) {
352 my $d = $depenses{$personne} || 0;
353 my $s = $solde{$personne} || 0;
355 print $personne." a payé ".pp
($d);
357 print $personne." n'a rien payé";
360 print " et a pour ".pp
($d - $s)." de frais au total.\n";
362 print " et n'a pas eu de frais.\n";
364 print $personne." a donc un solde de ".pp
($s)."\n";
372 foreach my $transaction (@transactions) {
373 my ($payeur, $prix, $total_parts, $split, $parts) = &parse_transaction
($transaction);
374 $depenses{$payeur} += $prix;
376 foreach my $personne (keys(%{$split})) {
377 $soldes{$personne} += $split->{$personne};
380 foreach my $personne (keys(%soldes)) {
381 $frais{$personne} = $depenses{$personne} - $soldes{$personne};
384 return (\
%depenses, \
%frais, \
%soldes);
388 my ($soldes, @participants) = @_;
390 foreach my $participant (@participants) {
391 delete $soldes->{$participant} if pp
($soldes->{$participant}, 1) == 0;
395 sub compute_reimbursment
{
396 my ($a, $b, $soldes) = @_;
397 my $s_a = $soldes->{$a};
398 my $s_b = $soldes->{$b};
400 return if (pp
($s_a, 1) * pp
($s_b, 1) >= 0);
401 my $debtor = pp
($s_a, 1) < 0 ? $a : $b;
402 my $creditor = pp
($s_a, 1) > 0 ? $a : $b;
403 my $exchange = (abs($s_a) < abs($s_b)) ? abs($s_a) : abs($s_b);
405 my @remboursement = ($debtor, $creditor, $exchange);
406 push @remboursements, \
@remboursement;
407 $soldes->{$creditor} -= $exchange;
408 $soldes->{$debtor} += $exchange;
409 delete_zeros
($soldes, $a, $b);
412 sub select_exchange_couple
{
414 my $bd; # biggest debtor
415 my $sc; # smallest creditor
417 foreach my $p (keys(%{$soldes})) {
418 $bd = $p if $soldes->{$p} < 0 && (!$bd || $soldes->{$p} < $soldes->{$bd});
419 $sc = $p if $soldes->{$p} > 0 && (!$sc || $soldes->{$p} < $soldes->{$sc});
425 sub print_remboursements
{
426 foreach my $remboursement (@remboursements) {
427 my ($debtor, $creditor, $exchange) = (@{$remboursement});
428 print $debtor." doit ".pp
($exchange)." à ".$creditor."\n";
434 my $action = choose_action
();
436 case
"Ajouter un participant" {
439 case
"Ajouter une dépense" {
442 case
"Voir les frais de quelqu'un (dépenses - dettes)" {
443 my $personne = select_participant
("Annuler");
447 list_transactions_for_participants
(($personne));
450 case
"Voir les frais de tout le monde" {
451 list_transactions_for_participants
(keys(%participants));
454 case
"Voir une transaction" {
455 my ($description, $payeur, $prix, $total_parts, $split, $parts) = select_transaction
();
456 print $description." (payé par ".$payeur."), ".pp
($prix)."\n";
457 foreach my $pers (keys(%{$split})) {
458 print $pers.", ".$parts->{$pers}." part(s), soit ". pp
($split->{$pers});
459 if ($pers eq $payeur) {
460 print " (".pp
($prix)." - ".pp
($prix - $split->{$pers}).")";
466 print "Nom de l'événement ?";
467 if(!($evenement_def eq "")) {
468 print " [".$evenement_def."]";
471 my $evenement = <STDIN
>;
473 if($evenement eq "") {
474 $evenement = $evenement_def;
476 open FILE
, ">".$file;
477 print FILE
$evenement."\n";
479 foreach $key (keys(%participants)) {
480 print FILE
$participants{$key}." ".$key."\n";
483 for(my $i=0;$i<scalar(@transactions);$i++) {
484 print FILE
$transactions[$i]."\n";
485 print FILE
$descriptions[$i]."\n";
488 foreach my $remboursement (@remboursements) {
489 print FILE
join(" ", @{$remboursement})."\n";
494 my ($depenses, $frais, $soldes) = compute_equity
();
495 @remboursements = ();
497 foreach my $personne (keys(%participants)) {
498 print $personne." a un solde de ".pp
($soldes->{$personne})." (+" . pp
($depenses->{$personne}). " / -". pp
($frais->{$personne}) . ")\n";
501 print "Y-a-t-il des remboursements plus aisés ?\n";
502 my $ouinon = select_menu
("Oui", "Non");
504 AISE
: while($ouinon eq "Oui") {
506 my $personnea = select_participant
("Fini");
507 if(!$personnea) { last AISE
; }
508 print "Avec qui ?\n";
509 my $personneb = select_participant
("Annuler");
510 if(!$personneb) { next AISE
; }
511 compute_reimbursment
($personnea, $personneb, $soldes);
513 # Une boucle pour détecter si on a des couples qui s'annulent mutuellement
514 delete_zeros
($soldes, keys(%{$soldes}));
515 COUPLE
: foreach my $personnea (keys(%participants)) {
516 next if(pp
($soldes->{$personnea}, 1) == 0);
517 foreach my $personneb (keys(%participants)) {
518 next if (pp
($soldes->{$personneb} + $soldes->{$personnea}, 1) != 0);
519 compute_reimbursment
($personnea, $personneb, $soldes);
524 last REMB
if(keys(%{$soldes}) == 0);
526 my ($biggest_debtor, $smallest_creditor) = select_exchange_couple
($soldes);
527 compute_reimbursment
($biggest_debtor, $smallest_creditor, $soldes);
529 print_remboursements
();
531 case
"Afficher les remboursements" {
532 print_remboursements
();