#!/usr/bin/env perl use strict; $| = 1; use File::Temp qw(tempdir); # core use POE qw(Wheel::Run); # from CPAN ## note: POE uses Time::HiRes for subsecond sleeps so install if you can use File::Basename qw(dirname); # core use lib dirname(__FILE__); # find PoBoy near here use PoBoy; ### config my $CVSROOT = undef; # undef means make new empty one for testing my $MODULE = "abc/def"; # cvs -d $CVSROOT co -d . $MODULE my $SUBDIR = "ghi/jkl"; # this path below $MODULE for testing my $KIDS = 10; # how many kids my $TEST_LENGTH_IN_SECONDS = 60; # how long to test (in seconds) ## note: testing time does *not* include one final task per child my $MINTASK = 1; # minimum idle time between tasks (in seconds) my $MAXTASK = 10; # maximum idle time between tasks (in seconds) my $COMMIT_PREFIX = "id: dev\n\n"; # prefix all commits with this ### end config ### if $CVSROOT is set, use it, otherwise make up a fake one: unless ($CVSROOT) { $CVSROOT = tempdir(CLEANUP => 1); print "creating a fake CVS root in $CVSROOT\n"; trace("cvs", "-d", $CVSROOT, "init"); ## create a workdir to populate the module/subdir location: my $workdir = tempdir(CLEANUP => 1); chdir $workdir or die "cannot chdir $workdir: $!"; trace("cvs", "-d", $CVSROOT, "co", "."); ## build the path downward: for (split m{/}, "$MODULE/$SUBDIR") { next if $_ eq "."; mkdir $_, 0755 or die "cannot mkdir $_: $!"; trace("cvs", "add", $_); chdir $_ or die "cannot chdir $_: $!"; } ## now touch a ".cvsignore" { open my $f, ">>", ".cvsignore" or die } trace("cvs", "add", ".cvsignore"); trace("cvs", "commit", "-m", "${COMMIT_PREFIX}needed for non empty", ".cvsignore"); ## show what got placed in fake cvsroot: trace("ls", "-RAl", $CVSROOT); ## note that $workdir goes out of scope here, cleaning it up } ### figure out when to quit: my $STOP_TIME = time + $TEST_LENGTH_IN_SECONDS; ### launch the kids: PoBoy::__spawn( { name => "session $_", cvsroot => $CVSROOT, module => $MODULE, subdir => $SUBDIR, stop_time => $STOP_TIME, mintask => $MINTASK, maxtask => $MAXTASK, commit_prefix => $COMMIT_PREFIX, } ) for 1 .. $KIDS; ### run the tasks: POE::Kernel->run; ### show the repository if we can: if ($CVSROOT =~ m{^/}) { trace("ls", "-RAl", $CVSROOT); ## show the CVS activity history: require File::Copy; # core File::Copy::copy("$CVSROOT/CVSROOT/history", \*STDOUT); } exit 0; ## utility method, show args and execute: sub trace { my @cmd = @_; print "@cmd:\n"; system @cmd; }
The definition for PoBoy.pm:
package PoBoy; # the POE session states are here ## we presume "use POE" in the main namespace for the POE constants ## beware - ALL subroutines defined here are valid state names ## unless they begin with two underscores my $NEXT_FILE = sprintf "T%d00000", time; # used in task_add_file ## this pattern is used in a glob below sub __spawn { # constructor - note double underscore POE::Session->create( package_states => ## extract all subroutines that don't start with "__" ## and allocate them as states: [ (__PACKAGE__) => [ do { no strict 'refs'; grep { !/^__/ and defined &$_ } keys %{__PACKAGE__ . "::"}; } ] ], ## pass args into _start: args => [@_], ); } ## called for startup: sub _start { ## set up SIGCHLD handler $_[::KERNEL]->sig(CHLD => sigchld_handler =>); ## save the options in the heap: my $heap = $_[::HEAP] = $_[::ARG0]; my $name = $heap->{name}; print "starting $name\n"; my $workdir = ::tempdir(CLEANUP => 1); $heap->{workdir} = $workdir; ## ugly hack... cannot co -d . if we're coming from remote ## so we'll symlink in a "..." that points at "." symlink "$workdir", "$workdir/..." or die "Cannot symlink $workdir: $!"; ## launch a checkout, then call add_next_task: $_[::KERNEL]->yield( run => ["cvs", "-d", $heap->{cvsroot}, "co", "-d", "...", $heap->{module}], [add_next_task =>] ); } ## everybody eventually comes back to here, to queue up the next thing sub add_next_task { my $heap = $_[::HEAP]; ## no time to do more? then show how up-to-date we are: if (time > $heap->{stop_time}) { $_[::KERNEL]->yield(run => ["cvs", "-n", "update"]); return; } ## otherwise, launch a new random task in a bit: $_[::KERNEL]->delay(random_task => $heap->{mintask} + rand($heap->{maxtask} - $heap->{mintask})); } ## pick a random task, and yield to it: sub random_task { my $name = $_[::HEAP]{name}; ## bias the choices towards editing: my @choices = qw(task_add_file task_update task_update_and_edit task_update_and_edit task_update_and_edit task_update_and_edit task_update_and_edit task_update_and_edit task_update_and_edit ); ## random selection: my $choice = $choices[rand @choices]; print "$name performs $choice\n"; $_[::KERNEL]->yield($choice); } ## add a file sub task_add_file { my $heap = $_[::HEAP]; my $name = $heap->{name}; ## generate the name (shared by all sessions): my $filename = $heap->{subdir} . "/" . $NEXT_FILE++; print "$name adds $filename\n"; ## get the top of my tree: my $workdir = $heap->{workdir}; ## create the file, put timestamp into it: { open my $out, ">", "$workdir/$filename" or die "Cannot create $filename: $!"; print {$out} time, "\n"; } ## add the file to CVS, and when done, do next step (commit): print "$name launches cvs add $filename\n"; $_[::KERNEL]->yield( run => ["cvs", "add", $filename], [task_add_file_2 => $filename] ); } ## after add is done, need to commit: sub task_add_file_2 { my $heap = $_[::HEAP]; ## filename is passed above my $filename = $_[::ARG0]; my $name = $heap->{name}; ## commit the file, and then queue another task: print "$name launches cvs commit (new) $filename\n"; $_[::KERNEL]->yield( run => [ "cvs", "commit", "-m", "$heap->{commit_prefix}$filename from $name", $filename ], [add_next_task =>] ); } ## "just looking" - refresh the local workdir sub task_update { my $name = $_[::HEAP]{name}; print "$name updates\n"; ## call update, then go on to another task $_[::KERNEL]->yield( run => ["cvs", "update"], [add_next_task =>] ); } ## "time to edit" - update then select a victim sub task_update_and_edit { my $name = $_[::HEAP]{name}; print "$name updates and edits\n"; ## first update, overwriting conflicts, and then next step: $_[::KERNEL]->yield( run => ["cvs", "update", "-C"], [task_update_and_edit_2 =>] ); } ## after update, hack the file: sub task_update_and_edit_2 { my $heap = $_[::HEAP]; my $name = $heap->{name}; my $workdir = $heap->{workdir}; chdir $workdir or die "Cannot chdir $workdir: $!"; ## pick a file to edit: my @filenames = glob "$heap->{subdir}/T*[0-9]"; ## might be nothing if we're called too early. Pretend it's add_file unless (@filenames) { print "$name can't find anything, adding a file\n"; $_[::KERNEL]->yield(task_add_file =>); return; } my $filename = $filenames[rand @filenames]; ## inplace-edit: local *ARGV; @ARGV = $filename; local $^I = "~"; while (<>) { ## hack the first line: $_ = time . rand() . "\n$_" if 1 .. 1; ## randomly attack other lines: $_ = "X $_" if rand > 0.8; print; # copy to new file } ## commit the changed file, then go to a new task $_[::KERNEL]->yield( run => [ "cvs", "commit", "-m", "$heap->{commit_prefix}$name edit $filename", $filename ], [add_next_task =>] ); } ## all done, automatically called: sub _stop { my $name = $_[::HEAP]{name}; print "stopping $name\n"; } ## utility state - run command, then go to next state (if any): sub run { my @command = @{$_[::ARG0]}; my @next_state = @{$_[::ARG1] || []}; ## grab workdir for the closure: my $workdir = $_[::HEAP]{workdir}; my $wheel = POE::Wheel::Run->new( Program => sub { ## execute this code in the child (POE kernel is not here!) chdir $workdir or die "cannot chdir to $workdir: $!"; print "@command\n"; exec @command; die "Cannot exec @command: $!"; }, StdoutEvent => 'run_got_output', StderrEvent => 'run_got_output', ); ## save my wheelinfo under PID for CHLD handler: $_[::HEAP]{run}{$wheel->PID} = [$wheel, \@next_state]; } ## whenever we get a line of output, spray it: sub run_got_output { my $name = $_[::HEAP]{name}; my $input = $_[::ARG0]; my $id = $_[::ARG1]; print "$name($id):$input\n"; } ## every dead kid comes here: sub sigchld_handler { my $pid = $_[::ARG1]; my $child_error = $_[::ARG2]; my $name = $_[::HEAP]{name}; ## was it one of our wheels? if (my $run_info = delete $_[::HEAP]{run}{$pid}) { ## if so, say it: my $id = $run_info->[0]->ID; print "$name($id):[DONE]\n"; ## jump to next state if present: my @next_state = @{$run_info->[1]}; if (@next_state) { $_[::KERNEL]->yield(@next_state); } } ## report all kids here if they were broken: print "child process $pid exited with status $child_error\n" if $child_error; } 1;