path: root/comptes

#!/usr/bin/env perl
# The MIT License (MIT)
# 
# Copyright (c) 2011-2015 Ismaël Bouya http://www.normalesup.org/~bouya/
# 
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
# THE SOFTWARE.


# Feel like tipping/donating? https://www.immae.eu/licenses_and_tipping

use Switch;
use strict;

my $file = "comptes.data";

my @actions=('Ajouter un participant');
my %participants = ();
my @transactions = ();
my @descriptions = ();
my $evenement_def;
my @remboursements = ();
my %initiales = ();

if($#ARGV == 0) {
  open FILE, $ARGV[0] || die "Impossible de lire le fichier";
  $evenement_def = <FILE>;
  chomp($evenement_def);
  while(my $noms = <FILE>) {
    if($noms eq "\n") { last; }
    my ($numero,$nom) = split(/ /,$noms,2);
    chomp($nom);
    $participants{$nom} = $numero;
  }
  while(my $transaction = <FILE>) {
    if($transaction eq "\n") { last; }
    chomp($transaction);
    push(@transactions,$transaction);
    my $description = <FILE>;
    chomp($description);
    push(@descriptions,$description);
  }
  while(my $remboursement = <FILE>) {
    if($remboursement eq "\n") { last; }
    chomp($remboursement);
    my @remb = split(/ /, $remboursement);
    push(@remboursements,\@remb);
  }
  $file = $ARGV[0];
}

sub choose_action {
  my @actions = ('Ajouter un participant');
  my $action;

  if (keys(%participants) > 0) {
    $actions[1] = "Ajouter une dépense";
    $actions[2] = "Enregistrer";
  }
  if(scalar(@transactions) > 0) {
    $actions[2] = "Enregistrer";
    $actions[3] = "Voir les frais de quelqu'un (dépenses - dettes)";
    $actions[4] = "Voir les frais de tout le monde";
    $actions[5] = "Equilibrage";
    $actions[6] = "Voir une transaction";
  }
  if(scalar(@remboursements) > 0) {
    $actions[7] = "Afficher les remboursements";
  }

  while(1) {
    my $i = 1;
    my $var;
    my @vart = ( @actions, 'Sortir' );
    my $message = '';
    foreach $var ( @vart ) {
      $message .= $i++.') '.$var."\n";
    }
    print $message;
    $var = <STDIN>;
    chop($var);
    if(/\D/ || $var < 1 || $var > $i) {
      print "Mauvaise entrée\n";
      next;
    }
    $action = $vart[$var-1];
    last;
  }

  return $action;
}

sub pp {
  my ($price, $noteur) = @_;

  if (!$noteur) {
    return sprintf("%.2f", $price)." EUR";
  } else {
    return sprintf("%.2f", $price);
  }
}

sub compute_initiales {
  %initiales = ();
}

sub add_participant {
  print "Nom du participant ?\n";
  my $participant = <STDIN>;
  chomp($participant);
  $participant =~ s/\s/_/g;
  $participants{$participant} = keys(%participants)+1;
  compute_initiales();
}

sub select_menu {
  my (@vart) = @_;
  while(1) {
    my $i = 1;
    my $var;
    foreach $var ( @vart ) {
      print $i++.') '.$var."\n";
    }
    $var = <STDIN>;
    chop($var);
    if(/\D/ || $var < 1 || $var > scalar @vart) {
      print "Mauvaise entrée\n";
      next;
    }
    return $vart[$var-1];
  }
}

sub select_participant {
  my ($annuler, @supplementaires) = @_;
  while(1) {
    my $i = 1;
    my $var;
    my @vart = ( keys(%participants), @supplementaires, ($annuler) );
    foreach $var ( @vart ) {
      print $i++.') '.$var."\n";
    }
    $var = <STDIN>;
    chop($var);
    if(/\D/ || $var < 1 || $var > scalar @vart) {
      print "Mauvaise entrée\n";
      next;
    }
    if ($var != scalar @vart) {
      return $vart[$var-1];
    } else {
      return;
    }
  }
}

