File Coverage

blib/lib/Lingua/Thesaurus/Term.pm
Criterion Covered Total %
statement 12 33 36.3
branch 0 2 0.0
condition 0 5 0.0
subroutine 6 7 85.7
pod 2 2 100.0
total 20 49 40.8


line stmt bran cond sub pod time code
1             package Lingua::Thesaurus::Term;
2 4     4   2410 use 5.010;
  4         11  
3 4     4   15 use Moose;
  4         4  
  4         25  
4 5     5   130 use overload '""' => sub {$_[0]->string},
5 4     4   17921 'eq' => sub {$_[0]->string eq $_[1]};
  4     1   4  
  4         33  
  1         108  
6              
7             #DO NOT "use namespace::clean -except => 'meta'" BECAUSE it sweeps 'overload'
8              
9             has 'storage' => (is => 'ro', does => 'Lingua::Thesaurus::Storage',
10             required => 1,
11             documentation => "storage object from which this term was issued");
12              
13             has 'id' => (is => 'ro', isa => 'Str', required => 1,
14             documentation => "unique storage id for the term");
15              
16             has 'string' => (is => 'ro', isa => 'Str', required => 1,
17             documentation => "the term itself");
18              
19             has 'origin' => (is => 'ro', isa => 'Maybe[Str]',
20             documentation => "where this term was found");
21              
22             __PACKAGE__->meta->make_immutable;
23              
24             sub related {
25 5     5 1 9 my ($self, $rel_ids) = @_;
26              
27 5         136 return $self->storage->related($self->id, $rel_ids);
28             }
29              
30             sub transitively_related {
31 0     0 1   my ($self, $rel_ids, $max_depth) = @_;
32 0   0       $max_depth //= 50;
33              
34 0 0         $rel_ids
35             or die "missing relation type(s) for method 'transitively_related()'";
36 0           my @results;
37 0           my @terms = ($self);
38 0           my %seen = ($self->id => 1);
39 0           my $level = 1;
40 0   0       while ($level < $max_depth && @terms) {
41 0           my @next_related;
42 0           foreach my $term (@terms) {
43 0           my @step_related = $term->related($rel_ids);
44 0           my @new_terms = grep {!$seen{$_->[1]->id}} @step_related;
  0            
45 0           push @next_related, map {[@$_, $term, $level]} @new_terms;
  0            
46 0           $seen{$_->[1]->id} = 1 foreach @new_terms;
47             }
48 0           @terms = map {$_->[1]} @next_related;
  0            
49 0           push @results, @next_related;
50 0           $level += 1;
51             }
52 0           return @results;
53             }
54              
55             1;
56              
57             __END__
58              
59             =head1 NAME
60              
61             Lingua::Thesaurus::Term - parent class for thesaurus terms
62              
63             =head1 SYNOPSIS
64              
65             my $term = $thesaurus->fetch_term($term_string);
66              
67             # methods for specific relations
68             my $scope_note = $term->SN;
69             my @synonyms = $term->UF;
70              
71             # exploring several relations at once
72             foreach my $pair ($term->related(qw/NT RT/)) {
73             my ($rel_type, $item) = @$pair;
74             printf " %s(%s) = %s\n", $rel_type->description, $rel_type->rel_id, $item;
75             }
76              
77             # transitive search
78             foreach my $quadruple ($term->transitively_related(qw/NT/)) {
79             my ($rel_type, $related_term, $through_term, $level) = @$quadruple;
80             printf " %s($level): %s (through %s)\n",
81             $rel_type->rel_id,
82             $level,
83             $related_term->string,
84             $through_term->string;
85             }
86              
87             =head1 DESCRIPTION
88              
89             Objects of this class encapsulate terms in a thesaurus.
90             They possess methods for navigating through relations, reaching
91             other terms or external data.
92              
93             =head1 CONSTRUCTOR
94              
95             =head2 new
96              
97             my $term = Lingua::Thesaurus::Term->new(
98             storage => $storage, # an object playing role Lingua::Thesaurus::Storage
99             id => $id, # unique id for this term
100             string => $string, # the actual term string
101             origin => $origin, # an identifier for the file where this term was found
102             );
103              
104             Creates a new term object; not likely to be called from client code,
105             because such objects are created automatically
106             from the thesaurus through
107             L<Lingua::Thesaurus/"search_terms"> and
108             L<Lingua::Thesaurus/"fetch_term"> methods.
109              
110              
111             =head1 ATTRIBUTES
112              
113             =head2 storage
114              
115             Reference to the storage object
116             from which this term was issued.
117              
118             =head2 id
119              
120             unique storage id for the term
121              
122             =head2 string
123              
124             the term itself
125              
126             =head2 origin
127              
128             tagname of the dumpfile where this term was found
129              
130              
131             =head1 METHODS
132              
133             =head2 related
134              
135             my @pairs = $term->related(@relation_ids);
136              
137             Returns a list of items related to the current term, through
138             one or several C<@relation_ids>.
139             Each returned item is a pair, where the first element is
140             an instance of L<Lingua::Thesaurus::RelType>,
141             and the second element is either a plain string (when the relation
142             type is "external"), or another term (when the relation type is "internal").
143              
144             =head2 NT, BT, etc.
145              
146             my @narrower_terms = $term->NT;
147             my $broader_term = $term->BT;
148             ...
149              
150             Specific navigation methods, such as C<NT>, C<BT>, etc., depend on the
151             relation types declared in the thesaurus; once those relations are known,
152             a subclass of C<Lingua::Thesaurus::Term> is automatically created, with
153             the appropriate additional methods.
154              
155             Internally these methods are implemented of course by calling the
156             L</"related"> method described above; but instead or returning
157             a list of pairs, they just return related items (since the relation type is
158             explicitly requested in the method call, it would be useless to return
159             it again as a result). The result is either a list or a single related item,
160             depending on the calling context.
161              
162             =head2 transitively_related
163              
164             my @quadruples = $term->transitively_related(@relation_ids);
165              
166             Returns a list of items directly or indirectly related to the current term,
167             through one or several C<@relation_ids>.
168             Each returned item is a quadruple, where the first two elements
169             are as in the L</"related> method, and the two remaining elements
170             are
171              
172             =over
173              
174             =item *
175              
176             the last intermediate term through wich this relation was reached
177              
178             =item *
179              
180             the level of transitive steps
181              
182             =back
183