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