sub select_transaction {
  my $transaction;
  while(1) {
    my $i = 1;
    my $var;
    my @vart = ( @descriptions, "Annuler" );
    foreach $var ( @vart ) {
      print $i++.') '.$var."\n";
    }
    $var = <STDIN>;
    chop($var);
    if(/\D/ || $var < 1 || $var > $i) {
      print "Mauvaise entrée\n";
      next;
    }
    $transaction = $var-1;
    last;
  }

  my ($payeur, $prix, $total_parts, $split, $parts) = &parse_transaction($transactions[$transaction]);
  return ($descriptions[$transaction], $payeur, $prix, $total_parts, $split, $parts);
}

sub add_transaction {
  print "Qui a payé ?\n";
  my $paye = select_participant("Annuler");
  if(!$paye) {
    print "Annulé";
    return;
  }
  print "Quoi ?\n";
  my $description = <STDIN>;
  chomp($description);
  print "Combien ?\n";
  my $prix = <STDIN>;
  chomp($prix);
  print "Pour qui ?\n";
  my $repartition = "";
  my $total_parts = 0;
  DESTS: while(1) {
    my $dest = select_participant("Fini", "Ajouter à tous");
    switch($dest) {
      case undef {
        if($repartition eq "") {
          print "Annulé\n";
          return;
        }
        elsif($total_parts == 0) {
          print "Le nombre total de parts est nul, il faut en ajouter !\n";
          next DESTS;
        }
        else {
          push(@transactions, $participants{$paye}.' '.$prix.$repartition);
          push(@descriptions, $description);
          return;
        }
      }
      case "Ajouter à tous" {
        print "Nombre de parts ?\n";
        my $parts = <STDIN>;
        chomp($parts);
        if(!($parts == 0)) {
          foreach my $participant (keys(%participants)) {
            $repartition .= ' '.$participants{$participant}.':'.scalar($parts);
            $total_parts += scalar($parts);
          }
        }
      }
      else {
        print "Nombre de parts ?\n";
        my $parts = <STDIN>;
        chomp($parts);
        if(!($parts == 0)) {
          $repartition .= ' '.$participants{$dest}.':'.scalar($parts);
          $total_parts += scalar($parts);
        }
      }
    }
  }
}

sub find_participant {
  my ($participant_number) = @_;

  foreach my $name (keys(%participants)) {
    if ($participant_number == $participants{$name}) {
      return $name;
    }
  }
}

sub parse_transaction {
  my ($transaction) = @_;
  my @table_trans = split(/ /,$transaction);

  my $payeur = shift(@table_trans);
  $payeur = find_participant($payeur);
  my $prix = shift(@table_trans);
  my %parts;
  my %split;
  my $total_parts = 0;
  foreach my $repartition (@table_trans) {
    my ($participant, $part) = split(/:/, $repartition);
    $participant = find_participant($participant);
    $parts{$participant} ||= 0;
    $parts{$participant} += $part;
    $total_parts += $part;
  }
  if (!$parts{$payeur}) {
    $parts{$payeur} = 0;
  }
  foreach my $participant (keys(%parts)) {
    $split{$participant} = - ($parts{$participant} * $prix) / $total_parts;
    if ($participant eq $payeur) {
      $split{$participant} += $prix;
    }
  }

  return ($payeur, $prix, $total_parts, \%split, \%parts);
}

sub max_length {
  my (@strings) = @_;
  my @string_lengths = sort { length($a) <=> length($b) } @strings;
  return length($string_lengths[-1]);
}

