--- /dev/null
+#!/usr/bin/perl -w
+# A quick-hack solution for checking coupons for the Norwegian LOTTO.
+# This code is not hapered by copyright, it was released into
+# the public domain by Jon Langseth (jon dot langseth at lilug dot no) in 2009.
+#
+# Sample result of execution is screenshotted at
+# http://defcon.no/files/lotto.pl.png
+#
+# File formats;
+# Common for both files:
+# Numbers below 10 may be zero-padded,
+# Whitespace is matched and filtered using \s+, so any number of
+# non-line-terminating whitespace can be used to separate numbers.
+#
+# File format, results, remove leading "# ". File consists of _two_ lines:
+#
+# 1 5 9 16 25 26 31
+# 4 32 34
+#
+# The fist line is the main result numbers, the second is the extra numbers.
+#
+# File format, coupon(s), remove leading "# ". The file consists of coupon
+# rows, one row per line, numbers separated by whitespace, seven numbers to a
+# row,
+#
+# 8 10 19 20 21 28 30
+# 3 8 15 16 18 19 33
+# 7 11 21 22 23 28 34
+# 6 16 18 25 26 31 32
+# 2 3 11 16 21 22 27
+# 1 8 12 16 21 22 23
+# 2 9 16 21 23 26 34
+# 2 3 4 7 10 27 30
+# 11 16 19 20 21 29 32
+# 5 16 22 24 28 30 34
+#
+
+use strict;
+
+sub errr {
+ print "Syntax: " . $0 . " kupong.txt resultat.txt\n";
+ print " kupong.txt inneholder lottokupong med siffere \n";
+ print " skilt av mellom, en rekke per linje, \n";
+ print " resultat.txt inneholder en linje med resultatets\n";
+ print " hovedtall, og en linje med tilleggstall\n";
+ print " # på start av linje er kommentar i begge filer.\n";
+ exit(1);
+}
+
+# Check that two arguments are passed.
+if ( $#ARGV < 1 ) {
+ &errr;
+}
+my $coupon = $ARGV[0];
+my $result = $ARGV[1];
+my $tmp;
+my $count = 0;
+my @mains;
+my @extras;
+
+# Check for the existance of the files given as arguments.
+# I do not check for readable, as this will be handled by a failure to open later :P
+&errr if ( not -f $coupon );
+&errr if ( not -f $result );
+
+# Read the results file
+open( IN, "<" . $result ) or &errr;
+
+# First, the main numbers. The norwegian standard LOTTO has seven main numbers.
+# Note that I do not actually check that the array has seven, only seven, entries..
+# Yeah, I could have done a sub of the text-sanitation, as it is used three times.
+# But, as a do not like to fiddle with array-referencing, inline is the simplest.
+$tmp = <IN>;
+chomp $tmp;
+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}/ ) {
+ $tmp =~ s/^\s+//g;
+ $tmp =~ s/\s+/:/g;
+ $tmp =~ s/0(\d)/$1/g;
+ @mains = split ( ":", $tmp);
+} else {
+ &errr;
+}
+# Next line of the result file contains the extra numbers (bonus numbers/additionals)
+# In the Norwegian LOTTO there are three such numbers.
+# Note that I do not actually check that the array has three, only three, entries..
+$tmp = <IN>;
+chomp $tmp;
+if ( $tmp =~ m/\d{1,2}\s+\d{1,2}\s+\d{1,2}/ ) {
+ $tmp =~ s/^\s+//g;
+ $tmp =~ s/\s+/:/g;
+ $tmp =~ s/0(\d)/$1/g;
+ @extras = split ( ":", $tmp);
+} else {
+ &errr;
+}
+close(IN);
+
+open( IN, "<" . $coupon ) or &errr;
+
+print "\n .-------------------------+---------+-------------.\n";
+
+# Read teh coupon file, line by line.
+while (<IN>) {
+ next if m/^#/;
+ # The Norwegian LOTTO uses seven numbers per sequence, ten sequences to a row.
+ # I do not check for additional numbers above seven, and yes, that is a weakness.
+ # I hope the user is sane enough to not feed stupidness...
+ 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}/;
+
+ # Again, the text-sanitation. This is the last time.
+ chomp $_;
+ $_ =~ s/^\s+//g;
+ $_ =~ s/\s+/:/g;
+ $_ =~ s/0(\d)/$1/g;
+ my @row = split ( ":");
+
+ my $mres = 0;
+ my $mext = 0;
+ # Ten rows to a coupon in the Norwegian LOTTO....
+ if ( $count > 9 ) {
+ print " |-------------------------+---------+-------------|\n";
+ $count = 0;
+ }
+ print " | ";
+ foreach my $num ( @row ) {
+ # Dirty, slow, but good enough, and a simple solution:
+ # Step through all the main numbers, checking for a match,
+ # and set a color + increment the main result or extras result
+ # accordingly. The "last" statements may speed things a litte :P
+ # This is not a robust mechanism, but as long as we are given
+ # other data than garbage as input, we should be safe..
+ foreach my $m ( @mains) {
+ if ( $num == $m ) { print "\e[31m"; $mres++; last; }
+ }
+ foreach my $m ( @extras) {
+ if ( $num == $m ) { print "\e[34m"; $mext++; last; }
+ }
+
+ # Prettyprint the current number..
+ if ( $num < 10 ) { print "0"; }
+ print $num . " \e[0m";
+
+ }
+ print " | \e[33m $mres + $mext \e[0m | ";
+
+ # This is the price weighting of the norwegian LOTTO.
+ # $mres is the main result, $mext is the extras result.
+ # 7 main numbers..
+ if ( $mres == 7 ) { print "\e[1m 1. premie! |"; }
+ # 6 main numbers, plus one extra number
+ elsif ( ( $mres == 6 ) && ( $mext > 0 ) ) { print "\e[1m 2. premie! |"; }
+ # 6 main numbers, no extras
+ elsif ( ( $mres == 6 ) && ( $mext == 0 ) ) { print "\e[1m 3. premie |"; }
+ # 5 main numbers, no extras
+ elsif ( ( $mres == 5 ) && ( $mext == 0 ) ) { print "\e[0m 4. premie |"; }
+ # 4 main numbers, plus one or more extra numbers
+ elsif ( ( $mres == 4 ) && ( $mext > 0 ) ) { print "\e[0m 5. premie |"; }
+ # less than four correct numbers, no price....
+ else { print " |"; }
+
+ print "\e[0m\n";
+ $count++;
+}
+close(IN);
+print " '-------------------------+---------+-------------'\n\n";
git.defcon.no / test-repo / commitdiff