Institute of Cryptobureaucracy
founder:	pasky
depends on:
interested:	joe, tutchek, ruza, TMA, stick
software license:	Apache+PHP+Postgres
hardware license:	N/A

brmlab existence involves some mundane adminsitrativa tasks, mainly tracking of membership fees and donations. So far, this is done manually and there result is a lot of laborous work and a lot of chaos.

Therefore, some simple software tool would do us a lot of good. It should:

• Track members database - including personal, payment and access information
  • Can also provide LDAP interface for UNIX auth, automatically flash brmdoor, etc.
• Track payments made to our bank accounts and tie them to the members database
  • We already have small accounting system implemented for our brmBar
• Project our current and expected financial balance so that we know how much we can our incomes expect to be (and compare them to our expenses)
• Keep the “paid until” attribute up-to-date and automatically send notifications and reminders in case payment is due
• Produce reports and donation certificates for tax purposes

• Design and deploy dedicated members database instead of in-wiki membership roster
  • [TODO] Where do we deploy it? brmko? Or somewhere “safe” outside of brmlab?
  • [TODO] SQL schema design; for starters, the information currently in membership roster
  • [TODO] Simple web interface for querying and modifying the database
• Include accounting information in the database
  • [TODO] Extend SQL schema to track incomes from members (or otherwise)
  • [TODO] Gateway Fio e-mail notifications to the database
  • [TODO] Automatic “payment due” reminders
  • [TODO] Automatic donation tax receipt generator
  • [TODO] Simple “project financial balance” tool
  • [not finished] LDAP interface for UNIX authentication
    • slapd partialy configured on data.brm. scheme improvements needed
  • [TODO] Possibly also some expense tracking and some-such

brmbyro-arch.xmind

• Sklad: https://github.com/Harvie/SokoMan

platby.pl

#!/usr/bin/perl
 
# Copyright 2012 TMA
# License: GNU GPL version 2
 
use strict;
use warnings;
use utf8;
 
my $status = 'endmail';
 
my ($fio,$konto,$castka,$VS,$SS,$zprava,$protiucet,$date);
my ($header, $body);
 
my $mul;
 
sub vreset() {
	($header,$body) = ('','');
	($fio,$konto,$castka,$VS,$SS,$zprava,$protiucet,$date) = undef;
}
 
sub process($) {
	$status = $_[0];
	no warnings;
	$date =~ s/ +\d+:\d+:\d+ +[+-]\d{4}$//o;
	$date =~ s/^..., *(\d+) (...|\d+) (\d\d\d\d).*/$3-$2-$1/o;
	$date =~ s/Jan/01/o;
	$date =~ s/Feb/02/o;
	$date =~ s/Mar/03/o;
	$date =~ s/Apr/04/o;
	$date =~ s/May/05/o;
	$date =~ s/Jun/06/o;
	$date =~ s/Jul/07/o;
	$date =~ s/Aug/08/o;
	$date =~ s/Sep/09/o;
	$date =~ s/Oct/10/o;
	$date =~ s/Nov/11/o;
	$date =~ s/Dec/12/o;
	$date =~ s/ /0/o;
	$date =~ s/-(\d)-/-0$1-/o;
	$date =~ s/-(\d)$/-0$1/o;
	print "-- $ARGV $.\n";
	print "insert into ucetni_data (konto, castka, datum, VS, SS, protiucet, zprava, comment) values
	($konto, $castka", commanullq($date),
	commanull($VS), commanull($SS), commanullq($protiucet),
	commanullq($zprava),commanullq($header."\n\n".$body),");\n";
}
 
sub def_or_empty($) { defined$_[0]?$_[0]:'' }
 
sub quot($) {
	my ($x) = @_;
	# ' needs to be doubled
	$x =~ s/'/''/go;
	# replace suspicious characters by .
	$x =~ s{[^][\na-zA-Z0-9 !@#$%^&*()_=+;:"|<>/?,.~`{}'-]}{.}go; # '
	"'$x'"
}
 
sub commanull_($&) {
	my ($x, $q) = (@_);
	#print STDERR "[[$x]]\n";
	no warnings;
	(length $x) ? ", ". $q->($x) : ", NULL"
}
 
sub commanull($) { commanull_($_[0],sub {$_[0]}) }
 
sub commanullq($) { commanull_($_[0],\&quot) }
 
sub decimal($) {
	my ($x) = @_;
	$x =~ y/,/./;
	$x =~ s/ //g;
	$x
}
 
my %action = (
	endmail => sub {
		#print "$status: $_\n";
		/^From / and do {{ $status = 'header'; vreset }}
	},
	header => sub {
		$header .= $_."\n";
		#print "$status: $_\n";
		/^From: automat(?:\@| at )fio\.cz/ and $fio = 1;
		/^$/ and $status = ($fio ? 'body' : 'endmail'); 
		/^Date: (.*)/ and $date = $1;
		#print "$status(",def_or_empty($fio),"): $_\n";
       	},
	body => sub {
		/^From / or $body .= $_."\n";
		#print "$status: $_\n";
		/^P..jem na kont.: (\d+)/ and ($konto, $mul) = ($1,1);
		/^V.daj na kont.: (\d+)/ and ($konto, $mul) = ($1,-1);
		/^..stka: ([0-9 ]+[,.]\d+)?/ and $castka = $mul * decimal($1);
		/^VS: (\d+)/ and $VS = $1;
		/^SS: (\d*)/ and $SS = $1;
		/^Zpr.va p..jemci: (.*)/ and $zprava = $1;
		/^Proti..et: ([0-9\/-]+)/ and $protiucet = $1;
		/_____/ and process('endmail');
		/^From / and (process('header'),vreset);
		#/^P[?ř][?í]jem na kont[?ě]: (\d+)/ and 	$konto = $1;
		#/^[?Č][?á]stka: (\d+)[,.](\d+)?/ and $castka = $1 + $2/100;
		#/^VS: (\d+)/ and $VS = $1;
		#/^SS: (\d*)/ and $SS = $1;
		#/^Zpr[?á]va p[?ř][?í]jemci: (.*)/ and $zprava = $1;
		#/^Proti..et: ([0-9\/-]+)/ and $protiucet = $1;
		#/_____/ and process;
	}
);
 
my ($drop,$create) = (1,1);
my $SEP = ';';
print <<EOF if $drop;
drop table if exists ucetni_data;
EOF
print <<EOF if $create;
CREATE TABLE IF NOT EXISTS ucetni_data (
  `id` int(11) NOT NULL AUTO_INCREMENT,
  `konto` decimal(30,0) NOT NULL,
  `castka` decimal(30,2) NOT NULL,
  `datum` date NOT NULL,
  `vs` int(11) DEFAULT NULL,
  `ss` int(11) DEFAULT NULL,
  `protiucet` varchar(50) COLLATE utf8_unicode_ci DEFAULT NULL,
  `zprava` varchar(200) COLLATE utf8_unicode_ci DEFAULT NULL,
  `comment` varchar(2000) COLLATE utf8_unicode_ci DEFAULT NULL,
  PRIMARY KEY (`id`)
) ENGINE=InnoDB  DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci AUTO_INCREMENT=563 ;
EOF
 
while (<>) {
	chomp;
	$action{$status}->();
}
 
process('') if $status eq 'body';

hlas.pl

#!/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";
}

Priklad pouziti:

2
TMA
Mrkva

0 1
1 2
2 1

0

(Pred posledni nulu je mozno vlozit radek s cislem vylosovaneho kandidata, je-li treba losovat.)