]>
Commit | Line | Data |
---|---|---|
c2590696 | 1 | #!/usr/bin/env perl |
5172ecf8 IB |
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 | ||
2d8938f6 IB |
24 | |
25 | # Feel like tipping/donating? https://www.immae.eu/licenses_and_tipping | |
26 | ||
5172ecf8 IB |
27 | use Switch; |
28 | use strict; | |
29 | ||
30 | my $file = "comptes.data"; | |
31 | ||
32 | my @actions=('Ajouter un participant'); | |
33 | my %participants = (); | |
34 | my @transactions = (); | |
35 | my @descriptions = (); | |
36 | my $evenement_def; | |
c2590696 IB |
37 | my @remboursements = (); |
38 | my %initiales = (); | |
39 | ||
40 | if($#ARGV == 0) { | |
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); | |
47 | chomp($nom); | |
48 | $participants{$nom} = $numero; | |
49 | } | |
50 | while(my $transaction = <FILE>) { | |
51 | if($transaction eq "\n") { last; } | |
52 | chomp($transaction); | |
53 | push(@transactions,$transaction); | |
54 | my $description = <FILE>; | |
55 | chomp($description); | |
56 | push(@descriptions,$description); | |
57 | } | |
58 | while(my $remboursement = <FILE>) { | |
59 | if($remboursement eq "\n") { last; } | |
60 | chomp($remboursement); | |
61 | my @remb = split(/ /, $remboursement); | |
62 | push(@remboursements,\@remb); | |
63 | } | |
64 | $file = $ARGV[0]; | |
65 | } | |
66 | ||
67 | sub choose_action { | |
68 | my @actions = ('Ajouter un participant'); | |
69 | my $action; | |
70 | ||
71 | if (keys(%participants) > 0) { | |
72 | $actions[1] = "Ajouter une dépense"; | |
73 | $actions[2] = "Enregistrer"; | |
74 | } | |
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"; | |
81 | } | |
82 | if(scalar(@remboursements) > 0) { | |
83 | $actions[7] = "Afficher les remboursements"; | |
84 | } | |
85 | ||
86 | while(1) { | |
87 | my $i = 1; | |
88 | my $var; | |
89 | my @vart = ( @actions, 'Sortir' ); | |
90 | my $message = ''; | |
91 | foreach $var ( @vart ) { | |
92 | $message .= $i++.') '.$var."\n"; | |
93 | } | |
94 | print $message; | |
95 | $var = <STDIN>; | |
96 | chop($var); | |
97 | if(/\D/ || $var < 1 || $var > $i) { | |
98 | print "Mauvaise entrée\n"; | |
99 | next; | |
100 | } | |
101 | $action = $vart[$var-1]; | |
102 | last; | |
103 | } | |
104 | ||
105 | return $action; | |
106 | } | |
107 | ||
108 | sub pp { | |
109 | my ($price, $noteur) = @_; | |
110 | ||
111 | if (!$noteur) { | |
112 | return sprintf("%.2f", $price)." EUR"; | |
113 | } else { | |
114 | return sprintf("%.2f", $price); | |
115 | } | |
116 | } | |
117 | ||
118 | sub compute_initiales { | |
119 | %initiales = (); | |
120 | } | |
121 | ||
122 | sub add_participant { | |
123 | print "Nom du participant ?\n"; | |
124 | my $participant = <STDIN>; | |
125 | chomp($participant); | |
126 | $participant =~ s/\s/_/g; | |
127 | $participants{$participant} = keys(%participants)+1; | |
128 | compute_initiales(); | |
129 | } | |
130 | ||
131 | sub select_menu { | |
132 | my (@vart) = @_; | |
133 | while(1) { | |
134 | my $i = 1; | |
135 | my $var; | |
136 | foreach $var ( @vart ) { | |
137 | print $i++.') '.$var."\n"; | |
138 | } | |
139 | $var = <STDIN>; | |
140 | chop($var); | |
141 | if(/\D/ || $var < 1 || $var > scalar @vart) { | |
142 | print "Mauvaise entrée\n"; | |
143 | next; | |
5172ecf8 | 144 | } |
c2590696 IB |
145 | return $vart[$var-1]; |
146 | } | |
147 | } | |
148 | ||
149 | sub select_participant { | |
150 | my ($annuler, @supplementaires) = @_; | |
151 | while(1) { | |
152 | my $i = 1; | |
153 | my $var; | |
154 | my @vart = ( keys(%participants), @supplementaires, ($annuler) ); | |
155 | foreach $var ( @vart ) { | |
156 | print $i++.') '.$var."\n"; | |
5172ecf8 | 157 | } |
c2590696 IB |
158 | $var = <STDIN>; |
159 | chop($var); | |
160 | if(/\D/ || $var < 1 || $var > scalar @vart) { | |
161 | print "Mauvaise entrée\n"; | |
162 | next; | |
163 | } | |
164 | if ($var != scalar @vart) { | |
165 | return $vart[$var-1]; | |
166 | } else { | |
167 | return; | |
168 | } | |
169 | } | |
170 | } | |
171 | ||
172 | sub select_transaction { | |
173 | my $transaction; | |
174 | while(1) { | |
175 | my $i = 1; | |
176 | my $var; | |
177 | my @vart = ( @descriptions, "Annuler" ); | |
178 | foreach $var ( @vart ) { | |
179 | print $i++.') '.$var."\n"; | |
180 | } | |
181 | $var = <STDIN>; | |
182 | chop($var); | |
183 | if(/\D/ || $var < 1 || $var > $i) { | |
184 | print "Mauvaise entrée\n"; | |
185 | next; | |
186 | } | |
187 | $transaction = $var-1; | |
188 | last; | |
189 | } | |
190 | ||
191 | my ($payeur, $prix, $total_parts, $split, $parts) = &parse_transaction($transactions[$transaction]); | |
192 | return ($descriptions[$transaction], $payeur, $prix, $total_parts, $split, $parts); | |
193 | } | |
194 | ||
195 | sub add_transaction { | |
196 | print "Qui a payé ?\n"; | |
197 | my $paye = select_participant("Annuler"); | |
198 | if(!$paye) { | |
199 | print "Annulé"; | |
200 | return; | |
201 | } | |
202 | print "Quoi ?\n"; | |
203 | my $description = <STDIN>; | |
204 | chomp($description); | |
205 | print "Combien ?\n"; | |
206 | my $prix = <STDIN>; | |
207 | chomp($prix); | |
208 | print "Pour qui ?\n"; | |
209 | my $repartition = ""; | |
210 | my $total_parts = 0; | |
211 | DESTS: while(1) { | |
212 | my $dest = select_participant("Fini", "Ajouter à tous"); | |
213 | switch($dest) { | |
214 | case undef { | |
215 | if($repartition eq "") { | |
216 | print "Annulé\n"; | |
217 | return; | |
218 | } | |
219 | elsif($total_parts == 0) { | |
220 | print "Le nombre total de parts est nul, il faut en ajouter !\n"; | |
221 | next DESTS; | |
222 | } | |
223 | else { | |
224 | push(@transactions, $participants{$paye}.' '.$prix.$repartition); | |
225 | push(@descriptions, $description); | |
226 | return; | |
227 | } | |
228 | } | |
229 | case "Ajouter à tous" { | |
230 | print "Nombre de parts ?\n"; | |
231 | my $parts = <STDIN>; | |
232 | chomp($parts); | |
233 | if(!($parts == 0)) { | |
234 | foreach my $participant (keys(%participants)) { | |
235 | $repartition .= ' '.$participants{$participant}.':'.scalar($parts); | |
236 | $total_parts += scalar($parts); | |
237 | } | |
238 | } | |
239 | } | |
240 | else { | |
241 | print "Nombre de parts ?\n"; | |
242 | my $parts = <STDIN>; | |
243 | chomp($parts); | |
244 | if(!($parts == 0)) { | |
245 | $repartition .= ' '.$participants{$dest}.':'.scalar($parts); | |
246 | $total_parts += scalar($parts); | |
247 | } | |
248 | } | |
249 | } | |
250 | } | |
251 | } | |
252 | ||
253 | sub find_participant { | |
254 | my ($participant_number) = @_; | |
255 | ||
256 | foreach my $name (keys(%participants)) { | |
257 | if ($participant_number == $participants{$name}) { | |
258 | return $name; | |
259 | } | |
260 | } | |
261 | } | |
262 | ||
263 | sub parse_transaction { | |
264 | my ($transaction) = @_; | |
265 | my @table_trans = split(/ /,$transaction); | |
266 | ||
267 | my $payeur = shift(@table_trans); | |
268 | $payeur = find_participant($payeur); | |
269 | my $prix = shift(@table_trans); | |
270 | my %parts; | |
271 | my %split; | |
272 | my $total_parts = 0; | |
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; | |
279 | } | |
280 | if (!$parts{$payeur}) { | |
281 | $parts{$payeur} = 0; | |
282 | } | |
283 | foreach my $participant (keys(%parts)) { | |
284 | $split{$participant} = - ($parts{$participant} * $prix) / $total_parts; | |
285 | if ($participant eq $payeur) { | |
286 | $split{$participant} += $prix; | |
287 | } | |
288 | } | |
289 | ||
290 | return ($payeur, $prix, $total_parts, \%split, \%parts); | |
291 | } | |
292 | ||
293 | sub max_length { | |
294 | my (@strings) = @_; | |
295 | my @string_lengths = sort { length($a) <=> length($b) } @strings; | |
296 | return length($string_lengths[-1]); | |
297 | } | |
298 | ||
299 | sub list_transactions_for_participants { | |
300 | my (@participants) = @_; | |
301 | my $one_participant = 0; | |
302 | if (scalar @participants == 0) { | |
303 | @participants = keys(%participants); | |
304 | } | |
305 | if (scalar @participants == 1) { | |
306 | $one_participant = 1; | |
307 | } | |
308 | ||
309 | my %depenses; | |
310 | my %solde; | |
311 | ||
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; | |
319 | ||
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); | |
324 | ||
325 | print $description.":"; | |
326 | foreach my $participant (@intersection) { | |
327 | $solde{$participant} ||= 0; | |
328 | $solde{$participant} += $parsed_transaction->{$participant}; | |
329 | ||
330 | if ($one_participant) { | |
331 | print " ".pp($parsed_transaction->{$participant}); | |
332 | if ($payeur eq $participant) { | |
333 | print " (a payé, ".pp($prix).")"; | |
334 | } | |
335 | print "\n"; | |
336 | } else { | |
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).")"; | |
341 | } | |
342 | print "\n".$phantom; | |
343 | } | |
344 | } | |
345 | if (!$one_participant) { | |
346 | print "\n"; | |
347 | } | |
348 | } | |
349 | } | |
350 | ||
351 | foreach my $personne (@participants) { | |
352 | my $d = $depenses{$personne} || 0; | |
353 | my $s = $solde{$personne} || 0; | |
354 | if ($d) { | |
355 | print $personne." a payé ".pp($d); | |
356 | } else { | |
357 | print $personne." n'a rien payé"; | |
358 | } | |
359 | if ($s) { | |
360 | print " et a pour ".pp($d - $s)." de frais au total.\n"; | |
361 | } else { | |
362 | print " et n'a pas eu de frais.\n"; | |
363 | } | |
364 | print $personne." a donc un solde de ".pp($s)."\n"; | |
365 | } | |
366 | } | |
367 | ||
368 | sub compute_equity { | |
369 | my %depenses; | |
370 | my %frais; | |
371 | my %soldes; | |
372 | foreach my $transaction (@transactions) { | |
373 | my ($payeur, $prix, $total_parts, $split, $parts) = &parse_transaction($transaction); | |
374 | $depenses{$payeur} += $prix; | |
375 | ||
376 | foreach my $personne (keys(%{$split})) { | |
377 | $soldes{$personne} += $split->{$personne}; | |
378 | } | |
379 | } | |
380 | foreach my $personne (keys(%soldes)) { | |
381 | $frais{$personne} = $depenses{$personne} - $soldes{$personne}; | |
382 | } | |
383 | ||
384 | return (\%depenses, \%frais, \%soldes); | |
385 | } | |
386 | ||
387 | sub delete_zeros { | |
388 | my ($soldes, @participants) = @_; | |
389 | ||
390 | foreach my $participant (@participants) { | |
391 | delete $soldes->{$participant} if pp($soldes->{$participant}, 1) == 0; | |
392 | } | |
393 | } | |
394 | ||
395 | sub compute_reimbursment { | |
396 | my ($a, $b, $soldes) = @_; | |
397 | my $s_a = $soldes->{$a}; | |
398 | my $s_b = $soldes->{$b}; | |
399 | ||
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); | |
404 | ||
405 | my @remboursement = ($debtor, $creditor, $exchange); | |
406 | push @remboursements, \@remboursement; | |
407 | $soldes->{$creditor} -= $exchange; | |
408 | $soldes->{$debtor} += $exchange; | |
409 | delete_zeros($soldes, $a, $b); | |
410 | } | |
411 | ||
412 | sub select_exchange_couple { | |
413 | my ($soldes) = @_; | |
414 | my $bd; # biggest debtor | |
415 | my $sc; # smallest creditor | |
416 | ||
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}); | |
420 | } | |
421 | ||
422 | return ($bd, $sc); | |
423 | } | |
424 | ||
425 | sub print_remboursements { | |
426 | foreach my $remboursement (@remboursements) { | |
427 | my ($debtor, $creditor, $exchange) = (@{$remboursement}); | |
428 | print $debtor." doit ".pp($exchange)." à ".$creditor."\n"; | |
429 | } | |
430 | my $pause = <STDIN>; | |
5172ecf8 IB |
431 | } |
432 | ||
433 | GLOBALE: while(1) { | |
c2590696 IB |
434 | my $action = choose_action(); |
435 | switch ($action) { | |
436 | case "Ajouter un participant" { | |
437 | add_participant(); | |
438 | } | |
439 | case "Ajouter une dépense" { | |
440 | add_transaction(); | |
441 | } | |
442 | case "Voir les frais de quelqu'un (dépenses - dettes)" { | |
443 | my $personne = select_participant("Annuler"); | |
444 | if(!$personne) { | |
445 | next GLOBALE; | |
446 | } | |
447 | list_transactions_for_participants(($personne)); | |
448 | my $pause = <STDIN>; | |
449 | } | |
450 | case "Voir les frais de tout le monde" { | |
451 | list_transactions_for_participants(keys(%participants)); | |
452 | my $pause = <STDIN>; | |
5172ecf8 | 453 | } |
c2590696 IB |
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}).")"; | |
461 | } | |
462 | print "\n"; | |
463 | } | |
5172ecf8 | 464 | } |
c2590696 IB |
465 | case "Enregistrer" { |
466 | print "Nom de l'événement ?"; | |
467 | if(!($evenement_def eq "")) { | |
468 | print " [".$evenement_def."]"; | |
469 | } | |
470 | print "\n"; | |
471 | my $evenement = <STDIN>; | |
472 | chomp($evenement); | |
473 | if($evenement eq "") { | |
474 | $evenement = $evenement_def; | |
475 | } | |
476 | open FILE, ">".$file; | |
477 | print FILE $evenement."\n"; | |
478 | my $key; | |
479 | foreach $key (keys(%participants)) { | |
480 | print FILE $participants{$key}." ".$key."\n"; | |
481 | } | |
482 | print FILE "\n"; | |
483 | for(my $i=0;$i<scalar(@transactions);$i++) { | |
484 | print FILE $transactions[$i]."\n"; | |
485 | print FILE $descriptions[$i]."\n"; | |
486 | } | |
487 | print FILE "\n"; | |
488 | foreach my $remboursement (@remboursements) { | |
489 | print FILE join(" ", @{$remboursement})."\n"; | |
490 | } | |
491 | close FILE; | |
492 | } | |
493 | case "Equilibrage" { | |
494 | my ($depenses, $frais, $soldes) = compute_equity(); | |
495 | @remboursements = (); | |
496 | ||
497 | foreach my $personne (keys(%participants)) { | |
498 | print $personne." a un solde de ".pp($soldes->{$personne})." (+" . pp($depenses->{$personne}). " / -". pp($frais->{$personne}) . ")\n"; | |
499 | } | |
500 | my $pause = <STDIN>; | |
501 | print "Y-a-t-il des remboursements plus aisés ?\n"; | |
502 | my $ouinon = select_menu("Oui", "Non"); | |
5172ecf8 | 503 | |
c2590696 IB |
504 | AISE: while($ouinon eq "Oui") { |
505 | print "Qui ?\n"; | |
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); | |
512 | } | |
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); | |
520 | next COUPLE; | |
521 | } | |
522 | } | |
523 | REMB: while(1) { | |
524 | last REMB if(keys(%{$soldes}) == 0); | |
525 | ||
526 | my ($biggest_debtor, $smallest_creditor) = select_exchange_couple($soldes); | |
527 | compute_reimbursment($biggest_debtor, $smallest_creditor, $soldes); | |
528 | } | |
529 | print_remboursements(); | |
530 | } | |
531 | case "Afficher les remboursements" { | |
532 | print_remboursements(); | |
5172ecf8 | 533 | } |
c2590696 IB |
534 | case "Sortir" { |
535 | last GLOBALE; | |
5172ecf8 | 536 | } |
c2590696 | 537 | } |
5172ecf8 | 538 | } |