diff --git a/hlas.pl b/hlas.pl
new file mode 100755
index 0000000..0eaaa98
--- /dev/null
+++ b/hlas.pl
@@ -0,0 +1,138 @@
+#!/usr/bin/perl
+
+# Copyright TMA 2014
+# Brmlab can use this free of charge as long as TMA is member. For other licensing options contact the author.
+
+use strict;
+use warnings;
+use Data::Dumper;
+
+my $x = 1;
+# pocet volenych papalasu
+my $funkci;
+# prave voleny papalas
+my $voleny_papalas = 0;
+# kandidati na papalase
+my @kand = (undef,);
+# listky pro papalase
+my @listky;
+# stav programu
+my $st;
+# pocet listku a neplatnych
+my ($listky, $neplatne_listky) = (0,0);
+# stavova masina
+my %sm;
+%sm = (
+        start => sub {
+                $funkci = $_;
+                return 'kand';
+        },
+        kand => sub {
+                return 'listky' if /^$/;
+                push @kand,$_;
+                return 'kand';
+        },
+        listky => sub {
+                return 'volby' if /^$/;
+                my $listek = [0,split];
+                # doplnit nuly na konci listku
+                my @tmp = (0,) x scalar @kand;
+                @tmp[0 .. $#$listek] = @$listek;
+                $listek = [ @tmp ];
+                # je listek platny?
+                my $ok = /^[0-9 ]*1[0-9 ]*$/;
+                @tmp = sort {$a<=>$b} (grep {$_>0} @$listek) if $ok;
+                my $i = 0;
+                #{local$"=" ";print "@tmp\n";}
+                while ($ok && scalar @tmp) {
+                        #print "@tmp $i $ok\n";
+                        $ok = (++$i == shift@tmp);
+                }
+                #{local$"=" ";print "$ok/@tmp\n";}
+                #print "$ok listek $_\n";
+                ++$neplatne_listky unless $ok;
+                ++$listky;
+                push @listky, $listek if $ok;
+
+                return 'listky';
+        },
+        volby => sub {
+                die "Nebyl odevzdan ani jeden platny hlasovaci listek." unless $listky - $neplatne_listky;
+                #print Dumper(\@listky);
+                if (++$voleny_papalas > $funkci) {
+                        exit;
+                }
+                my $kolo = 1;
+                my $papalas = undef;
+                my $max;
+                for my $i (1 .. $#kand) {
+                        local$"=" ";
+                        my @kandidat = prepocti($i);
+                        #print "kolo $i, @kandidat\n";
+                }
+                while ($kolo <= $#kand) {
+                        my @kandidat = prepocti($kolo);
+                        #print Dumper(kandidat=>\@kandidat);
+                        ($max,$papalas) = (0, undef);
+                        for my $i (1 .. $#kandidat) {
+                                if ($max < $kandidat[$i]) {
+                                        $max = $kandidat[$i];
+                                        $papalas = $i;
+                                } elsif ($max == $kandidat[$i]) {
+                                        undef $papalas;
+                                }
+                        }
+                        #{local$"=" ";print "kolo $kolo, @kandidat\n";}
+                        last if defined $papalas;
+                        #{local$"=" ";print "$kolo  $papalas $zvolen  @kandidat\n";}
+                        $kolo++;
+                }
+                if (defined $papalas) {
+                        print "Byl zvolen $kand[$papalas] v $kolo. kole volby poctem $max hlasu.\n";
+                        uprav($papalas);
+                        $sm{volby}->();
+                } else {
+                        $papalas = $_;
+                        die "Chybi zaznam o losovani." unless $papalas;
+                        print "Byl vylosovan $kand[$papalas].\n";
+                        uprav($papalas);
+                }
+                return 'volby';
+        },
+);
+$st = $sm{start};
+sub prepocti($) {
+        my ($kolo,) = (@_);
+        my @kandidat = (0,) x $#kand;
+        for my $listek (@listky) {
+                #{no warnings;local$"="| |";print "|@$listek|\n";}
+                for my $i (1 .. $#$listek) {
+                        ++$kandidat[int$i] if $listek->[$i] > 0 && $listek->[int$i]<=$kolo;
+                }
+        }
+        return @kandidat;
+}
+sub uprav($) {
+        my ($papalas,) = (@_);
+        for my $listek (@listky) {
+                #{no warnings;local$"="| |";print "|@$listek|\n";}
+                #{local$"=" ";print "< @$listek\n";}
+                my $poradi = $listek->[$papalas];
+		next if $poradi == 0;
+		for my $i (1 .. $#$listek) {
+			$listek->[$i]-- if $listek->[$i] > $poradi;
+		}
+                $listek->[$papalas]=0;
+                #{local$"=" ";print "> @$listek\n";}
+        }
+}
+
+while (<>) {
+        chomp;
+        $st = $sm{$st->()};
+}
+END {
+        print "Odevzdano celkem $listky hlasovacich listku.\n";
+        my $platne_listky = $listky - $neplatne_listky;
+        print "Z toho $neplatne_listky hlasovacich listku neplatnych a $platne_listky platnych.\n";
+}