git.defcon.no Git - test-repo/blob - lotto.pl

   1 #!/usr/bin/perl -w
   2 # A quick-hack solution for checking coupons for the Norwegian LOTTO.
   3 # This code is not hapered by copyright, it was released into
   4 # the public domain by Jon Langseth (jon dot langseth at lilug dot no) in 2009.
   5 #
   6 # Sample result of execution is screenshotted at
   7 #     http://defcon.no/files/lotto.pl.png
   8 #
   9 # File formats;
  10 # Common for both files:
  11 #   Numbers below 10 may be zero-padded,
  12 #   Whitespace is matched and filtered using \s+, so any number of
  13 #   non-line-terminating whitespace can be used to separate numbers.
  14 #
  15 # File format, results, remove leading "# ". File consists of _two_ lines:
  16 #
  17 # 1 5 9 16 25 26 31
  18 # 4 32 34
  19 #
  20 # The fist line is the main result numbers, the second is the extra numbers.
  21 #
  22 # File format, coupon(s), remove leading "# ". The file consists of coupon
  23 # rows, one row per line, numbers separated by whitespace, seven numbers to a
  24 # row,
  25 #
  26 #  8 10 19 20 21 28 30
  27 #  3  8 15 16 18 19 33
  28 #  7 11 21 22 23 28 34
  29 #  6 16 18 25 26 31 32
  30 #  2  3 11 16 21 22 27
  31 #  1  8 12 16 21 22 23
  32 #  2  9 16 21 23 26 34
  33 #  2  3  4  7 10 27 30
  34 # 11 16 19 20 21 29 32
  35 #  5 16 22 24 28 30 34
  36 #
  37
  38 use strict;
  39
  40 sub errr {
  41         print "Syntax: " . $0 . " kupong.txt resultat.txt\n";
  42         print "  kupong.txt inneholder lottokupong med siffere \n";
  43         print "  skilt av mellom, en rekke per linje, \n";
  44         print "  resultat.txt inneholder en linje med resultatets\n";
  45         print "  hovedtall, og en linje med tilleggstall\n";
  46         print "  # på start av linje er kommentar i begge filer.\n";
  47         exit(1);
  48 }
  49
  50 # Check that two arguments are passed.
  51 if ( $#ARGV < 1 ) {
  52         &errr;
  53 }
  54 my $coupon = $ARGV[0];
  55 my $result = $ARGV[1];
  56 my $tmp;
  57 my $count = 0;
  58 my @mains;
  59 my @extras;
  60
  61 # Check for the existance of the files given as arguments.
  62 # I do not check for readable, as this will be handled by a failure to open later :P
  63 &errr if ( not -f $coupon );
  64 &errr if ( not -f $result );
  65
  66 # Read the results file
  67 open( IN, "<" . $result ) or &errr;
  68
  69 # First, the main numbers. The norwegian standard LOTTO has seven main numbers.
  70 # Note that I do not actually check that the array has seven, only seven, entries..
  71 # Yeah, I could have done a sub of the text-sanitation, as it is used three times.
  72 # But, as a do not like to fiddle with array-referencing, inline is the simplest.
  73 $tmp = <IN>;
  74 chomp $tmp;
  75 if ( $tmp =~ m/\d{1,2}\s+\d{1,2}\s+\d{1,2}\s+\d{1,2}\s+\d{1,2}\s+\d{1,2}\s+\d{1,2}/ ) {
  76         $tmp =~ s/^\s+//g;
  77         $tmp =~ s/\s+/:/g;
  78         $tmp =~ s/0(\d)/$1/g;
  79         @mains = split ( ":", $tmp);
  80 } else {
  81         &errr;
  82 }
  83 # Next line of the result file contains the extra numbers (bonus numbers/additionals)
  84 # In the Norwegian LOTTO there are three such numbers.
  85 # Note that I do not actually check that the array has three, only three, entries..
  86 $tmp = <IN>;
  87 chomp $tmp;
  88 if ( $tmp =~ m/\d{1,2}\s+\d{1,2}\s+\d{1,2}/ ) {
  89         $tmp =~ s/^\s+//g;
  90         $tmp =~ s/\s+/:/g;
  91         $tmp =~ s/0(\d)/$1/g;
  92         @extras = split ( ":", $tmp);
  93 } else {
  94         &errr;
  95 }
  96 close(IN);
  97
  98 open( IN, "<" . $coupon ) or &errr;
  99
 100 print "\n  .-------------------------+---------+-------------.\n";
 101
 102 # Read teh coupon file, line by line.
 103 while (<IN>) {
 104         next if m/^#/;
 105         # The Norwegian LOTTO uses seven numbers per sequence, ten sequences to a row.
 106         # I do not check for additional numbers above seven, and yes, that is a weakness.
 107         # I hope the user is sane enough to not feed stupidness...
 108         next if not  m/\d{1,2}\s+\d{1,2}\s+\d{1,2}\s+\d{1,2}\s+\d{1,2}\s+\d{1,2}\s+\d{1,2}/;
 109
 110         # Again, the text-sanitation. This is the last time.
 111         chomp $_;
 112         $_ =~ s/^\s+//g;
 113         $_ =~ s/\s+/:/g;
 114         $_ =~ s/0(\d)/$1/g;
 115         my @row = split ( ":");
 116
 117         my $mres = 0;
 118         my $mext = 0;
 119         # Ten rows to a coupon in the Norwegian LOTTO....
 120         if ( $count > 9 ) {
 121                 print "  |-------------------------+---------+-------------|\n";
 122                 $count = 0;
 123         }
 124         print "  |  ";
 125         foreach my $num ( @row ) {
 126                 # Dirty, slow, but good enough, and a simple solution:
 127                 # Step through all the main numbers, checking for a match,
 128                 # and set a color + increment the main result or extras result
 129                 # accordingly. The "last" statements may speed things a litte :P
 130                 # This is not a robust mechanism, but as long as we are given
 131                 # other data than garbage as input, we should be safe..
 132                 foreach my $m ( @mains) {
 133                         if ( $num == $m ) { print "\e[31m"; $mres++; last; }
 134                 }
 135                 foreach my $m ( @extras) {
 136                         if ( $num == $m ) { print "\e[34m"; $mext++; last; }
 137                 }
 138
 139                 # Prettyprint the current number..
 140                 if ( $num < 10 ) { print "0"; }
 141                 print $num . " \e[0m";
 142
 143         }
 144         print "  | \e[33m $mres + $mext \e[0m | ";
 145
 146         # This is the price weighting of the norwegian LOTTO.
 147         # $mres is the main result, $mext is the extras result.
 148         # 7 main numbers..
 149         if    ( $mres == 7 )                       { print "\e[1m 1. premie! |"; }
 150         # 6 main numbers, plus one extra number
 151         elsif ( ( $mres == 6 ) && ( $mext  > 0 ) ) { print "\e[1m 2. premie! |"; }
 152         # 6 main numbers, no extras
 153         elsif ( ( $mres == 6 ) && ( $mext == 0 ) ) { print "\e[1m 3. premie  |"; }
 154         # 5 main numbers, no extras
 155         elsif ( ( $mres == 5 ) && ( $mext == 0 ) ) { print "\e[0m 4. premie  |"; }
 156         # 4 main numbers, plus one or more extra numbers
 157         elsif ( ( $mres == 4 ) && ( $mext  > 0 ) ) { print "\e[0m 5. premie  |"; }
 158         # less than four correct numbers, no price....
 159         else                                       { print      "            |"; }
 160
 161         print "\e[0m\n";
 162         $count++;
 163 }
 164 close(IN);
 165 print "  '-------------------------+---------+-------------'\n\n";