[1980] | 1 | #!/usr/bin/perl |
---|
| 2 | |
---|
| 3 | use strict; |
---|
| 4 | use warnings; |
---|
| 5 | |
---|
| 6 | ################################################################################ |
---|
| 7 | # A Fcm::Keyword::Entry sub-class for testing |
---|
| 8 | { |
---|
| 9 | package TestEntry; |
---|
| 10 | use base qw{Fcm::Keyword::Entry}; |
---|
| 11 | } |
---|
| 12 | |
---|
| 13 | ################################################################################ |
---|
| 14 | # A mock loader implementing the Fcm::Keyword::Loader interface |
---|
| 15 | { |
---|
| 16 | package MockLoader0; |
---|
| 17 | use Scalar::Util qw{blessed}; |
---|
| 18 | |
---|
| 19 | ############################################################################ |
---|
| 20 | # Constructor |
---|
| 21 | sub new { |
---|
| 22 | my ($class) = @_; |
---|
| 23 | return bless({number_of_calls_to_load_to => 0}, $class); |
---|
| 24 | } |
---|
| 25 | |
---|
| 26 | ############################################################################ |
---|
| 27 | ##Returns the package name |
---|
| 28 | sub get_source { |
---|
| 29 | my ($self) = @_; |
---|
| 30 | return blessed($self); |
---|
| 31 | } |
---|
| 32 | |
---|
| 33 | ############################################################################ |
---|
| 34 | # Returns number of times $self->load_to() has been called |
---|
| 35 | sub get_number_of_calls_to_load_to { |
---|
| 36 | my ($self) = @_; |
---|
| 37 | return $self->{number_of_calls_to_load_to}; |
---|
| 38 | } |
---|
| 39 | |
---|
| 40 | ############################################################################ |
---|
| 41 | # Loads data into $entries, and returns number of entries loaded |
---|
| 42 | sub load_to { |
---|
| 43 | my ($self, $entries) = @_; |
---|
| 44 | $self->{number_of_calls_to_load_to}++; |
---|
| 45 | return $self->load_to_impl($entries); |
---|
| 46 | } |
---|
| 47 | |
---|
| 48 | ############################################################################ |
---|
| 49 | # Returns 0 |
---|
| 50 | sub load_to_impl { |
---|
| 51 | my ($self, $entries) = @_; |
---|
| 52 | return 0; |
---|
| 53 | } |
---|
| 54 | } |
---|
| 55 | |
---|
| 56 | ################################################################################ |
---|
| 57 | # A mock loader implementing the Fcm::Keyword::Loader interface |
---|
| 58 | { |
---|
| 59 | package MockLoader1; |
---|
| 60 | our @ISA = qw{MockLoader0}; |
---|
| 61 | |
---|
| 62 | my %VALUE_OF = (foo => 'foo1', bar => 'bar2', baz => 'baz3'); |
---|
| 63 | |
---|
| 64 | ############################################################################ |
---|
| 65 | # Returns a reference to the mock data |
---|
| 66 | sub get_data { |
---|
| 67 | my ($class) = @_; |
---|
| 68 | return \%VALUE_OF; |
---|
| 69 | } |
---|
| 70 | |
---|
| 71 | ############################################################################ |
---|
| 72 | ##Writes mock data to the $entries object |
---|
| 73 | sub load_to_impl { |
---|
| 74 | my ($self, $entries) = @_; |
---|
| 75 | my $counter = 0; |
---|
| 76 | for my $key (keys(%{$self->get_data()})) { |
---|
| 77 | $entries->add_entry($key, $self->get_data()->{$key}); |
---|
| 78 | $counter++; |
---|
| 79 | } |
---|
| 80 | return $counter; |
---|
| 81 | } |
---|
| 82 | } |
---|
| 83 | |
---|
| 84 | ################################################################################ |
---|
| 85 | # A mock loader implementing the Fcm::Keyword::Loader interface |
---|
| 86 | { |
---|
| 87 | package MockLoader2; |
---|
| 88 | our @ISA = qw{MockLoader1}; |
---|
| 89 | |
---|
| 90 | my %VALUE_OF = (sausages => 'pig', eggs => 'hen', chips => 'potato'); |
---|
| 91 | |
---|
| 92 | ############################################################################ |
---|
| 93 | # Returns a reference to the mock data |
---|
| 94 | sub get_data { |
---|
| 95 | my ($class) = @_; |
---|
| 96 | return \%VALUE_OF; |
---|
| 97 | } |
---|
| 98 | } |
---|
| 99 | |
---|
| 100 | package main; |
---|
| 101 | |
---|
| 102 | use Test::More qw{no_plan}; |
---|
| 103 | |
---|
| 104 | main(); |
---|
| 105 | |
---|
| 106 | sub main { |
---|
| 107 | my $class = 'Fcm::Keyword::Entries'; |
---|
| 108 | use_ok($class); |
---|
| 109 | test_empty_constructor($class); |
---|
| 110 | test_constructor($class); |
---|
| 111 | test_add_entry($class); |
---|
| 112 | test_loaders($class); |
---|
| 113 | } |
---|
| 114 | |
---|
| 115 | ################################################################################ |
---|
| 116 | # Tests empty constructor |
---|
| 117 | sub test_empty_constructor { |
---|
| 118 | my ($class) = @_; |
---|
| 119 | my $prefix = 'empty constructor'; |
---|
| 120 | my $entries = $class->new(); |
---|
| 121 | isa_ok($entries, $class); |
---|
| 122 | is($entries->get_entry_class(), 'Fcm::Keyword::Entry', |
---|
| 123 | "$prefix: default entry class"); |
---|
| 124 | is_deeply([$entries->get_loaders()], [], "$prefix: empty list of loaders"); |
---|
| 125 | is_deeply([$entries->get_all_entries()], [], |
---|
| 126 | "$prefix: empty list of entries"); |
---|
| 127 | for my $arg ('foo', undef) { |
---|
| 128 | is($entries->get_entry_by_key($arg), undef, |
---|
| 129 | "$prefix: entry by key: undef"); |
---|
| 130 | is($entries->get_entry_by_value($arg), undef, |
---|
| 131 | "$prefix: entry by value: undef"); |
---|
| 132 | } |
---|
| 133 | } |
---|
| 134 | |
---|
| 135 | ################################################################################ |
---|
| 136 | # Tests other constructor usages |
---|
| 137 | sub test_constructor { |
---|
| 138 | my ($class) = @_; |
---|
| 139 | my $prefix = 'constructor'; |
---|
| 140 | my @loaders = (MockLoader1->new(), MockLoader2->new()); |
---|
| 141 | my $entries = $class->new({ |
---|
| 142 | entry_class => 'not-a-class', |
---|
| 143 | loaders => \@loaders, |
---|
| 144 | }); |
---|
| 145 | isa_ok($entries, $class); |
---|
| 146 | is($entries->get_entry_class(), 'not-a-class', "$prefix: entry class"); |
---|
| 147 | is_deeply([$entries->get_loaders()], \@loaders, "$prefix: list of loaders"); |
---|
| 148 | eval { |
---|
| 149 | $entries->add_entry('key', 'value'); |
---|
| 150 | }; |
---|
| 151 | isnt($@, undef, "$prefix: invalid entry class"); |
---|
| 152 | } |
---|
| 153 | |
---|
| 154 | ################################################################################ |
---|
| 155 | # Tests adding entries |
---|
| 156 | sub test_add_entry { |
---|
| 157 | my ($class) = @_; |
---|
| 158 | my $prefix = 'add entry'; |
---|
| 159 | my %VALUE_OF = (key1 => 'value1', egg => 'white and yolk', 'xyz.abc' => ''); |
---|
| 160 | for my $entry_class ('Fcm::Keyword::Entry', 'TestEntry') { |
---|
| 161 | my $entries = $class->new({entry_class => $entry_class}); |
---|
| 162 | my $number_of_entries = 0; |
---|
| 163 | for my $key (keys(%VALUE_OF)) { |
---|
| 164 | my $entry = $entries->add_entry($key, $VALUE_OF{$key}); |
---|
| 165 | isa_ok($entry, $entry_class); |
---|
| 166 | is(scalar(@{$entries->get_all_entries()}), ++$number_of_entries, |
---|
| 167 | "$prefix: number of entries: $number_of_entries"); |
---|
| 168 | } |
---|
| 169 | for my $key (keys(%VALUE_OF)) { |
---|
| 170 | my $entry = $entries->get_entry_by_key($key); |
---|
| 171 | isa_ok($entry, $entry_class); |
---|
| 172 | is($entry->get_key(), uc($key), "$prefix: get by key: $key"); |
---|
| 173 | is($entry->get_value(), $VALUE_OF{$key}, |
---|
| 174 | "$prefix: get by key: $key: value"); |
---|
| 175 | } |
---|
| 176 | for my $key (keys(%VALUE_OF)) { |
---|
| 177 | my $entry = $entries->get_entry_by_value($VALUE_OF{$key}); |
---|
| 178 | isa_ok($entry, $entry_class); |
---|
| 179 | is($entry->get_key(), uc($key), "$prefix: get by value: $key"); |
---|
| 180 | is($entry->get_value(), $VALUE_OF{$key}, |
---|
| 181 | "$prefix: get by value: $key: value"); |
---|
| 182 | } |
---|
| 183 | is($entries->get_entry_by_key('no-such-key'), undef, |
---|
| 184 | "$prefix: get by key: no-such-key"); |
---|
| 185 | is($entries->get_entry_by_value('no-such-value'), undef, |
---|
| 186 | "$prefix: get by value: no-such-value"); |
---|
| 187 | } |
---|
| 188 | } |
---|
| 189 | |
---|
| 190 | ################################################################################ |
---|
| 191 | # Tests usage of loaders |
---|
| 192 | sub test_loaders { |
---|
| 193 | my ($class) = @_; |
---|
| 194 | my $prefix = "loader"; |
---|
| 195 | my @loaders = (MockLoader0->new(), MockLoader1->new(), MockLoader2->new()); |
---|
| 196 | my $entries = $class->new({loaders => \@loaders}); |
---|
| 197 | for my $loader (@loaders) { |
---|
| 198 | is($loader->get_number_of_calls_to_load_to(), 0, "$prefix: not loaded"); |
---|
| 199 | } |
---|
| 200 | for my $key (keys(%{$loaders[1]->get_data()})) { |
---|
| 201 | my $value = $loaders[1]->get_data()->{$key}; |
---|
| 202 | my $entry = $entries->get_entry_by_key($key); |
---|
| 203 | is($entry->get_key(), uc($key), "$prefix: by key: $key: key"); |
---|
| 204 | is($entries->get_entry_by_value($value), $entry, |
---|
| 205 | "$prefix: by value: $key: object"); |
---|
| 206 | } |
---|
| 207 | is($loaders[0]->get_number_of_calls_to_load_to(), 1, |
---|
| 208 | "$prefix: loaded once: 0"); |
---|
| 209 | is($loaders[1]->get_number_of_calls_to_load_to(), 1, |
---|
| 210 | "$prefix: loaded once: 1"); |
---|
| 211 | is($loaders[2]->get_number_of_calls_to_load_to(), 0, |
---|
| 212 | "$prefix: not loaded: 2"); |
---|
| 213 | for my $key (keys(%{$loaders[2]->get_data()})) { |
---|
| 214 | my $value = $loaders[2]->get_data()->{$key}; |
---|
| 215 | my $entry = $entries->get_entry_by_key($key); |
---|
| 216 | is($entry->get_key(), uc($key), "$prefix: by key: $key: key"); |
---|
| 217 | is($entries->get_entry_by_value($value), $entry, |
---|
| 218 | "$prefix: by value: $key: object"); |
---|
| 219 | } |
---|
| 220 | is($loaders[0]->get_number_of_calls_to_load_to(), 2, |
---|
| 221 | "$prefix: loaded once: 0"); |
---|
| 222 | is($loaders[1]->get_number_of_calls_to_load_to(), 1, |
---|
| 223 | "$prefix: loaded once: 1"); |
---|
| 224 | is($loaders[2]->get_number_of_calls_to_load_to(), 1, |
---|
| 225 | "$prefix: not loaded: 2"); |
---|
| 226 | } |
---|
| 227 | |
---|
| 228 | __END__ |
---|