Games::Perlwar - A Perl variant of the classic Corewar game

Games-Perlwar documentation Contained in the Games-Perlwar distribution.

Index

Code Index:

NAME

Top

Games::Perlwar - A Perl variant of the classic Corewar game

DESCRIPTION

Top

For the rules of Perlwar, please refers to the Games::Perlwar::Rules manpage.

HOW TO START AND MANAGE A PW GAME (THE SHORT AND SKINNY)

Top

Use the script pwcreate to create a new game. 

    $ pwcreate [ <game_directory> ]

pwcreate will create game_directory and populate it with the everything the new game will need. If game_directory is not provided, pwcreate will create a sub-directory called 'game'.

Once the game is created, the script pwupload can be used to submit the agents to be introduced into the Array:

    $ pwupload <game_directory> <player>

pwupload takes two arguments: the game directory and the name of the agent's owner. The script then reads the script from STDIN. E.g.:

    $ pwupload /home/perlwar/myWar yanick < borg.pl

Finally, pwround executes an iteration of the game:

    $ pwround <game_directory>

pwround isn't interactive and can easily be called from a cron job.

BUGS AND LIMITATIONS

Top

pwupload currently only works for local games. It will be soonishly extended to allow submissions to network games.

CONTACTS

Top

For bug reports, please use the CPAN request tracker on http://rt.cpan.org/NoAuth/Bugs.html?Dist=Games-Perlwar.

The Games::Perlwar git repository can be found at http://babyl.dyndns.org/git/perlwar.git.

AUTHOR

Top

Yanick Champoux (yanick@perl.org)

LICENCE AND COPYRIGHT

Top

Copyright (c) 2005, 2006 Yanick Champoux (yanick@cpan.org). All rights reserved.

This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See perldoc perlartistic.

This program is distributed in the hope that it will be useful (or at least entertaining), but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

Games-Perlwar documentation Contained in the Games-Perlwar distribution. 
package Games::Perlwar;

our $VERSION = '0.03';

use strict;
use warnings;
use utf8;

use Safe;
use XML::Simple;
use XML::Writer;
use XML::LibXML;
use IO::File;

