perl/tests/migrate.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 # This tests the migration functionality. It uses two test backends,
   7 # then cmp_deeply's 'em to make sure everything made it over. What
   8 # an amazing cheat. But it works...
   9
  10 use Test::More 'no_plan';
  11 use Data::Dumper;
  12 use Test::Deep;
  13
  14 BEGIN {
  15     print "This test is expected to print lots of extra "
  16         ."crap as a test of the dry run feature.\n";
  17
  18     use_ok 'Thrasher::Test', qw(:all);
  19     use_ok 'Thrasher::Backend::Test';
  20     use_ok 'Thrasher::Backend::Migrate', 'migrate';
  21 }
  22
  23 my $source = Thrasher::Backend::Test->new;
  24 my $dest = Thrasher::Backend::Test->new;
  25 my $fresh = Thrasher::Backend::Test->new;
  26
  27 MIGRATE: {
  28     for my $test (['romeo@montague.lit', 'rom'],
  29                   ['test@bbb.com', 'bbb']) {
  30         my ($jid, $diff) = @$test;
  31
  32         # register
  33         $source->register($jid,
  34                           {username => "user_$diff",
  35                            password => $diff});
  36
  37         # mappings
  38         $source->store_username_mapping
  39             ($jid, "legacy_$diff", "legacy_$diff\@aim.transport");
  40         $source->store_username_mapping
  41             ($jid, "legacy2_$diff", "legacy2_$diff\@aim.transport");
  42
  43         # roster
  44         $source->set_roster
  45             ($jid, {"legacy_$diff" => $source->subscribed,
  46                     "legacy2_$diff" => $source->want_subscribe});
  47
  48         # misc
  49         $source->set_misc($jid, "key1", $diff);
  50
  51         # avatars
  52         $source->set_avatar($jid, "legacy_$diff", "AVATAR");
  53     }
  54
  55     migrate($source, $dest, dry_run => 1);
  56     cmp_deeply($dest, $fresh, 'dry run does nothing correctly');
  57
  58     migrate($source, $dest);
  59     cmp_deeply($dest, $source, 'migration appears to work as expected');
  60 }
  61