Table of Contents

BrmBüro

Current Solution to this project is discussed in BrmLib
Institute of Cryptobureaucracy
administrativa.jpg
founder: pasky
depends on:
interested: joe,
tutchek,
ruza,
TMA,
stick
software license: Apache+PHP+Postgres
hardware license: N/A

~~META: status = active &relation firstimage = :project:administrativa.jpg ~~

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:

Status and Roadmap

General Architectural Overview

(i) Notwithstanding the provisions of subsection 3 of Section A of Clause 214 of the Administrative Procedures (Scotland) Act 1978, it has been agreed that, insofar as the implementation of the statutory provisions is concerned, the resolution of anomalies and uncertainties between responsible departments shall fall within the purview of the Minister for Administrative Affairs.

brmbyro-arch.xmind

SW

Evidence plateb v bankovnictvi

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';

Hlasování na VH

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.)