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 = "";
37 open FILE, $ARGV[0] || die "Impossible de lire le fichier";
38 $evenement_def = <FILE>;
39 chomp($evenement_def);
40 while(my $noms = <FILE>) {
41 if($noms eq "\n") { last; }
42 my ($numero,$nom) = split(/ /,$noms,2);
44 $participants{$nom} = $numero;
46 while(my $transaction = <FILE>) {
47 if($transaction eq "\n") { last; }
49 push(@transactions,$transaction);
50 my $description = <FILE>;
52 push(@descriptions,$description);
58 if(keys(%participants)>0) {
59 $actions[1]="Ajouter une dépense";
60 $actions[2]="Enregistrer";
62 if(scalar(@transactions)>0) {
63 $actions[3]="Voir les dépenses de quelqu'un";
64 $actions[2]="Enregistrer";
65 $actions[4]="Equilibrage";
66 $actions[5]="Voir une transaction";
73 my @vart = ( @actions, 'Sortir' );
75 foreach $var ( @vart ) {
76 $message .= $i++.') '.$var."\n";
81 if(/\D/ || $var < 1 || $var > $i) {
82 print "Mauvaise entrée\n";
85 $action = $vart[$var-1];
89 case "Ajouter un participant" {
90 print "Nom du participant\n";
91 my $participant = <STDIN>;
93 $participants{$participant} = keys(%participants)+1;
95 case "Ajouter une dépense" {
96 print "Qui a payé ?\n";
101 my @vart = ( keys(%participants), "Annuler" );
102 foreach $var ( @vart ) {
103 print $i++.') '.$var."\n";
107 if(/\D/ || $var < 1 || $var > $i) {
108 print "Mauvaise entrée\n";
111 $paye = $vart[$var-1];
114 if($paye eq "Annuler") {
118 my $description = <STDIN>;
123 print "Pour qui ?\n";
124 my $repartition = "";
131 my @vart = ( keys(%participants), "Ajouter à tous", "Fini" );
132 foreach $var ( @vart ) {
133 print $i++.') '.$var."\n";
137 if(/\D/ || $var < 1 || $var > $i) {
138 print "Mauvaise entrée\n";
141 $dest = $vart[$var-1];
146 if($repartition eq "") { print "Annulé\n"; }
147 elsif($total_parts == 0) {
148 print "Le nombre total de parts est nul, il faut en ajouter !\n";
152 push(@transactions, $participants{$paye}.' '.$prix.$repartition);
153 push(@descriptions, $description);
157 case "Ajouter à tous" {
158 print "Nombre de parts ?\n";
162 foreach my $participant (keys(%participants)) {
163 $repartition .= ' '.$participants{$participant}.':'.scalar($parts);
164 $total_parts += scalar($parts);
169 print "Nombre de parts ?\n";
173 $repartition .= ' '.$participants{$dest}.':'.scalar($parts);
174 $total_parts += scalar($parts);
180 case "Voir les dépenses de quelqu'un" {
185 my @vart = ( keys(%participants), "Annuler" );
186 foreach $var ( @vart ) {
187 print $i++.') '.$var."\n";
191 if(/\D/ || $var < 1 || $var > $i) {
192 print "Mauvaise entrée\n";
195 $personne = $vart[$var-1];
198 if($personne eq "Annuler") {
203 foreach my $transaction (@transactions) {
204 my @table_trans = split(/ /,$transaction);
205 my $payeur = shift(@table_trans);
206 my $prix = shift(@table_trans);
207 if($payeur == $participants{$personne}) {
213 foreach $repartition (@table_trans) {
214 my ($pers,$part) = split(/:/,$repartition);
215 if($pers == $participants{$personne}) {
220 $frais += $prix*$frac/$parts;
222 print $personne." a payé ".$depenses." EUR\n";
223 print "et a pour ".sprintf("%.2f",$frais)." EUR de frais au total.\n";
224 print "Il a donc un solde de ".sprintf("%.2f",$depenses-$frais)." EUR\n";
227 case "Voir une transaction" {
232 my @vart = ( @descriptions, "Annuler" );
233 foreach $var ( @vart ) {
234 print $i++.') '.$var."\n";
238 if(/\D/ || $var < 1 || $var > $i) {
239 print "Mauvaise entrée\n";
242 $transaction = $var-1;
245 my @table_trans = split(/ /,$transactions[$transaction]);
246 my $payeur = shift(@table_trans);
247 my $prix = shift(@table_trans);
251 foreach my $pers (keys(%participants)) {
252 if($payeur == $participants{$pers}) {
253 print $descriptions[$transaction]." (payé par ".$pers."), ".$prix." EUR\n";
257 foreach $repartition (@table_trans) {
258 my ($pers,$part) = split(/:/,$repartition);
260 $parts{$pers} += $part;
262 foreach my $pers (keys(%participants)) {
263 if(!exists $parts{$participants{$pers}}) {
266 print $pers.", ".$parts{$participants{$pers}}." part(s), soit ". $prix*$parts{$participants{$pers}}/$Tparts." EUR\n";
271 print "Nom de l'événement ?";
272 if(!($evenement_def eq "")) {
273 print " [".$evenement_def."]";
276 my $evenement = <STDIN>;
278 if($evenement eq "") {
279 $evenement = $evenement_def;
281 open FILE, ">".$file;
282 print FILE $evenement."\n";
284 foreach $key (keys(%participants)) {
285 print FILE $participants{$key}." ".$key."\n";
288 for(my $i=0;$i<scalar(@transactions);$i++) {
289 print FILE $transactions[$i]."\n";
290 print FILE $descriptions[$i]."\n";
293 print FILE $remboursements;
300 $remboursements = "";
301 foreach my $Ttransaction (@transactions) {
302 my @Ttable_trans = split(/ /,$Ttransaction);
303 my $Tpayeur = shift(@Ttable_trans);
304 my $Tprix = shift(@Ttable_trans);
305 $Tdepenses{$Tpayeur} = $Tdepenses{$Tpayeur} + $Tprix;
309 foreach $Trepartition (@Ttable_trans) {
310 my ($Tpers,$Tpart) = split(/:/,$Trepartition);
313 foreach $Trepartition (@Ttable_trans) {
314 my ($Tpers,$Tpart) = split(/:/,$Trepartition);
315 $Tfrais{$Tpers} = $Tfrais{$Tpers} + $Tprix*$Tpart/$Tparts;
318 foreach my $Tpersonne (keys(%participants)) {
319 my $numero = $participants{$Tpersonne};
320 $Tsolde{$Tpersonne} = sprintf("%.2f",$Tdepenses{$numero}-$Tfrais{$numero});
321 print $Tpersonne." a un solde de ".$Tsolde{$Tpersonne}." EUR\n";
324 print "Y-a-t-il des remboursements plus aisés ?\n";
329 my @vart = ( "Oui", "Non" );
330 foreach $var ( @vart ) {
331 print $i++.') '.$var."\n";
335 if(/\D/ || $var < 1 || $var > $i) {
336 print "Mauvaise entrée\n";
339 $ouinon = $vart[$var-1];
342 AISE: while($ouinon eq "Oui") {
348 my @vart = ( keys(%participants), "Fini" );
349 foreach $var ( @vart ) {
350 print $i++.') '.$var."\n";
354 if(/\D/ || $var < 1 || $var > $i) {
355 print "Mauvaise entrée\n";
358 $personne = $vart[$var-1];
361 if($personne eq "Fini") { last AISE; }
362 print "Avec qui ?\n";
367 my @vart = ( keys(%participants), "Annuler" );
368 foreach $var ( @vart ) {
369 print $i++.') '.$var."\n";
373 if(/\D/ || $var < 1 || $var > $i) {
374 print "Mauvaise entrée\n";
377 $personneb = $vart[$var-1];
380 if($personneb eq "Annuler") { next AISE; }
381 if($Tsolde{$personne}*$Tsolde{$personneb}<0) {
382 my $pers_inf = ($Tsolde{$personne}<0)?$personne:$personneb;
383 my $pers_sup = ($Tsolde{$personne}>0)?$personne:$personneb;
384 my $inf = (abs($Tsolde{$personne})<abs($Tsolde{$personneb}))?abs($Tsolde{$personne}):abs($Tsolde{$personneb});
385 $remboursements .= $pers_inf." doit ".$inf." EUR à ".$pers_sup."\n";
386 $Tsolde{$pers_inf} += $inf;
387 $Tsolde{$pers_sup} -= $inf;
390 # Une boucle pour détecter si on a des couples qui s'annulent mutuellement
391 COUPLE: foreach my $personne (keys(%participants)) {
392 if($Tsolde{$personne} == 0) { next; }
393 foreach my $personneb (keys(%participants)) {
394 if($Tsolde{$personneb} + $Tsolde{$personne} != 0) { next; }
395 my $pers_inf = ($Tsolde{$personne}<0)?$personne:$personneb;
396 my $pers_sup = ($Tsolde{$personne}>0)?$personne:$personneb;
397 my $val = abs($Tsolde{$personne});
398 $remboursements .= $pers_inf." doit ".$val." EUR à ".$pers_sup."\n";
399 $Tsolde{$pers_inf} += $val;
400 $Tsolde{$pers_sup} -= $val;
405 # On supprime les 0, et on fait deux hashs
408 foreach my $personne (keys(%Tsolde)) {
409 if($Tsolde{$personne} == 0) { delete $Tsolde{$personne}; }
410 elsif($Tsolde{$personne} < 0) { $Tneg{$personne} = $Tsolde{$personne}; }
411 elsif($Tsolde{$personne} > 0) { $Tpos{$personne} = $Tsolde{$personne}; }
413 if(keys(%Tneg) == 0) {
416 foreach my $neg (sort { $Tneg{$a} cmp $Tneg{$b} } keys %Tneg) {
419 foreach my $pos (sort { $Tpos{$a} cmp $Tpos{$b} } keys %Tpos) {
420 if($Tpos{$pos} + $Tneg{$neg}>0) {
427 $remboursements .= $neg." doit ".$Tsolde{$max}." EUR à ".$max."\n";
428 $Tsolde{$neg} += $Tsolde{$max};
429 delete $Tsolde{$max};
432 $remboursements .= $neg." doit ".-$Tsolde{$neg}." EUR à ".$positif."\n";
433 $Tsolde{$positif} += $Tsolde{$neg};
434 delete $Tsolde{$neg};
439 print $remboursements;