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