#!/usr/bin/perl # Copyright 2009-2010, Michael Allan. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Votorola Software"), to deal in the Votorola Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicence, and/or sell copies of the Votorola Software, and to permit persons to whom the Votorola Software is furnished to do so, subject to the following conditions: The preceding copyright notice and this permission notice shall be included in all copies or substantial portions of the Votorola Software. THE VOTOROLA SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE VOTOROLA SOFTWARE OR THE USE OR OTHER DEALINGS IN THE VOTOROLA SOFTWARE. use strict; use warnings; =pod =head1 NAME vosim-alex - output commands for a simulated group of alphanumeric voters =head1 SYNOPSIS vosim-alex CHAR-PATTERN CHAR-PATTERN* vosim-alex CHAR-PATTERN CHAR-PATTERN* | nice voter =cut # my $poll = 'G/p/sandbox'; my $poll = 'Sys/p/sandbox'; # for testing a new vote-server, per system manual # my $poll = 'Tor/p/m'; sub simulate() { vote(); # unvote(); } =pod =head1 DESCRIPTION Outputs a list of commands for a simulated group of voters with alphanumeric names. The group is defined by a sequence of regular-expression character patterns in the range a-z and 0-9 that are passed in as arguments. For example: $ vosim-alex ab 1-3 test-a1@reluk.ca Sys/p/sandbox vote test-a@reluk.ca test-a2@reluk.ca Sys/p/sandbox vote test-a@reluk.ca test-a3@reluk.ca Sys/p/sandbox vote test-a@reluk.ca test-b1@reluk.ca Sys/p/sandbox vote test-b@reluk.ca test-b2@reluk.ca Sys/p/sandbox vote test-b@reluk.ca test-b3@reluk.ca Sys/p/sandbox vote test-b@reluk.ca The output is a batch of voting commands suitable for piping to the 'voter' shell. For example: $ vosim-alex ab 1-3 | voter The name pattern in the example above is the regular expression [ab][1-3]. It matches six simulated voters. Each simulated voter casts her vote for the candidate whose name exactly matches the voter's own, less the final character. So three of the voters (a1, a2, a3) vote for candidate (a), and the other three (b1, b2, b3) vote for (b): a1 a2 a3 b1 b2 b3 \ | / \ | / \ | / \ | / \ | / \ | / a b By repeatedly calling vosim-alex with longer names, a delegate structure is built up one layer at a time. For example, "vosim-alex b 1-3 yz" results in: b1y b1z b2y b2z b3y b3z \ | \ / | / \ | | | / \| | |/ a1 a2 a3 b1 b2 b3 \ | / \ | / \ | / \ | / \ | / \ | / a b In this case, the voters are (b1y, b1z, b2y, b2z, b3y, b3z). Their votes flow to delegates (b1, b2, b3), and thence to end-candidate (b). To do the same for both end-candidates (a and b), use either two separate commands, or the single command "vosim-alex ab 1-3 yz". For a larger simulation, especially when run on an active server, it's a good idea to give the voter shell a low priority. For example: $ vosim-alex a-b a-g 0-9 a-k a-z | nice voter =head1 CAVEATS Output from the voter shell is verbose, both to stdout and the log. There is currently no convenient way to silence it. When running a large simulation therefore, you may want to reduce the logging level to WARNING in your Java logging.properties, in order to gain speed. For example: votorola.a.line.VOTer.level = WARNING # # Eliminate log churn, in order to gain speed when running a # large simulation through the voter shell. =cut my @chars = qw( 0 1 2 3 4 5 6 7 8 9 a b c d e f g h i j k l m n o p q r s t u v w x y z ); sub simulate_branch( $ ); our $voter; { use Pod::Usage qw( pod2usage ); scalar @ARGV or pod2usage( -verbose => 1 ); # and exits simulate_branch( '' ); } # ---------------------------------------------------------------------------------------- sub chopped( $ ) { my $value = shift; chop $value; return $value; } sub simulate_branch( $ ) { my $candidate = shift; my $tier = length $candidate; my $is_top_tier = $tier == scalar @ARGV - 1; my $pattern = $ARGV[$tier]; for my $char( @chars ) { if( $char !~ /[$pattern]/ ) { next; } $voter = $candidate . $char; if( $is_top_tier ) { simulate(); } else { simulate_branch( $voter ); } } } sub unvote() { my $voterEmail = voterEmail(); print( "$voterEmail $poll unvote\n" ); } sub vote() { my $candidate = chopped( $voter ); $candidate or return; my $voterEmail = voterEmail(); my $candidateEmail = voterEmail( $candidate); print( "$voterEmail $poll vote $candidateEmail\n" ); } sub voterEmail( ;$ ) { my $v = shift; defined $v or $v = $voter; return 'test-' . $v . '@reluk.ca'; }