t/02-aurora.t

   1 #!/usr/bin/perl
   2
   3 # use 5.010;
   4 use strict;
   5 use warnings;
   6
   7 =head1 NAME
   8
   9
  10
  11 =head1 SYNOPSIS
  12
  13
  14
  15 =head1 OPTIONS
  16
  17 =over 8
  18
  19 =cut
  20
  21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  22
  23 =item B<--cleanup!>
  24
  25 Defaults to true. Negate with --nocleanup. If true, all generated
  26 files are removed at the end of the test run.
  27
  28 =item B<--help|h!>
  29
  30 This help
  31
  32 =item B<--sleep1=f>
  33
  34 Defaults to 0.2. Seconds to sleep between the cration of the initial
  35 files.
  36
  37 =item B<--sleep2=f>
  38
  39 Defaults to 0.1. Seconds to sleep between the iterations of the second
  40 phase.
  41
  42 =item B<--iterations=i>
  43
  44 Defaults to 30. Number of iterations in the second phase.
  45
  46 =back
  47
  48 =head1 DESCRIPTION
  49
  50 In the first phase the test creates a couple of files and injects them
  51 into the tree, one after the other. There are tunable C<sleep1> pauses
  52 between each file creation. In the second phase the test runs
  53 alternating C<aggregate> commands on the server and C<rmirror>
  54 commands on the client. After each iteration both directories are
  55 checksummed and stored in a separate yaml file for later inspection.
  56
  57 If you want to inspect the yaml files, be sure to set --nocleanup.
  58
  59 =head2 Interpretation of the output
  60
  61 Output may look like this:
  62
  63   # 17.1575 new state reached in t/serv-5c59696a590715c20f2b7f55c281c667.yaml
  64   # 18.0686 new state reached in t/mirr-b9b903e62f31249d2d5836eede1d0420.yaml
  65   # 19.2339 new state reached in t/serv-9a9df7f3c8d2fc501c27490696ba1c88.yaml
  66   # 33.2662 new state reached in t/serv-7ad22e96a3ecf527e1fa934425ec7516.yaml
  67   # 55.2330 new state reached in t/serv-ce628a7ee14eb32054f6744ab9772b2c.yaml
  68
  69 This means that the RECENT files on the server have changed 4 times
  70 due to calls to C<aggregate> but the RECENT files on the mirror have
  71 only changed once.
  72
  73 =cut
  74
  75
  76 use FindBin;
  77 use lib "$FindBin::Bin/../lib";
  78 BEGIN {
  79     push @INC, qw(       );
  80 }
  81
  82 use Getopt::Long;
  83 use Hash::Util qw(lock_keys);
  84
  85 our %Opt;
  86 lock_keys %Opt, map { /([^=!]+)/ } @opt;
  87 GetOptions(\%Opt,
  88            @opt,
  89           ) or pod2usage(1);
  90
  91 $Opt{cleanup}    = 1   unless defined $Opt{cleanup};
  92 $Opt{sleep1}     = 0.2 unless defined $Opt{sleep1};
  93 $Opt{sleep2}     = 0.1 unless defined $Opt{sleep2};
  94 $Opt{iterations} = 30  unless defined $Opt{iterations};
  95
  96
  97 use File::Basename qw(dirname);
  98 use File::Find;
  99 use File::Path qw(mkpath rmtree);
 100 use Time::HiRes qw(time sleep);
 101 $^T = time; # force it to float
 102 use YAML::Syck;
 103
 104 use Test::More;
 105 my $tests;
 106 BEGIN {
 107     $tests = 0;
 108 }
 109
 110 use lib "lib";
 111
 112 my $root_from = "t/serv";
 113 my $root_to = "t/mirr";
 114 my $statusfile = "t/recent-rmirror-state.yml";
 115 my @unlink = map { "t/$_-ttt.yaml" } qw(serv mirr);
 116 rmtree [$root_from, $root_to];
 117
 118 my @cast =
 119     qw(
 120           princess
 121           king
 122           queen
 123           household
 124           horses
 125           dogs
 126           pidgeons
 127           flies
 128           fire
 129           roast
 130           cook
 131           scullion
 132           wind
 133           trees
 134           leaves
 135      );
 136
 137 {
 138     my @intervals;
 139     my $test_counter;
 140     BEGIN {
 141         @intervals = qw( 2s 3s 5s 8s 13s 21s 34s 55s Z );
 142         $tests += 1;
 143     }
 144     my $rf0 = File::Rsync::Mirror::Recentfile->new
 145         (
 146          aggregator     => [@intervals[1..$#intervals]],
 147          interval       => $intervals[0],
 148          localroot      => $root_from,
 149          rsync_options  => {
 150                             compress          => 0,
 151                             links             => 1,
 152                             times             => 1,
 153                             checksum          => 0,
 154                            },
 155         );
 156     mkpath $root_from;
 157     mkpath $root_to;
 158     mkpath "t/tmp";
 159     my $cwd = Cwd::cwd;
 160     my $rrr = File::Rsync::Mirror::Recent->new
 161         (
 162          ignore_link_stat_errors => 1,
 163          localroot        => $root_to,
 164          remote           => "$root_from/RECENT.recent",
 165          rsync_options    => {
 166                               compress          => 0,
 167                               links             => 1,
 168                               times             => 1,
 169                               # not available in rsync 3.0.3: 'omit-dir-times'  => 1,
 170                               checksum          => 0,
 171                               'temp-dir'        => "$cwd/t/tmp",
 172                              },
 173         );
 174     my $latest_timestamp = 0;
 175     sub archive {
 176         for my $r ($root_from,$root_to) {
 177             next unless -d $r;
 178             my $tfile = "$r-ttt.yaml";
 179             my $ctx = Digest::MD5->new;
 180             my $y;
 181             File::Find::find
 182                     (
 183                      {
 184                       wanted => sub {
 185                           return unless -f $_;
 186                           my $content = do { open my $fh, $File::Find::name or die "Could not open '$File::Find::name': $!"; local $/; <$fh>};
 187                           $y->{substr($File::Find::name,1+length($r))} = $content;
 188                       },
 189                       no_chdir => 1,
 190                      },
 191                      $r
 192                     );
 193             while () {
 194                 YAML::Syck::DumpFile $tfile, $y;
 195                 my @stat = stat $tfile;
 196                 if ($stat[9] == $latest_timestamp) {
 197                     # for a better overview over the results, never
 198                     # let two timestamps be the same
 199                     sleep 0.1;
 200                 } else {
 201                     $latest_timestamp = $stat[9];
 202                     last;
 203                 }
 204             }
 205             open my $fh, $tfile or die $!;
 206             $ctx->addfile($fh);
 207             my $digest = $ctx->hexdigest;
 208             my $pfile = "$r-$digest.yaml";
 209             next if -e $pfile;
 210             my $t = sprintf "%6.4f", time - $^T;
 211             diag "$t new state reached in $pfile";
 212             rename $tfile, $pfile or die $!;
 213             push @unlink, $pfile;
 214         }
 215     }
 216     sub ts {
 217         my($file, $message) = @_;
 218         my $t = sprintf "%6.4f", time - $^T;
 219         mkpath dirname $file;
 220         open my $fh, ">", $file or die "Could not open '$file': $!";
 221         print $fh "$message\n";
 222         $rf0->update($file,"new");
 223         $rf0->aggregate;
 224         diag "$t $message";
 225     }
 226     sub superevent {
 227         my($event) = @_;
 228         for my $i (0..$#cast) {
 229             my $actor = $cast[$i];
 230             my $file = sprintf "%s/%02d%s", $root_from, $i, $actor;
 231             my $message = "$actor $event";
 232             ts $file, $message;
 233             sleep $Opt{"sleep1"};
 234         }
 235     }
 236     # speeding up the process a little bit:
 237     superevent("sleeping");
 238     my $rfs = $rrr->recentfiles;
 239     for my $rf (@$rfs) {
 240         $rf->sleep_per_connection(0);
 241     }
 242     $rrr->_rmirror_sleep_per_connection(0.001);
 243     for (my $t=0; $t < $Opt{iterations}; $t++) {
 244         $rf0->aggregate;
 245         $rrr->rmirror;
 246         archive;
 247         sleep $Opt{sleep2};
 248     }
 249     ok(1);
 250 }
 251
 252 if ($Opt{cleanup}) {
 253     rmtree [$root_from, $root_to, "t/tmp"];
 254     unlink @unlink;
 255 }
 256
 257 BEGIN {
 258     if ($ENV{AUTHOR_TEST}) {
 259         plan tests => $tests
 260     } else {
 261         plan( skip_all => "test is a tunable author test, set envariable AUTHOR_TEST and tune it" );
 262         eval "require POSIX; 1" and POSIX::_exit(0);
 263     }
 264 }
 265
 266 use Cwd ();
 267 use Digest::MD5 ();
 268 use File::Rsync::Mirror::Recent;
 269 use File::Rsync::Mirror::Recentfile;
 270
 271 # Local Variables:
 272 # mode: cperl
 273 # cperl-indent-level: 4
 274 # End: