1 |
dpavlin |
410 |
package WebPAC::Index; |
2 |
|
|
|
3 |
|
|
use warnings; |
4 |
|
|
use strict; |
5 |
|
|
|
6 |
|
|
use Carp; |
7 |
dpavlin |
512 |
use Tie::Array::Sorted::Lazy; |
8 |
dpavlin |
410 |
use Log::Log4perl qw(get_logger :levels); |
9 |
|
|
|
10 |
|
|
=head1 NAME |
11 |
|
|
|
12 |
|
|
WebPAC::Index - create sorted index |
13 |
|
|
|
14 |
|
|
=head1 DESCRIPTION |
15 |
|
|
|
16 |
|
|
This module will create sorted index by headline (like thesaurus). |
17 |
|
|
|
18 |
|
|
=head1 METHODS |
19 |
|
|
|
20 |
|
|
=head2 new |
21 |
|
|
|
22 |
|
|
Create new sorted index object |
23 |
|
|
|
24 |
|
|
my $thes = new WebPAC::Index( |
25 |
|
|
log => 'log4perl.conf', |
26 |
dpavlin |
511 |
name => 'index name', |
27 |
dpavlin |
410 |
); |
28 |
|
|
|
29 |
|
|
C<log> is optional parametar which specify filename of L<Log::Log4Perl> |
30 |
|
|
config file. Default is C<log.conf>. |
31 |
|
|
|
32 |
dpavlin |
511 |
C<name> is optional parametar used to mark lines in log file with index |
33 |
|
|
name. |
34 |
|
|
|
35 |
dpavlin |
410 |
Default sort function is my C<headline>, non case sensitive. It can't be |
36 |
|
|
changed right now without editing of source. |
37 |
|
|
|
38 |
|
|
=cut |
39 |
|
|
|
40 |
|
|
sub new { |
41 |
|
|
my $class = shift; |
42 |
|
|
my $self = {@_}; |
43 |
|
|
bless($self, $class); |
44 |
|
|
|
45 |
|
|
my $log_file = $self->{'log'} || "log.conf"; |
46 |
|
|
Log::Log4perl->init($log_file); |
47 |
|
|
|
48 |
dpavlin |
515 |
tie @{$self->{'index'}}, "Tie::Array::Sorted::Lazy", sub { |
49 |
dpavlin |
410 |
lc( $_[0]->{'headline'} ) cmp lc( $_[1]->{'headline'} ) |
50 |
|
|
}; |
51 |
|
|
|
52 |
|
|
return $self; |
53 |
|
|
} |
54 |
|
|
|
55 |
|
|
=head2 insert |
56 |
|
|
|
57 |
|
|
Insert data into index |
58 |
|
|
|
59 |
|
|
$index->insert( |
60 |
|
|
headline => 'headline text', |
61 |
dpavlin |
448 |
mfn => '99', |
62 |
dpavlin |
410 |
); |
63 |
|
|
|
64 |
|
|
=cut |
65 |
|
|
|
66 |
|
|
sub insert { |
67 |
|
|
my $self = shift; |
68 |
|
|
|
69 |
|
|
my $data = {@_}; |
70 |
|
|
|
71 |
|
|
my $log = $self->_get_logger(); |
72 |
|
|
|
73 |
dpavlin |
448 |
$log->logconfess("need headline and mfn!") unless (defined($data->{'headline'}) && defined($data->{'mfn'})); |
74 |
dpavlin |
411 |
|
75 |
dpavlin |
410 |
push @{$self->{'index'}}, $data; |
76 |
|
|
|
77 |
dpavlin |
511 |
my $name = ''; |
78 |
|
|
$name = $self->{'name'}." " if ($self->{'name'}); |
79 |
dpavlin |
410 |
|
80 |
dpavlin |
511 |
$log->debug("stored ",$name,$data->{'mfn'},": ",$data->{'headline'}); |
81 |
|
|
|
82 |
dpavlin |
410 |
} |
83 |
|
|
|
84 |
|
|
=head2 elements |
85 |
|
|
|
86 |
|
|
Get all elements (sorted by locale) from sorted index. |
87 |
|
|
|
88 |
|
|
my @e = $index->elements; |
89 |
|
|
|
90 |
|
|
Each element is hash containing C<path> and C<headline>. |
91 |
|
|
|
92 |
|
|
print $e[0]->{'headline'}," is ",$e[0]->{'path'},"\n"; |
93 |
|
|
|
94 |
|
|
=cut |
95 |
|
|
|
96 |
|
|
sub elements { |
97 |
|
|
my $self = shift; |
98 |
|
|
|
99 |
|
|
my $log = $self->_get_logger(); |
100 |
|
|
|
101 |
|
|
$log->debug(scalar(@{$self->{'index'}})." elements in index"); |
102 |
|
|
|
103 |
|
|
return @{$self->{'index'}}; |
104 |
|
|
} |
105 |
|
|
|
106 |
|
|
# |
107 |
|
|
|
108 |
|
|
=head1 INTERNAL METHODS |
109 |
|
|
|
110 |
|
|
You shouldn't call this methods directly. |
111 |
|
|
|
112 |
|
|
=head2 _get_logger |
113 |
|
|
|
114 |
|
|
Get C<Log::Log4perl> object with a twist: domains are defined for each |
115 |
|
|
method |
116 |
|
|
|
117 |
|
|
my $log = $webpac->_get_logger(); |
118 |
|
|
|
119 |
|
|
=cut |
120 |
|
|
|
121 |
|
|
sub _get_logger { |
122 |
|
|
my $self = shift; |
123 |
|
|
|
124 |
|
|
my $name = (caller(1))[3] || caller; |
125 |
|
|
return get_logger($name); |
126 |
|
|
} |
127 |
|
|
|
128 |
|
|
1; |