]>
Commit | Line | Data |
---|---|---|
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 | } |