File Coverage

blib/lib/KinoSearch1/Store/FSInvIndex.pm
Criterion Covered Total %
statement 93 100 93.0
branch 27 48 56.2
condition n/a
subroutine 23 23 100.0
pod 1 11 9.0
total 144 182 79.1


line stmt bran cond sub pod time code
1             package KinoSearch1::Store::FSInvIndex;
2 40     40   243 use strict;
  40         75  
  40         1267  
3 40     40   191 use warnings;
  40         74  
  40         2737  
4 40     40   210 use KinoSearch1::Util::ToolSet;
  40         112  
  40         6032  
5 40     40   221 use base qw( KinoSearch1::Store::InvIndex );
  40         75  
  40         16822  
6              
7             our $LOCK_DIR; # used by FSLock
8              
9 40     40   22703 use File::Spec::Functions qw( canonpath catfile catdir tmpdir no_upwards );
  40         25921  
  40         3368  
10 40     40   240 use Fcntl;
  40         76  
  40         23684  
11              
12             BEGIN {
13 40     40   487 __PACKAGE__->init_instance_vars();
14              
15             # confirm or create a directory to put lockfiles in
16 40         1793 $LOCK_DIR = catdir( tmpdir, 'kinosearch_lockdir' );
17 40 50       6210 if ( !-d $LOCK_DIR ) {
18 0 0       0 mkdir $LOCK_DIR or die "couldn't mkdir '$LOCK_DIR': $!";
19 0         0 chmod 0777, $LOCK_DIR;
20             }
21             }
22              
23 40     40   268 use Digest::MD5 qw( md5_hex );
  40         160  
  40         2379  
24 40     40   26558 use KinoSearch1::Store::InStream;
  40         108  
  40         1070  
25 40     40   24602 use KinoSearch1::Store::OutStream;
  40         108  
  40         1124  
26 40     40   20373 use KinoSearch1::Store::FSLock;
  40         202  
  40         1051  
27 40     40   29883 use KinoSearch1::Index::IndexFileNames;
  40         115  
  40         55405  
28              
29             sub init_instance {
30 24     24 1 46 my $self = shift;
31              
32             # clean up path.
33 24         168 my $path = $self->{path} = canonpath( $self->{path} );
34              
35 24 100       89 if ( $self->{create} ) {
36             # clear out lockfiles related to this path
37 4         24 my $lock_prefix = $self->get_lock_prefix;
38 4 50       286 opendir( my $lock_dh, $LOCK_DIR )
39             or confess("Couldn't opendir '$LOCK_DIR': $!");
40 4         175 my @lockfiles = grep {/$lock_prefix/} readdir $lock_dh;
  8         109  
41 4 50       73 closedir $lock_dh
42             or confess("Couldn't closedir '$LOCK_DIR': $!");
43 4         19 for (@lockfiles) {
44 0         0 $_ = catfile( $LOCK_DIR, $_ );
45 0 0       0 unlink $_ or confess("couldn't unlink '$_': $!");
46             }
47              
48             # blast any existing index files
49 4 100       74 if ( -e $path ) {
50 2 50       44 opendir( my $invindex_dh, $path )
51             or confess("Couldn't opendir '$path': $!");
52 2         7 my @to_remove;
53 2         41 for ( readdir $invindex_dh ) {
54 6 100       49 if (/(^\w+\.(?:cfs|del)$)/) {
    50          
    50          
55 1         7 push @to_remove, $1;
56             }
57             elsif ( $_ eq 'segments' ) {
58 0         0 push @to_remove, 'segments';
59             }
60             elsif ( $_ eq 'delqueue' ) {
61 0         0 push @to_remove, 'delqueue';
62             }
63             }
64 2         16 for my $removable (@to_remove) {
65 1         11 $removable = catfile( $path, $removable );
66 1 50       98 unlink $removable
67             or confess "Couldn't unlink file '$removable': $!";
68             }
69 2 50       35 closedir $invindex_dh
70             or confess("Couldn't closedir '$path': $!");
71             }
72 4 100       56 if ( !-d $path ) {
73 2 50       169 mkdir $path or confess("Couldn't mkdir '$path': $!");
74             }
75             }
76              
77             # by now, we should have a directory, so throw an error if we don't
78 24 100       462 if ( !-d $path ) {
79 1 50       234 confess("Can't open invindex location '$path': $! ")
80             unless -e $path;
81 0         0 confess("invindex location '$path' isn't a directory");
82             }
83             }
84              
85             sub open_outstream {
86 182     182 0 293 my ( $self, $filename ) = @_;
87 182         823 my $filepath = catfile( $self->{path}, $filename );
88 182 50       11415 sysopen( my $fh, $filepath, O_CREAT | O_RDWR | O_EXCL )
89             or confess("Couldn't open file '$filepath': $!");
90 182         390 binmode($fh);
91 182         1889 return KinoSearch1::Store::OutStream->new($fh);
92             }
93              
94             sub open_instream {
95 215     215 0 392 my ( $self, $filename, $offset, $len ) = @_;
96 215         1167 my $filepath = catfile( $self->{path}, $filename );
97             # must be unbuffered, or PerlIO messes up with the shared handles
98 215 50       6821 open( my $fh, "<:unix", $filepath )
99             or confess("Couldn't open file '$filepath': $!");
100 215         377 binmode($fh);
101 215         3365 return KinoSearch1::Store::InStream->new( $fh, $offset, $len );
102             }
103              
104             sub list {
105 2     2 0 6 my $self = shift;
106 2 50       83 opendir( my $dh, $self->{path} )
107             or confess("Couldn't opendir '$self->{path}'");
108 2         49 my @files = no_upwards( readdir $dh );
109 2 50       76 closedir $dh or confess("Couldn't closedir '$self->{path}'");
110 2         16 return @files;
111             }
112              
113             sub file_exists {
114 295     295 0 475 my ( $self, $filename ) = @_;
115 295         6751 return -e catfile( $self->{path}, $filename );
116             }
117              
118             sub rename_file {
119 35     35 0 86 my ( $self, $from, $to ) = @_;
120 35         387 $_ = catfile( $self->{path}, $_ ) for ( $from, $to );
121 35 50       2716 rename( $from, $to )
122             or confess("couldn't rename file '$from' to '$to': $!");
123             }
124              
125             sub delete_file {
126 163     163 0 274 my ( $self, $filename ) = @_;
127 163         717 $filename = catfile( $self->{path}, $filename );
128 163 50       11612 unlink $filename or confess("couldn't unlink file '$filename': $!");
129             }
130              
131             sub slurp_file {
132 1     1 0 961 my ( $self, $filename ) = @_;
133 1         11 my $filepath = catfile( $self->{path}, $filename );
134 1 50       57 open( my $fh, "<", $filepath )
135             or confess("Couldn't open file '$filepath': $!");
136 1         3 binmode($fh);
137 1         7 local $/;
138 1         43 return <$fh>;
139             }
140              
141             sub make_lock {
142 69     69 0 1021 my $self = shift;
143 69         518 return KinoSearch1::Store::FSLock->new( @_, invindex => $self );
144             }
145              
146             # Create a hashed string derived from this invindex's path.
147             sub get_lock_prefix {
148 73     73 0 121 my $self = shift;
149 73         1010 return "kinosearch-" . md5_hex( canonpath( $self->{path} ) );
150             }
151              
152 1     1 0 7 sub close { }
153              
154             1;
155              
156             __END__