use Games::Perlwar::Array;
use Games::Perlwar::Cell;
use Games::Perlwar::AgentEval;

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub new {
    my( $class, $dir ) = @_;
    my $self = { dir => $dir || '.', interactive => 1 };
    chdir $self->{dir};
    bless $self, $class;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub clear_log {
	my $self = shift;
	$self->{log} = ();
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub load_players_from_config {
    my( $self, $config ) = @_;

    my %player;
    for my $player ( $config->findnodes( '/configuration/players/player' ) ) {
        my $name   = $player->findvalue( '@name' );
        my $color  = $player->findvalue( '@color' );
        my $status = $player->findvalue( '@status' ) || 'OK' ;

        $player{ $name } = { color => $color, status => $status };
    }

    return %player;
}

sub load_players_from_iteration {
    my( $self, $iter ) = @_;

    my %player;
    for my $player ( $iter->findnodes( '/iteration/summary/player' ) ) {
        my $name   = $player->findvalue( '@name' );
        my $color  = $player->findvalue( '@color' );
        my $status = $player->findvalue( '@status' ) || 'OK' ;

        $player{ $name } = { color => $color, status => $status };
    }

    return %player;
}

sub load_players_adhoc {
    my( $self, $config ) = @_;

    my $community_file = $config->findvalue(
                            '/configuration/players/@community' );
    my @players = XML::LibXML->new
                             ->parse_file( $community_file )
                             ->findnodes( '//player' );

    @players = grep { -e 'mobil/'.$_->findvalue('@name') } @players;

    my %player;
    for my $player ( @players ) {
        my $name   = $player->findvalue( '@name' );
        my $color  = $player->findvalue( '@color' );
        my $status = 'OK' ;

        $player{ $name } = { color => $color, status => $status };
    }

    return %player;
}

sub load {
    my ( $self, $iteration, $replay ) = @_;

    # if it's a replay, we load from the current iteration,
    # then get the newcomers from the next iteration.
    # if not, we get the newcomers from mobil station
    # the loading of newcomers must happen in 
    # run_iteration

	
	print "loading configuration.. \n";

    my $parser = XML::LibXML->new;

    my $config = $parser->parse_file( 'configuration.xml' );

    $self->{replay} = $replay;

    my $filename;
    if ( defined $iteration ) {
        $filename = sprintf( "round_%05d.xml", $iteration );
        die "can't load iteration $iteration\n" 
            unless -e $filename;
    } 
    else {
        $filename = 'round_current.xml';
    }
    my $current_iteration = $parser->parse_file( $filename );

	$self->{round} = $current_iteration->findvalue( '/iteration/@nbr' );
	print "loading iteration $self->{round}\n";

    $self->{conf}{gameLength} = 
        $config->findvalue( '/configuration/gameLength/text()' );
    $self->{gameVariant} = 
        $config->findvalue( '/configuration/gameVariant/text()' );
    $self->{conf}{agentMaxSize} = 
        $config->findvalue( '/configuration/agentMaxSize/text()' );

    $self->{conf}{theArraySize} = 
        $config->findvalue( '/configuration/theArraySize/text()' );
	$self->{theArray} = Games::Perlwar::Array->new({ 
                            size => $self->{conf}{theArraySize} });
    $self->{theArray}->load_from_xml( $current_iteration );

    if ( $self->{round} == 0 ) {
        
        $self->{conf}{player} = { 
            $config->findvalue( '//players/@list' ) eq 'predefined' 
                ?  $self->load_players_from_config( $config ) 
                :  $self->load_players_adhoc( $config )
        };
    }
    else {
        $self->{conf}{player} = { $self->load_players_from_iteration(
                                                    $current_iteration ) };
    }
       
    $self->set_game_status( 
        $current_iteration->findvalue( '/iteration/summary/status' ) 
            || 'ongoing' );
}   

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub visit_mobil_station {
    my $self = shift;

    $self->{newcomers} = [];
    chdir 'mobil';
        
    opendir my $dir, '.' or die "couldn't open dir mobil: $!\n";
    my @files = sort { -M $b <=> -M $a } 
                grep { exists $self->{conf}{player}{$_} } 
                     readdir $dir;
    closedir $dir;

    my @newcomers;
    for my $player ( @files ) {
        my $date = localtime( $^T - (-M $player)*24*60*60 );
		
        my $fh;
        my $code;
        {
            undef $/;
            open $fh, $player or die;
            $code = <$fh>;
            close $fh;
        }

        unlink $player or $self->log( "ERROR: $!" );
    
        push @newcomers, [ $player, $date, $code  ];
    }

    chdir '..';

    return @newcomers;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub get_game_status {
    return $_[0]->{conf}{gameStatus};
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub set_game_status {
    return $_[0]->{conf}{gameStatus} = $_[1];
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub play_round
{
	my $self = shift;
	
	# check if the game is over (because a player won)
	if( $self->get_game_status eq 'over' ) {
		print "game is already over, exiting\n";
		return;
	}

    $self->{round}++;

	$self->{log} = [];
	$self->log( localtime() . " : running round ".$self->{round} );
	
	# import newcomers
	$self->log( "train arriving from Station Mobil.." );
	$self->introduce_newcomers;
	
	# check if players are eliminated
	$self->checkForEliminatedPlayers;
	
	# run each slot
	$self->log( "running the Array.." );
    $self->runSlot( $_ ) for 0..$self->{conf}{theArraySize}-1;

    # end of round checks
    $self->{theArray}->reset_operational;

	# check for victory
    $self->agent_census;

    my @survivors;
    for my $p ( keys %{$self->{conf}{player}} ) {
        if ( $self->{conf}{player}{$p}{agents} ) {
            push @survivors, $p;
        }
        else {
            $self->{conf}{player}{$p}{status} = 'EOT';
        }
    }

    if ( @survivors > 1 ) {
        print scalar( @survivors ), 
            " players still have agents on the field\n";
    } else {
        print @survivors ? "only $survivors[0] left!\n"
                        : "no survivor!\n";
        # TODO update the config w/ victory
        $self->set_game_status( 'over' );
    }

	# check if the game is over (because round > game length)
    $self->endtime_reached if $self->{round} >= $self->{conf}{gameLength};

    $self->save;
    delete $self->{newcomers};
    delete $self->{old_iteration};
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub endtime_reached {
    my $self = shift;

    print "number of rounds limit reached, game is over\n";
    $self->set_game_status( 'over' );

    my $player = $self->{conf}{player};

    my %census = $self->agent_census;

    my @k = reverse sort { $census{$a} <=> $census{$b} } 
                    grep { $player->{status} == 'OK' } keys %$player;

    return unless @k;

    $player->{ shift @k }{status} = 'w1nn3r';
    $player->{$_}{status} = 'EOT' for @k;

    return;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub save
{
	my $self = shift;
	
	print "saving round $self->{round}..\n";
	
	#$self->saveConfiguration;
	
	#XMLout( $self->{conf}, OutputFile => "configuration.xml", RootName => 'configuration' );
	

	my $output = new IO::File(">round_current.xml");
	my $writer = new XML::Writer(OUTPUT => $output);

	$writer->startTag( "iteration", nbr => $self->{round} );

    $writer->startTag( 'summary' );
    $writer->dataElement( 'status' =>  $self->get_game_status ); 

    my %census = $self->agent_census;

    for my $p ( keys %{$self->{conf}{player} } ) {
        $writer->emptyTag( 'player', 
            name   => $p,
            status => $self->{conf}{player}{$p}{status},
            color  => $self->{conf}{player}{$p}{color},
            agents => $census{ $p },
        );
    }

    $writer->endTag( 'summary' );
	
	if( $self->{newcomers} )
	{
		$writer->startTag( 'newcomers' );
		
		for( @{$self->{newcomers}} )
		{
			my @x = @$_;
			$writer->dataElement( 'newcomer', $x[2], player => $x[0], time => $x[1] );
		}
		$writer->endTag;
	}
	
	
	if( $self->{log} )
	{
  		$writer->startTag( 'log' );
  		$writer->dataElement( 'entry', $_ ) for @{$self->{log}};
  		$writer->endTag;
	}

    $self->{theArray}->save_as_xml( $writer );

	$writer->endTag;
	$writer->end();

	$output->close();

	open my $current_file, "round_current.xml" or die;
	open my $archive, sprintf( ">round_%05d.xml", $self->{round} ) or die "$!";
	print $archive $_ while <$current_file>;
	close $current_file;
	close $archive;
}

##########################################################################

sub saveConfiguration
{
    die "obsolete\n";
	my %conf = @_ == 1 ? %{$_[0]->{conf}} : @_;
	
	my $output = new IO::File(">configuration.xml");
	my $writer = new XML::Writer(OUTPUT => $output, NEWLINES => 1);

	$writer->startTag( 'configuration' );
	$writer->dataElement( 'title', $conf{title} );
	$writer->dataElement( 'gameStatus', $conf{gameStatus} );
	$writer->dataElement( 'gameLength', $conf{gameLength} );
	$writer->dataElement( 'theArraySize', $conf{theArraySize} );
	$writer->dataElement( 'snippetMaxLength', $conf{snippetMaxLength} );
	
	$writer->dataElement( 'currentIteration', $conf{currentIteration} );
	if( $conf{mamboDecrement} )
	{
		$writer->dataElement( 'mamboDecrement', $conf{mamboDecrement} );
	}
	$writer->dataElement( 'note', ref $conf{note} ? %{$conf{note}} 
                                                  : $conf{note}   );
	
	foreach( keys %{$conf{player}} )
	{
		$writer->dataElement( 'player', $_, color => $conf{player}{$_}{color}, 
			password => $conf{player}{$_}{password}, status => $conf{player}{$_}{status} );
	}
	
	$writer->endTag;
	$writer->end;
	$output->close;
}

##########################################################################

sub checkForEliminatedPlayers
{
	my $self = shift;
	
	no warnings 'uninitialized';
	
	$self->log( "checking for eliminated players.." );
	
	my %score = $self->{theArray}->census;
	
	for my $player ( keys %{ $self->{conf}{player} } )
	{
		next if $self->{conf}{player}{$player}{status} eq 'EOT';
		unless( $score{ $player }  )
		{
			$self->log( "\tplayer $player lost all agents, eliminated" );
			$self->{conf}{player}{$player}{status} = 'EOT';	
		}
	}
	
}

sub get_iteration_newcomers {
    my( $self, $iteration ) = @_;

    my $iter = XML::LibXML->new->parse_file(
        sprintf( "round_%05d.xml", $iteration )
    );

    my @newcomers;
    for my $n ( $iter->findnodes( '//newcomer' ) ) {
        my $owner = $n->findvalue( '@player' );
        my $code = $n->findvalue( 'text()' );
        my $date = $n->findvalue( '@time' );

        push @newcomers, [ $owner, $date, $code ];
    }

    return @newcomers;
}   

##########################################################################

sub introduce_newcomers
{
	no warnings 'uninitialized';
	my $self = shift;

    # TODO special case for adhoc at iteration 0
   
    my @newcomers = $self->{replay} ? $self->get_iteration_newcomers( )
                                    : $self->visit_mobil_station
                                    ;

    $self->{newcomers} = \@newcomers;

    $self->log( "\tno-one was aboard" ) unless @newcomers;

    AGENT: for my $newcomer ( @newcomers ) {
        my( $player, $date, $code ) = @$newcomer;
        $self->log( "\t".$player."'s new agent is aboard (u/l'ed $date)" );
        # dead players can't submit agents
        if( $self->{conf}{player}{$player}{status} eq 'EOT' ) {
            $self->log( "\tplayer is eliminated, can't submit a new agent" );
            next AGENT;
        }
    
        my @available_slots = $self->{theArray}->empty_cells;
    
        if( @available_slots > 0 )
        {
            my $slot = $available_slots[ rand @available_slots ];
            $self->log( "\tagent inserted at cell $slot" );
            $self->{theArray}->cell( $slot )->insert({
                owner => $player,
                code => $code,
            });
            next AGENT;
        }
   
        # no empty cells, maybe a cell already occupied by
        # the player?
        @available_slots = $self->{theArray}->cells_belonging_to( $player );
    
        if( @available_slots > 0 )
        {
            my $slot = $available_slots[ rand @available_slots ];
            $self->log( "agent at cell $slot is upgraded" );
            $self->{theArray}->cell( $slot )->insert({
                owner => $player,
                code => $code,
            });
            unlink $player or $self->log( "ERROR: $!" );
            next AGENT;
        }
    
        $self->log( "no empty slot left, agent deleted" ); 
    }
}

##########################################################################

sub log 
{
  my $self = shift;
  
  return @{$self->{log}} unless @_;

  if( $self->{interactive} ) {
    local $\ = "\n";
    print for @_;
  }

  push @{$self->{log}}, @_;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub insert_agent {
	my ( $self, $pos, $player, $code ) = @_;

    if( $pos >= $self->{conf}{theArraySize} ) { 
	    $self->log( "can't insert agent: cell $pos out of bound" );
        return;
    }
		
    $self->{theArray}->cell( $pos )->insert({
        owner => $player,
        code => $code,
    });
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub run_cell {
    my( $self, $cell_id, $vars_ref ) = @_;
    my %vars;
    %vars = %$vars_ref if $vars_ref;

    return $self->array->run_cell( $cell_id => {  
       %vars,
       '$S' => $self->{conf}{agentMaxSize},
       '$I' => $self->{conf}{gameLength},
       '$i' => $self->{round},
    } );

}

##########################################################################

# ( $result, $error, @array ) = $pw->execute( @array )
# executes the code of $array[0]
sub execute
{
	my( $self, $cell_id ) = @_;

    # what happens in execute(), stays in execute
    local *STDERR;
    my $warnings;
    open STDERR, '>', \$warnings;

    my $owner =  $self->array->cell( $cell_id )->get_owner;
    
	local @_ = $self->array->get_cells_code( $cell_id );
	local $_ = $_[0];
	my @o = $self->array->get_facades( $cell_id );

	# run this in a safe
	my $safe = new Safe 'Container';
	$safe->permit( qw/ rand time sort :browse :default / );
	my $result;
	my $error;
  
	eval 
	{   
    	local $SIG{ALRM} = sub { die "timed out\n" };
    	alarm 3;
		undef $@;
		my $code = $_[0];
		@Container::Array = @_;
		@Container::o = @o;
		@Container::O = $owner;
		$Container::S = $self->{conf}{snippetMaxLength};
		$Container::I = $self->{conf}{gameLength};
		$Container::i = $self->{conf}{currentIteration};
		$safe->share_from( 'Container', 
                           [ '$S', '$I', '$i', '@_', '@o', '$O' ] );
		$result = $safe->reval( <<EOT );
local *_ = \\\@Array;
\$_ = \$_[0];
$code
EOT
	
    	$error = $@;   
    	alarm 0;
  	};

    return ( $result, $error ) if $error;

    my @code_array = $safe->reval( '@Array' );
    $owner = $safe->reval( '$o[0]' );
    $code_array[0] = $safe->reval( '$_' );

    return( $result, $error, $owner, @code_array );
}

##########################################################################

sub runSlot {
  	my ( $self, $slotId ) = @_;

    my $cell = $self->{theArray}->cell( $slotId );

    # diddled cells and empty cells aren't executed
	return if $cell->is_empty 
           or not $cell->get_operational;
	
	$self->log( "cell $slotId: agent owned by ".$cell->get_owner ); 

    my @code_array  = $self->{theArray}->get_cells_code( $slotId );
    my @owner_array = $self->{theArray}->get_facades( $slotId );

	# exceed permited size?
    my $code = $cell->get_code;
  	if( length $code > $self->{conf}{agentMaxSize} ) {
    	$self->log( "\tagent crashed: is ".length($code)." chars, exceeds max permitted size $self->{conf}{snippetMaxSize}" ); 
        $cell->delete;
    	return;
  	}

  	$self->log( "\texecuting.." );
  	
    # TODO  squeeze in the ownership array
    my $agent = $self->run_cell( $slotId );

	if( $agent->crashed ) {
    	$self->log( "\tagent crashed: ".$agent->error_msg );
        $cell->delete;
    	return;
  	} 

    $cell->set_code( $agent->eval( '$_' ) );
    $cell->set_facade( $agent->eval( '$o' ) );

    no warnings qw/ uninitialized /; 

  	my $output = $agent->return_value;
    my $result = $output;
  	$output = substr( $output, 0, 24 ).".." if length $output > 25;
  	$output =~ s#\n#\\n#g;
  	
    $self->log( "\tagent returned: $output" );
    
    if( $result =~ /^!(-?\d*)$/ ) {
        $self->_nuke_operation( $slotId, $1 );
    }
    elsif( $result =~ /^\^(-?\d*)$/ ) {
        $self->_p0wn_operation( $slotId, $1 );
    }
    elsif( $result =~ /^~(-?\d*)$/ ) {
        $self->_alter_operation( $slotId, $1, [ $agent->eval( '@Array' ) ] );
    }
    elsif( $result =~ /^(-?\d*):(-?\d*)$/ ) {
        $self->_copy_operation( $slotId, $1, $2 );
    }
    else {
    	$self->_noop_operation();
    }
}

sub _nuke_operation {
    my( $self, $agent_index, $target_index ) = @_;

    $target_index = $self->relative_to_absolute_position( $agent_index, $target_index );
    return if $target_index == -1;
    
    if( $self->array->cell( $target_index )->is_empty ) {
        $self->log( "\tno agent found at cell $target_index" );
        return;
    }
		
    $self->array->cell( $target_index )->clear;
    $self->log( "\tagent in cell $target_index destroyed" );
}

sub _p0wn_operation {
    my( $self, $agent_index, $target_index ) = @_;

    $target_index = $self->relative_to_absolute_position( $agent_index, $target_index );

    return if $target_index == -1;

    my $target = $self->{theArray}->cell( $target_index );

    if( $target->is_empty ) {
	   $self->log( "\tno agent to p0wn in cell $target_index" );
	   return;
    }

    $self->log( "\tagent in cell $target_index p0wned" );
    $target->set_owner( $self->{theArray}->cell( $agent_index )->get_owner );
}

sub relative_to_absolute_position {
  my( $self, $slotId, $shift ) = @_;
  $shift ||= 0;

  if( abs( $shift ) > $self->{conf}{theArraySize} ) {
    $self->log( "\tposition $shift out-of-bound" );
    return -1;
  }
  $slotId += $shift + 2 * $self->{conf}{theArraySize};
  $slotId %= $self->{conf}{theArraySize};

  return $slotId;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub _alter_operation {
    my ( $self, $agent_index, $target_index, $Array_ref ) = @_;

    my $abs_target_index = $self->relative_to_absolute_position( $agent_index, $target_index );
    return if $abs_target_index == -1;

    my $target = $self->{theArray}->cell( $abs_target_index );
   
    if ( $target->is_empty ) {
        $self->log( "\tno agent found at cell $abs_target_index" );
      	return;
    }

    $target->set_code( $Array_ref->[$target_index] );
    $self->log( "\tcode of agent in cell $abs_target_index altered" );
}

sub _copy_operation {
    my( $self, $agent_index, $source_index, $dest_index ) = @_;
    
    $source_index = $self->relative_to_absolute_position( $agent_index, $source_index );
    $dest_index   = $self->relative_to_absolute_position( $agent_index, $dest_index );
    
    # source or destination invalid? We do nothing
    return if $source_index == -1 or $dest_index == -1;

    my $theArray = $self->{theArray};
    my $target = $theArray->cell( $dest_index );
    my $agent = $theArray->cell( $agent_index );
    
    if( $target->get_owner 
        and $target->get_owner ne $agent->get_owner )
    {
        $self->log( "\tagent in cell $dest_index already owned by ".
                    $target->get_owner );
        return;
    }

    $self->log( "\tagent of cell $source_index copied into cell $dest_index" );
    $target->copy( $agent );
    $target->set_operational( 0 );
}

sub _noop_operation {
    $_[0]->log( "\tno-op" );
}

sub readCell {
	my( $self, $cellId ) = @_;
	return undef unless $self->{theArray}[$cellId];
	return ( $self->{theArray}[$cellId]{owner}, $self->{theArray}[$cellId]{code}  );
}

sub writeCell {
	my( $self, $pos, $owner, $code ) = @_;
	$self->{theArray}[$pos] = { owner => $owner, code => $code };
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub array {
    return $_[0]->{theArray};
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


sub agent_census {
    my( $self ) = @_;

    my %player = %{$self->{conf}{player}};

    my %census = $self->{theArray}->census;

    for my $p ( keys %player ) {
        $player{$p}{agents} = $census{$p} || 0;
    }

    return %census;
}



1;

__END__

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#  Module Documentation
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%