sub list_transactions_for_participants {
  my (@participants) = @_;
  my $one_participant = 0;
  if (scalar @participants == 0) {
    @participants = keys(%participants);
  }
  if (scalar @participants == 1) {
    $one_participant = 1;
  }

  my %depenses;
  my %solde;

  my @zipped = map {($transactions[$_], $descriptions[$_])} (0 .. $#descriptions);
  while (scalar(@zipped) > 0) {
    my $transaction = shift @zipped;
    my $description = shift @zipped;
    my ($payeur, $prix, $total_parts, $parsed_transaction, $parts) = &parse_transaction($transaction);
    $depenses{$payeur} ||= 0;
    $depenses{$payeur} += $prix;

    my @intersection = grep( $parsed_transaction->{$_}, @participants);
    if (scalar @intersection) {
      my $phantom = " " x length($description.":");
      my $max_participant_length = max_length(@intersection);

      print $description.":";
      foreach my $participant (@intersection) {
        $solde{$participant} ||= 0;
        $solde{$participant} += $parsed_transaction->{$participant};

        if ($one_participant) {
          print " ".pp($parsed_transaction->{$participant});
          if ($payeur eq $participant) {
            print " (a payé, ".pp($prix).")";
          }
          print "\n";
        } else {
          my $participant_padding = " " x ($max_participant_length - length($participant));
          print "  ".$participant.$participant_padding." ".pp($parsed_transaction->{$participant});
          if ($payeur eq $participant) {
            print " (a payé, ".pp($prix).")";
          }
          print "\n".$phantom;
        }
      }
      if (!$one_participant) {
        print "\n";
      }
    }
  }

  foreach my $personne (@participants) {
    my $d = $depenses{$personne} || 0;
    my $s = $solde{$personne} || 0;
    if ($d) {
      print $personne." a payé ".pp($d);
    } else {
      print $personne." n'a rien payé";
    }
    if ($s) {
      print " et a pour ".pp($d - $s)." de frais au total.\n";
    } else {
      print " et n'a pas eu de frais.\n";
    }
    print $personne." a donc un solde de ".pp($s)."\n";
  }
}

sub compute_equity {
  my %depenses;
  my %frais;
  my %soldes;
  foreach my $transaction (@transactions) {
    my ($payeur, $prix, $total_parts, $split, $parts) = &parse_transaction($transaction);
    $depenses{$payeur} += $prix;

    foreach my $personne (keys(%{$split})) {
      $soldes{$personne} += $split->{$personne};
    }
  }
  foreach my $personne (keys(%soldes)) {
    $frais{$personne} = $depenses{$personne} - $soldes{$personne};
  }

  return (\%depenses, \%frais, \%soldes);
}

sub delete_zeros {
  my ($soldes, @participants) = @_;

  foreach my $participant (@participants) {
    delete $soldes->{$participant} if pp($soldes->{$participant}, 1) == 0;
  }
}

sub compute_reimbursment {
  my ($a, $b, $soldes) = @_;
  my $s_a = $soldes->{$a};
  my $s_b = $soldes->{$b};

  return if (pp($s_a, 1) * pp($s_b, 1) >= 0);
  my $debtor   = pp($s_a, 1) < 0 ? $a : $b;
  my $creditor = pp($s_a, 1) > 0 ? $a : $b;
  my $exchange = (abs($s_a) < abs($s_b)) ? abs($s_a) : abs($s_b);

  my @remboursement = ($debtor, $creditor, $exchange);
  push @remboursements, \@remboursement;
  $soldes->{$creditor} -= $exchange;
  $soldes->{$debtor}   += $exchange;
  delete_zeros($soldes, $a, $b);
}

sub select_exchange_couple {
  my ($soldes) = @_;
  my $bd; # biggest debtor
  my $sc; # smallest creditor

  foreach my $p (keys(%{$soldes})) {
    $bd = $p if $soldes->{$p} < 0 && (!$bd || $soldes->{$p} < $soldes->{$bd});
    $sc = $p if $soldes->{$p} > 0 && (!$sc || $soldes->{$p} < $soldes->{$sc});
  }

  return ($bd, $sc);
}

sub print_remboursements {
  foreach my $remboursement (@remboursements) {
    my ($debtor, $creditor, $exchange) = (@{$remboursement});
    print $debtor." doit ".pp($exchange)." à ".$creditor."\n";
  }
  my $pause = <STDIN>;
}

GLOBALE: while(1) {
  my $action = choose_action();
  switch ($action) {
    case "Ajouter un participant" {
      add_participant();
    }
    case "Ajouter une dépense" {
      add_transaction();
    }
    case "Voir les frais de quelqu'un (dépenses - dettes)" {
      my $personne = select_participant("Annuler");
      if(!$personne) {
        next GLOBALE;
      }
      list_transactions_for_participants(($personne));
      my $pause = <STDIN>;
    }
    case "Voir les frais de tout le monde" {
      list_transactions_for_participants(keys(%participants));
      my $pause = <STDIN>;
    }
    case "Voir une transaction" {
      my ($description, $payeur, $prix, $total_parts, $split, $parts) = select_transaction();
      print $description." (payé par ".$payeur."), ".pp($prix)."\n";
      foreach my $pers (keys(%{$split})) {
        print $pers.", ".$parts->{$pers}." part(s), soit ". pp($split->{$pers});
        if ($pers eq $payeur) {
          print " (".pp($prix)." - ".pp($prix - $split->{$pers}).")";
        }
        print "\n";
      }
    }
    case "Enregistrer" {
      print "Nom de l'événement ?";
      if(!($evenement_def eq "")) {
        print " [".$evenement_def."]";
      }
      print "\n";
      my $evenement = <STDIN>;
      chomp($evenement);
      if($evenement eq "") {
        $evenement = $evenement_def;
      }
      open FILE, ">".$file;
      print FILE $evenement."\n";
      my $key;
      foreach $key (keys(%participants)) {
        print FILE $participants{$key}." ".$key."\n";
      }
      print FILE "\n";
      for(my $i=0;$i<scalar(@transactions);$i++) {
        print FILE $transactions[$i]."\n";
        print FILE $descriptions[$i]."\n";
      }
      print FILE "\n";
      foreach my $remboursement (@remboursements) {
        print FILE join(" ", @{$remboursement})."\n";
      }
      close FILE;
    }
    case "Equilibrage" {
      my ($depenses, $frais, $soldes) = compute_equity();
      @remboursements = ();

      foreach my $personne (keys(%participants)) {
        print $personne." a un solde de ".pp($soldes->{$personne})." (+" . pp($depenses->{$personne}). " / -". pp($frais->{$personne}) . ")\n";
      }
      my $pause = <STDIN>;
      print "Y-a-t-il des remboursements plus aisés ?\n";
      my $ouinon = select_menu("Oui", "Non");

      AISE: while($ouinon eq "Oui") {
        print "Qui ?\n";
        my $personnea = select_participant("Fini");
        if(!$personnea) { last AISE; }
        print "Avec qui ?\n";
        my $personneb = select_participant("Annuler");
        if(!$personneb) { next AISE; }
        compute_reimbursment($personnea, $personneb, $soldes);
      }
      # Une boucle pour détecter si on a des couples qui s'annulent mutuellement
      delete_zeros($soldes, keys(%{$soldes}));
      COUPLE: foreach my $personnea (keys(%participants)) {
        next if(pp($soldes->{$personnea}, 1) == 0);
        foreach my $personneb (keys(%participants)) {
          next if (pp($soldes->{$personneb} + $soldes->{$personnea}, 1) != 0);
          compute_reimbursment($personnea, $personneb, $soldes);
          next COUPLE;
        }
      }
      REMB: while(1) {
        last REMB if(keys(%{$soldes}) == 0);

        my ($biggest_debtor, $smallest_creditor) = select_exchange_couple($soldes);
        compute_reimbursment($biggest_debtor, $smallest_creditor, $soldes);
      }
      print_remboursements();
    }
    case "Afficher les remboursements" {
      print_remboursements();
    }
    case "Sortir" {
      last GLOBALE;
    }
  }
}