File Coverage

blib/lib/Lingua/Thesaurus/Storage.pm
Criterion Covered Total %
statement 37 37 100.0
branch 4 4 100.0
condition 2 4 50.0
subroutine 18 18 100.0
pod n/a
total 61 63 96.8


line stmt bran cond sub pod time code
1             package Lingua::Thesaurus::Storage;
2 7     7   6679 use Moose::Role;
  7         18243  
  7         25  
3 7     7   14385 use Moose::Meta::Class;
  7         8  
  7         203  
4 7     7   22 use namespace::clean -except => 'meta';
  7         8  
  7         43  
5              
6             #======================================================================
7             # ATTRIBUTES
8             #======================================================================
9              
10             has 'params' => (is => 'ro', isa => 'HashRef',
11             lazy => 1, builder => '_params',
12             predicate => 'has_params',
13             documentation => "params saved in storage");
14              
15             has 'term_class' => (is => 'ro', isa => 'ClassName',
16             lazy => 1, builder => '_build_term_class',
17             init_arg => undef,
18             documentation => "dynamic class for terms");
19              
20             has 'relType_class' => (is => 'ro', isa => 'ClassName',
21             lazy => 1, builder => '_relType_class',
22             init_arg => undef,
23             documentation => "class for relTypes");
24              
25             #======================================================================
26             # REQUIRED METHODS
27             #======================================================================
28              
29             requires 'search_terms';
30             requires 'fetch_term';
31             requires 'related';
32             requires 'rel_types';
33             requires 'fetch_rel_type';
34              
35             requires 'do_transaction';
36             requires 'initialize';
37             requires 'store_rel_type';
38             requires 'store_relation';
39             requires 'store_term';
40             requires 'finalize';
41              
42             requires '_params';
43              
44             #======================================================================
45             # IMPLEMENTED METHODS
46             #======================================================================
47              
48             sub _build_term_class {
49 4     4   7 my ($self) = @_;
50              
51             # compute subclass name from the list of possible relations
52 4         15 my @rel_ids = $self->rel_types;
53 4         34 my $subclass_name = join "_", "auto", sort @rel_ids;
54 4         13 my $parent_class = $self->_parent_term_class;
55 4         15 my $pkg_name = "${parent_class}::${subclass_name}";
56              
57             # build subclass (only if it does not already exist)
58 7     7   2110 no strict 'refs';
  7         8  
  7         1571  
59 4 100       34 unless (%{$pkg_name."::"}) {
  4         39  
60             # build a closure for each relation type (NT, BT, etc.)
61 3         5 my %methods;
62 3         6 foreach my $rel_id (@rel_ids) {
63 5     5   766 $methods{$rel_id} = sub {my $self = shift;
        5      
        5      
        5      
        5      
        5      
        5      
        5      
        5      
        5      
        5      
64 5         21 my @rel = map {$_->[1]} $self->related($rel_id);
  14         20  
65 30 100       73 return wantarray ? @rel : $rel[0];};
  5         16  
66             }
67              
68             # dynamically create a new subclass
69 3         18 my $meta_subclass = Moose::Meta::Class->create(
70             $pkg_name,
71             superclasses => [$parent_class],
72             methods => \%methods,
73             );
74 3         5249 $meta_subclass->make_immutable;
75             }
76              
77 4         797 return $pkg_name;
78             }
79              
80              
81              
82             sub _parent_term_class {
83 4     4   6 my $self = shift;
84             my $parent_term_class = $self->params->{term_class}
85 4   50     128 || 'Lingua::Thesaurus::Term';
86 4         18 Module::Load::load $parent_term_class;
87 4         146 return $parent_term_class;
88             }
89              
90              
91             sub _relType_class {
92 5     5   5 my $self = shift;
93             my $relType_class = $self->params->{relType_class}
94 5   50     170 || 'Lingua::Thesaurus::RelType';
95 5         17 Module::Load::load $relType_class;
96 5         223 return $relType_class;
97             }
98              
99             1;
100              
101             __END__
102              
103             =head1 NAME
104              
105             Lingua::Thesaurus::Storage - Role for thesaurus storage
106              
107             =head1 DESCRIPTION
108              
109             This role specifies the interface for thesaurus storage classes.
110              
111              
112             =head1 METHODS
113              
114             =head2 Retrieval methods
115              
116             =head3 search_terms
117              
118             Implementation for L<Lingua::Thesaurus/"search_terms">.
119              
120             =head3 fetch_term
121              
122             Implementation for L<Lingua::Thesaurus/"fetch_term">.
123              
124             =head3 related
125              
126             Implementation for L<Lingua::Thesaurus::Term/"related">.
127              
128             =head3 rel_types
129              
130             Implementation for L<Lingua::Thesaurus/"rel_types">.
131              
132             =head3 fetch_rel_type
133              
134             Implementation for L<Lingua::Thesaurus/"fetch_rel_type">.
135              
136              
137             =head2 Populating the database
138              
139             =head3 initialize
140              
141             Called by an IO class to initialize storage before a load operation.
142              
143             =head3 do_transaction
144              
145             $storage->do_transaction($coderef);
146              
147             Will execute C<$coderef> within a transaction. This is used
148             by L<Lingua::Thesaurus::IO/"load"> to store all terms and relations
149             in a single step.
150              
151             =head3 store_term
152              
153             my $term_id = $storage->store_term($term_string);
154              
155             Stores a new term, and returns the unique storage id for this
156             term. Depending on the implementation, an exception could be raised if
157             several attempts are made to store the same C<$term_string>.
158              
159              
160             =head3 store_rel_type
161              
162             $storage->store_rel_type($rel_id, $description, $is_external);
163              
164             Stores a new relation type.
165              
166             =over
167              
168             =item *
169              
170             C<$rel_id> is a unique identifier string for this relation type
171             (such as C<'NT'> or C<'UF'>).
172              
173             =item *
174              
175             C<$description> is an optional free text description
176              
177             =item *
178              
179             C<$is_external> is a boolean which tells whether related items
180             will be other terms or external data.
181              
182             =back
183              
184              
185              
186             =head3 store_relation
187              
188             $storage->store_relation($term_id, $rel_id, $related,
189             $is_external, $inverse_id);
190              
191             Stores a relation, where
192              
193             =over
194              
195             =item *
196              
197             C<$term_id> is the unique identifier for the first term in the relation
198              
199             =item *
200              
201             C<$rel_id> is the unique identifier for relation type
202              
203             =item *
204              
205             C<$related> is an arrayref of items to relate to the term;
206             if C<$is_external> is true, these items can be any scalar;
207             if C<$is_external> is false, items should be identifiers of other terms.
208              
209             The storage should preserve the order of items in C<$related>, i.e.
210             the L</"related"> method should return items in the same order.
211              
212             =item *
213              
214             C<$is_external> is a boolean which tells what kind of items
215             are related, as explained above
216              
217             =item *
218              
219             C<$inverse_id> is the optional identifier of the inverse
220             relation type; if non-null, relations will be stored in both
221             directions.
222              
223             =back
224              
225              
226             =head3 finalize
227              
228             Will be called by IO classes after loading files.
229             Storage implementations may use this to perform cleanup operations if needed.