[1980] | 1 | #!/usr/bin/perl |
---|
| 2 | |
---|
| 3 | use strict; |
---|
| 4 | use warnings; |
---|
| 5 | |
---|
| 6 | use Carp qw{croak}; |
---|
| 7 | use Fcm::Keyword::Entries; |
---|
| 8 | use File::Basename qw{dirname}; |
---|
| 9 | use File::Spec; |
---|
| 10 | use File::Temp qw{tempdir}; |
---|
| 11 | use IO::File; |
---|
| 12 | use IO::Pipe; |
---|
| 13 | use POSIX qw{WIFEXITED}; |
---|
| 14 | use Test::More (tests => 17); |
---|
| 15 | |
---|
| 16 | my %VALUE_OF = ( |
---|
| 17 | bar => { |
---|
| 18 | 'bar3' => 3, |
---|
| 19 | 'bar3.1' => 31, |
---|
| 20 | 'bar3.14' => 314, |
---|
| 21 | }, |
---|
| 22 | baz => { |
---|
| 23 | 'bear' => 4, |
---|
| 24 | 'bee' => 6, |
---|
| 25 | 'spider' => 8, |
---|
| 26 | }, |
---|
| 27 | ); |
---|
| 28 | |
---|
| 29 | main(); |
---|
| 30 | |
---|
| 31 | sub main { |
---|
| 32 | my $class = 'Fcm::Keyword::Loader::VC::Revision'; |
---|
| 33 | use_ok($class); |
---|
| 34 | test_constructor($class); |
---|
| 35 | test_load_to($class); |
---|
| 36 | } |
---|
| 37 | |
---|
| 38 | ################################################################################ |
---|
| 39 | # Tests simple usage of the constructor |
---|
| 40 | sub test_constructor { |
---|
| 41 | my ($class) = @_; |
---|
| 42 | my $prefix = "constructor"; |
---|
| 43 | my $loader = $class->new({source => 'foo'}); |
---|
| 44 | isa_ok($loader, $class); |
---|
| 45 | is($loader->get_source(), 'foo', "$prefix: get_source()"); |
---|
| 46 | ok($loader->load_to(), "$prefix: load_to"); # FIXME: should fail? |
---|
| 47 | } |
---|
| 48 | |
---|
| 49 | ################################################################################ |
---|
| 50 | # Tests loading to an Fcm::Keyword::Entries object |
---|
| 51 | sub test_load_to { |
---|
| 52 | my ($class) = @_; |
---|
| 53 | my $prefix = 'load to'; |
---|
| 54 | my $temp_dir = tempdir(CLEANUP => 1); |
---|
| 55 | my $repos = File::Spec->catfile($temp_dir, 'repos'); |
---|
| 56 | WIFEXITED(system(qw{svnadmin create}, $repos)) |
---|
| 57 | || croak("$repos: cannot create: $?"); |
---|
| 58 | my $dump_file = File::Spec->catfile(dirname($0), 'Revision.dump'); |
---|
| 59 | my $handle = IO::File->new($dump_file, 'r'); |
---|
| 60 | if (!$handle) { |
---|
| 61 | croak("$dump_file: cannot load: $!"); |
---|
| 62 | } |
---|
| 63 | my $dump = do{local $/; $handle->getline()}; |
---|
| 64 | $handle->close(); |
---|
| 65 | my $pipe = IO::Pipe->new(); |
---|
| 66 | $pipe->writer(qw{svnadmin load -q}, $repos); |
---|
| 67 | print($pipe $dump); |
---|
| 68 | $pipe->close(); |
---|
| 69 | if ($?) { |
---|
| 70 | croak("$dump_file: cannot load: $?"); |
---|
| 71 | } |
---|
| 72 | my $repos_url = "file://$repos"; |
---|
| 73 | my $loader = $class->new({source => $repos_url}); |
---|
| 74 | my $entries = Fcm::Keyword::Entries->new(); |
---|
| 75 | ok($loader->load_to($entries), "$prefix: nothing to load"); |
---|
| 76 | for my $key (keys(%VALUE_OF)) { |
---|
| 77 | my $url = "$repos_url/$key"; |
---|
| 78 | my $loader = $class->new({source => $url}); |
---|
| 79 | $loader->load_to($entries); |
---|
| 80 | for my $rev_key (keys(%{$VALUE_OF{$key}})) { |
---|
| 81 | my $entry = $entries->get_entry_by_key($rev_key); |
---|
| 82 | if ($entry) { |
---|
| 83 | is( |
---|
| 84 | $entry->get_key(), |
---|
| 85 | uc($rev_key), |
---|
| 86 | "$prefix: by key: $rev_key", |
---|
| 87 | ); |
---|
| 88 | is( |
---|
| 89 | $entries->get_entry_by_value($VALUE_OF{$key}{$rev_key}), |
---|
| 90 | $entry, |
---|
| 91 | "$prefix: by value: $rev_key: object", |
---|
| 92 | ); |
---|
| 93 | } |
---|
| 94 | else { |
---|
| 95 | fail("$prefix: by key: $rev_key"); |
---|
| 96 | } |
---|
| 97 | } |
---|
| 98 | } |
---|
| 99 | } |
---|
| 100 | |
---|
| 101 | __END__ |
---|