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
27 my $file = "comptes.data";
29 my @actions=('Ajouter un participant');
30 my %participants = ();
31 my @transactions = ();
32 my @descriptions = ();
34 my @remboursements = ();
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);
45 $participants{$nom} = $numero;
47 while(my $transaction = <FILE
>) {
48 if($transaction eq "\n") { last; }
50 push(@transactions,$transaction);
51 my $description = <FILE
>;
53 push(@descriptions,$description);
55 while(my $remboursement = <FILE
>) {
56 if($remboursement eq "\n") { last; }
57 chomp($remboursement);
58 my @remb = split(/ /, $remboursement);
59 push(@remboursements,\
@remb);
65 my @actions = ('Ajouter un participant');
68 if (keys(%participants) > 0) {
69 $actions[1] = "Ajouter une dépense";
70 $actions[2] = "Enregistrer";
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";
79 if(scalar(@remboursements) > 0) {
80 $actions[7] = "Afficher les remboursements";
86 my @vart = ( @actions, 'Sortir' );
88 foreach $var ( @vart ) {
89 $message .= $i++.') '.$var."\n";
94 if(/\D/ || $var < 1 || $var > $i) {
95 print "Mauvaise entrée\n";
98 $action = $vart[$var-1];
106 my ($price, $noteur) = @_;
109 return sprintf("%.2f", $price)." EUR";
111 return sprintf("%.2f", $price);
115 sub compute_initiales
{
119 sub add_participant
{
120 print "Nom du participant ?\n";
121 my $participant = <STDIN
>;
123 $participant =~ s/\s/_/g;
124 $participants{$participant} = keys(%participants)+1;
133 foreach $var ( @vart ) {
134 print $i++.') '.$var."\n";
138 if(/\D/ || $var < 1 || $var > scalar @vart) {
139 print "Mauvaise entrée\n";
142 return $vart[$var-1];
146 sub select_participant
{
147 my ($annuler, @supplementaires) = @_;
151 my @vart = ( keys(%participants), @supplementaires, ($annuler) );
152 foreach $var ( @vart ) {
153 print $i++.') '.$var."\n";
157 if(/\D/ || $var < 1 || $var > scalar @vart) {
158 print "Mauvaise entrée\n";
161 if ($var != scalar @vart) {
162 return $vart[$var-1];
169 sub select_transaction
{
174 my @vart = ( @descriptions, "Annuler" );
175 foreach $var ( @vart ) {
176 print $i++.') '.$var."\n";
180 if(/\D/ || $var < 1 || $var > $i) {
181 print "Mauvaise entrée\n";
184 $transaction = $var-1;
188 my ($payeur, $prix, $total_parts, $split, $parts) = &parse_transaction
($transactions[$transaction]);
189 return ($descriptions[$transaction], $payeur, $prix, $total_parts, $split, $parts);
192 sub add_transaction
{
193 print "Qui a payé ?\n";
194 my $paye = select_participant
("Annuler");
200 my $description = <STDIN
>;
205 print "Pour qui ?\n";
206 my $repartition = "";
209 my $dest = select_participant
("Fini", "Ajouter à tous");
212 if($repartition eq "") {
216 elsif($total_parts == 0) {
217 print "Le nombre total de parts est nul, il faut en ajouter !\n";
221 push(@transactions, $participants{$paye}.' '.$prix.$repartition);
222 push(@descriptions, $description);
226 case
"Ajouter à tous" {
227 print "Nombre de parts ?\n";
231 foreach my $participant (keys(%participants)) {
232 $repartition .= ' '.$participants{$participant}.':'.scalar($parts);
233 $total_parts += scalar($parts);
238 print "Nombre de parts ?\n";
242 $repartition .= ' '.$participants{$dest}.':'.scalar($parts);
243 $total_parts += scalar($parts);
250 sub find_participant
{
251 my ($participant_number) = @_;
253 foreach my $name (keys(%participants)) {
254 if ($participant_number == $participants{$name}) {
260 sub parse_transaction
{
261 my ($transaction) = @_;
262 my @table_trans = split(/ /,$transaction);
264 my $payeur = shift(@table_trans);
265 $payeur = find_participant
($payeur);
266 my $prix = shift(@table_trans);
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;
277 if (!$parts{$payeur}) {
280 foreach my $participant (keys(%parts)) {
281 $split{$participant} = - ($parts{$participant} * $prix) / $total_parts;
282 if ($participant eq $payeur) {
283 $split{$participant} += $prix;
287 return ($payeur, $prix, $total_parts, \
%split, \
%parts);
292 my @string_lengths = sort { length($a) <=> length($b) } @strings;
293 return length($string_lengths[-1]);
296 sub list_transactions_for_participants
{
297 my (@participants) = @_;
298 my $one_participant = 0;
299 if (scalar @participants == 0) {
300 @participants = keys(%participants);
302 if (scalar @participants == 1) {
303 $one_participant = 1;
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;
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);
322 print $description.":";
323 foreach my $participant (@intersection) {
324 $solde{$participant} ||= 0;
325 $solde{$participant} += $parsed_transaction->{$participant};
327 if ($one_participant) {
328 print " ".pp
($parsed_transaction->{$participant});
329 if ($payeur eq $participant) {
330 print " (a payé, ".pp
($prix).")";
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).")";
342 if (!$one_participant) {
348 foreach my $personne (@participants) {
349 my $d = $depenses{$personne} || 0;
350 my $s = $solde{$personne} || 0;
352 print $personne." a payé ".pp
($d);
354 print $personne." n'a rien payé";
357 print " et a pour ".pp
($d - $s)." de frais au total.\n";
359 print " et n'a pas eu de frais.\n";
361 print $personne." a donc un solde de ".pp
($s)."\n";
369 foreach my $transaction (@transactions) {
370 my ($payeur, $prix, $total_parts, $split, $parts) = &parse_transaction
($transaction);
371 $depenses{$payeur} += $prix;
373 foreach my $personne (keys(%{$split})) {
374 $soldes{$personne} += $split->{$personne};
377 foreach my $personne (keys(%soldes)) {
378 $frais{$personne} = $depenses{$personne} - $soldes{$personne};
381 return (\
%depenses, \
%frais, \
%soldes);
385 my ($soldes, @participants) = @_;
387 foreach my $participant (@participants) {
388 delete $soldes->{$participant} if pp
($soldes->{$participant}, 1) == 0;
392 sub compute_reimbursment
{
393 my ($a, $b, $soldes) = @_;
394 my $s_a = $soldes->{$a};
395 my $s_b = $soldes->{$b};
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);
402 my @remboursement = ($debtor, $creditor, $exchange);
403 push @remboursements, \
@remboursement;
404 $soldes->{$creditor} -= $exchange;
405 $soldes->{$debtor} += $exchange;
406 delete_zeros
($soldes, $a, $b);
409 sub select_exchange_couple
{
411 my $bd; # biggest debtor
412 my $sc; # smallest creditor
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});
422 sub print_remboursements
{
423 foreach my $remboursement (@remboursements) {
424 my ($debtor, $creditor, $exchange) = (@{$remboursement});
425 print $debtor." doit ".pp
($exchange)." à ".$creditor."\n";
431 my $action = choose_action
();
433 case
"Ajouter un participant" {
436 case
"Ajouter une dépense" {
439 case
"Voir les frais de quelqu'un (dépenses - dettes)" {
440 my $personne = select_participant
("Annuler");
444 list_transactions_for_participants
(($personne));
447 case
"Voir les frais de tout le monde" {
448 list_transactions_for_participants
(keys(%participants));
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}).")";
463 print "Nom de l'événement ?";
464 if(!($evenement_def eq "")) {
465 print " [".$evenement_def."]";
468 my $evenement = <STDIN
>;
470 if($evenement eq "") {
471 $evenement = $evenement_def;
473 open FILE
, ">".$file;
474 print FILE
$evenement."\n";
476 foreach $key (keys(%participants)) {
477 print FILE
$participants{$key}." ".$key."\n";
480 for(my $i=0;$i<scalar(@transactions);$i++) {
481 print FILE
$transactions[$i]."\n";
482 print FILE
$descriptions[$i]."\n";
485 foreach my $remboursement (@remboursements) {
486 print FILE
join(" ", @{$remboursement})."\n";
491 my ($depenses, $frais, $soldes) = compute_equity
();
492 @remboursements = ();
494 foreach my $personne (keys(%participants)) {
495 print $personne." a un solde de ".pp
($soldes->{$personne})." (+" . pp
($depenses->{$personne}). " / -". pp
($frais->{$personne}) . ")\n";
498 print "Y-a-t-il des remboursements plus aisés ?\n";
499 my $ouinon = select_menu
("Oui", "Non");
501 AISE
: while($ouinon eq "Oui") {
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);
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);
521 last REMB
if(keys(%{$soldes}) == 0);
523 my ($biggest_debtor, $smallest_creditor) = select_exchange_couple
($soldes);
524 compute_reimbursment
($biggest_debtor, $smallest_creditor, $soldes);
526 print_remboursements
();
528 case
"Afficher les remboursements" {
529 print_remboursements
();