File Coverage

blib/lib/Search/ByPrefix.pm
Criterion Covered Total %
statement 24 25 96.0
branch 1 2 50.0
condition 3 4 75.0
subroutine 6 6 100.0
pod 3 3 100.0
total 37 40 92.5


line stmt bran cond sub pod time code
1             package Search::ByPrefix;
2              
3 2     2   120754 use 5.010;
  2         15  
4 2     2   10 use strict;
  2         3  
  2         38  
5 2     2   8 use warnings;
  2         3  
  2         528  
6              
7             =encoding utf8
8              
9             =head1 NAME
10              
11             Search::ByPrefix - An efficient, tree-based, multi-match prefix searcher.
12              
13             =head1 VERSION
14              
15             Version 0.04
16              
17             =cut
18              
19             our $VERSION = '0.04';
20              
21             =head1 SYNOPSIS
22              
23             B works by creating an internal table from a list of
24             key/value pairs, where each key is an array.
25              
26             Then, this table can be efficiently searched with an array prefix-key,
27             which finds and returns all the values that have this certain prefix.
28              
29             use Search::ByPrefix;
30             my $sbp = Search::ByPrefix->new;
31              
32             # Add an entry
33             $sbp->add($key, $value); # where $key is an array
34              
35             # Search by a prefix
36             my @matches = $sbp->search($prefix); # where $prefix is an array
37              
38             =head1 METHODS
39              
40             =head2 new
41              
42             Creates and returns a new object.
43              
44             my $sbp = Search::ByPrefix->new(%opt);
45              
46             Where C<%opt> can have the following keys:
47              
48             =over 2
49              
50             =item * table => {}
51              
52             The value of the C must be a multidimensional hash-like data structure.
53              
54             Starting with version 0.04, using a L database is also supported.
55              
56             =item * special_key => "\0\0\1\0\0"
57              
58             Special unique key, used internally to store the original values.
59              
60             =back
61              
62             =cut
63              
64             sub new {
65 1     1 1 832 my ($class, %opt) = @_;
66             bless {
67              
68             table => $opt{table} // {},
69 1   50     12 special_key => "\0\0\1\0\0",
70              
71             }, $class;
72             }
73              
74             =head2 add
75              
76             $sbp->add($key, $value);
77              
78             The C<$key> must be an array, where its granularity controls the matching.
79              
80             my $key = ['f','o','o','-','b','a','r'];
81             my $value = 'foo-bar';
82             $sbp->add($key, $value);
83              
84             or:
85              
86             my $key = ['my', 'dir', 'path'];
87             my $value = 'my/dir/path';
88             $sbp->add($key, $value);
89              
90             =cut
91              
92             sub add {
93 11     11 1 217 my ($self, $key, $value) = @_;
94              
95 11         18 my $ref = $self->{table};
96              
97 11         15 foreach my $item (@$key) {
98 64   100     135 $ref = $ref->{$item} //= {};
99 64         67 push @{$ref->{$self->{special_key}}}, $value;
  64         102  
100             }
101              
102 11         23 $self;
103             }
104              
105             =head2 search
106              
107             my @matches = $sbp->search($prefix);
108              
109             Searches and returns a list of values that have a certain prefix,
110             where each value is the original value associated with the matched key.
111              
112             The C<$prefix> must be an array, where its granularity controls the matching.
113              
114             my $prefix = ['f','o'];
115             my @values = $sbp->search($prefix); # finds: ('foo-bar')
116              
117             or:
118              
119             my $prefix = ['my', 'dir'];
120             my @values = $sbp->search($prefix); # finds: ('my/dir/path')
121              
122             =cut
123              
124             sub search {
125 1     1 1 9 my ($self, $prefix) = @_;
126              
127 1         3 my $ref = $self->{table};
128              
129 1         3 foreach my $item (@$prefix) {
130 4 50       6 if (exists $ref->{$item}) {
131 4         7 $ref = $ref->{$item};
132             }
133             else {
134 0         0 return;
135             }
136             }
137              
138 1         1 @{$ref->{$self->{special_key}}};
  1         5  
139             }
140              
141             =head1 EXAMPLE
142              
143             This example illustrates how to add some key/value pairs to the table
144             and how to search the table with a given prefix:
145              
146             use 5.010;
147             use Search::ByPrefix;
148             my $obj = Search::ByPrefix->new;
149              
150             sub make_key {
151             [split('/', $_[0])]
152             }
153              
154             foreach my $dir (
155             qw(
156             /home/user1/tmp/coverage/test
157             /home/user1/tmp/covert/operator
158             /home/user1/tmp/coven/members
159             /home/user2/tmp/coven/members
160             /home/user1/tmp2/coven/members
161             )
162             ) {
163             $obj->add(make_key($dir), $dir);
164             }
165              
166             # Finds the directories that have this common path
167             say for $obj->search(make_key('/home/user1/tmp'));
168              
169             The results are:
170              
171             "/home/user1/tmp/coverage/test"
172             "/home/user1/tmp/covert/operator"
173             "/home/user1/tmp/coven/members"
174              
175             =head1 REPOSITORY
176              
177             L
178              
179             =head1 AUTHOR
180              
181             Daniel Șuteu, C<< >>
182              
183             =head1 LICENSE AND COPYRIGHT
184              
185             Copyright 2016-2022 Daniel Șuteu.
186              
187             This program is free software; you can redistribute it and/or modify it
188             under the terms of the the Artistic License (2.0). You may obtain a
189             copy of the full license at:
190              
191             L
192              
193             =cut
194              
195             1; # End of Search::ByPrefix