Lai palaistu komandrindā rakstam echo "Vārds Otrs Trešais Ceturtais:Otrais Ceturtais" | ./giftfriend.pl

giftfriend.pl

#!/usr/bin/perl
use List::Util qw(shuffle);

my $input = <STDIN>;
my @arr = split(':', $input);
my @names = split(' ', $arr[0]);
my @ep = split (',', $arr[1]);
my @exclpairs;
foreach (@ep) {
  my @asd = split(' ', $_);
  push @exclpairs, \@asd;
}

my %names_hash;
my $has_error = 0;
foreach (@names) {
  $names_hash{$_}++;
  if ( $names_hash{$_} > 1 ) {
    $has_error = 1;
    break;
  } 
}

if ( $has_error ) {
  die "There are duplicate names in the list";
}

@rec = @names;

$ret = match_pairs ( \@names, \@rec, \@exclpairs);

unless ( $$ret[0]{giver} ) {
  die "Could not match any pairs, your exclusions list probably is too strict";
}

foreach ( @{$ret} ) {
  print $_->{giver}. " dāvina dāvanu " . $_->{receiver}. "\n";
}

sub match_pairs {
  my ($givRef, $recRef, $exclRef) = @_;
  @givers = shuffle @{$givRef};
  @receivers = shuffle @{$recRef};
  my $arr_len = @givers;
  if ( $arr_len == 1 ) {
    if ( $givers[0] ne $receivers[0] && valid_pair($givers[0], $receivers[0], $exclRef) ) {
      return [ {'giver' => $givers[0], 'receiver' => $receivers[0]} ];
    }
    return [ {} ]; 
  } 
  my $i = 0;
  my $giver = shift @givers;
  do {
    my $receiver = shift @receivers;
    if ( $giver ne $receiver && valid_pair($giver, $receiver, $exclRef) ) {
      $sub_ret = match_pairs(\@givers, \@receivers, $exclRef);
      if ( $$sub_ret[0]{giver} ) {
        push( @$sub_ret, { 'giver' => $giver, 'receiver' => $receiver });
        return $sub_ret;
      }
    }
    push ( @receivers, $receiver );
    $i++; 
  } while ( $i < $arr_len ); 
  push @givers, $giver;
  return [ {} ];
}

sub valid_pair {
  my ($giver, $receiver, $exclRef) = @_;
  foreach ( @{$exclRef} ) {
   if ( ($giver eq $_->[0]) && ($receiver eq $_->[1]) ) { return 0; }
  }
  return 1;
}