Codice sorgente (parte 2: subroutine)

 # ### Subroutine ###

 # Policy 1: assegna al giocatore le palline richieste, se disponibili
 sub policy1 {
     my ($pallineric) = @_;
     ($palline >= $pallineric) ? return $pallineric : return 0;
 }

 # Policy 2: se c'e` ancora almeno il 20% delle palline disponibili, assegna
 # quelle richieste; se ce ne sono meno, ne assegna al massimo il 2.5%
 # ogni volta
 sub policy2 {
     my ($pallineric) = @_;
     if ($palline < int($pallinetot/5)) {
         if ($pallineric > int($pallinetot/40)) {
             ($palline >= int($pallinetot/40)) ? return int($pallinetot/40) : return 0;
         } else {
             ($palline >= $pallineric) ? return $pallineric : return 0;
         }
     } else {
         ($palline >= $pallineric) ? return $pallineric : return 0;
     }
 }

 # Richiesta palline
 sub chiedi_palline {
     my ($nome, $pallineric) = @_;

     # Ora $palline E<egrave> tutta nostra
     lock ($palline);

     # Assegna le palline secondo la policy desiderata
     my $pallineass = &policy2($pallineric);

     if ($pallineass > 0) {
         $palline -= $pallineass;
         print "$pallineass palline (su $pallineric richieste) concesse a $nome (totale $palline)\n";
         return $pallineass;
     } else {
         print "$pallineric palline rifiutate a $nome (totale $palline)\n";
         return 0;
     }
 }

 # Restituzione palline
 sub restituisci_palline {
     my ($nome, $pallineric) = @_;

     lock ($palline);
     $palline += $pallineric;
     print "$pallineric palline restituite da $nome (totale $palline)\n";
 }

 # Giocatore
 sub giocatore {
     my ($nome) = @_;

     # Il giocatore gioca e rigioca di continuo
     while (1) {

         # Richiedi un numero di palline tra 1 e $pallinemaxe
         my $pallineric = int(rand($pallinemaxe))+1;

         my $pallineass;

         # Chiedi le palline
         while (($pallineass = &chiedi_palline($nome, $pallineric)) == 0)  {
             sleep $tempobar;
         }
         sleep int(rand($tempomax))+1;
         &restituisci_palline($nome, $pallineass);
         sleep $tempoidl;

     }
 }