File Coverage

blib/lib/Filesys/POSIX/Mem/Bucket.pm
Criterion Covered Total %
statement 111 111 100.0
branch 58 58 100.0
condition 5 5 100.0
subroutine 18 18 100.0
pod 6 7 85.7
total 198 199 99.5


line stmt bran cond sub pod time code
1             # Copyright (c) 2014, cPanel, Inc.
2             # All rights reserved.
3             # http://cpanel.net/
4             #
5             # This is free software; you can redistribute it and/or modify it under the same
6             # terms as Perl itself. See the LICENSE file for further details.
7              
8             package Filesys::POSIX::Mem::Bucket;
9              
10 27     27   91 use strict;
  27         21  
  27         568  
11 27     27   76 use warnings;
  27         26  
  27         450  
12              
13 27     27   75 use Filesys::POSIX::Bits;
  27         25  
  27         5904  
14 27     27   9025 use Filesys::POSIX::Bits::System;
  27         47  
  27         617  
15 27     27   9093 use Filesys::POSIX::IO::Handle ();
  27         40  
  27         415  
16 27     27   100 use Filesys::POSIX::Error qw(throw);
  27         24  
  27         931  
17              
18 27     27   86 use Fcntl;
  27         25  
  27         4992  
19 27     27   109 use Carp ();
  27         24  
  27         383  
20 27     27   15815 use File::Temp ();
  27         364002  
  27         21511  
21              
22             =head1 NAME
23              
24             Filesys::POSIX::Mem::Bucket - Regular file I/O handle
25              
26             =head1 DESCRIPTION
27              
28             C provides an implementation of the interface in
29             L that allows access to the regular file data of a
30             file in a L filesystem hierarchy.
31              
32             Internally, the bucket can store up to a specified maximum number of bytes until
33             said data is flushed to a temporary file on disk, backed by L.
34              
35             =cut
36              
37             our @ISA = ('Filesys::POSIX::IO::Handle');
38              
39             my $DEFAULT_MAX = 16384;
40             my $DEFAULT_DIR = '/tmp';
41              
42             sub new {
43 73     73 1 862 my ( $class, %opts ) = @_;
44              
45             return bless {
46             'fh' => undef,
47             'buf' => '',
48             'max' => defined $opts{'max'} ? $opts{'max'} : $DEFAULT_MAX,
49             'dir' => defined $opts{'dir'} ? $opts{'dir'} : $DEFAULT_DIR,
50 73 100       522 'inode' => $opts{'inode'},
    100          
51             'size' => 0,
52             'pos' => 0
53             }, $class;
54             }
55              
56             sub DESTROY {
57 12     12   3127 my ($self) = @_;
58              
59 12 100       35 close $self->{'fh'} if $self->{'fh'};
60              
61 12 100 100     100 if ( $self->{'file'} && -f $self->{'file'} ) {
62 4         220 unlink $self->{'file'};
63             }
64             }
65              
66             sub open {
67 97     97 0 216 my ( $self, $flags ) = @_;
68 97   100     170 $flags ||= 0;
69              
70 97 100       249 throw &Errno::EBUSY if $self->{'fh'};
71              
72 96         95 $self->{'pos'} = 0;
73              
74 96 100       280 if ( $flags & $O_APPEND ) {
    100          
75 4         5 $self->{'pos'} = $self->{'size'};
76             }
77             elsif ( $flags & ( $O_CREAT | $O_TRUNC ) ) {
78 73         66 $self->{'size'} = 0;
79 73         65 $self->{'inode'}->{'size'} = 0;
80              
81 73         81 undef $self->{'buf'};
82 73         81 $self->{'buf'} = '';
83             }
84              
85 96 100       153 if ( $self->{'file'} ) {
86 5         13 my $fcntl_flags = Filesys::POSIX::Bits::System::convertFlagsToSystem($flags);
87              
88 5 100       156 sysopen( my $fh, $self->{'file'}, $fcntl_flags ) or Carp::confess("$!");
89              
90 4         9 $self->{'fh'} = $fh;
91             }
92              
93 95         147 return $self;
94             }
95              
96             sub _flush_to_disk {
97 8     8   58 my ( $self, $len ) = @_;
98              
99 8 100       16 throw &Errno::EALREADY if $self->{'file'};
100              
101             my ( $fh, $file ) =
102 7         7 eval { File::Temp::mkstemp("$self->{'dir'}/.bucket-XXXXXX") };
  7         23  
103              
104 7 100       1932 Carp::confess("mkstemp() failure: $@") if $@;
105              
106 6         7 my $offset = 0;
107              
108 6         15 for ( my $left = $self->{'size'}; $left > 0; $left -= $len ) {
109 128 100       112 my $wrlen = $left > $len ? $len : $left;
110              
111 128         479 syswrite( $fh, substr( $self->{'buf'}, $offset, $wrlen ), $wrlen );
112              
113 128         196 $offset += $wrlen;
114             }
115              
116 6         8 @{$self}{qw(fh file)} = ( $fh, $file );
  6         22  
117             }
118              
119             sub write {
120 739     739 1 2412 my ( $self, $buf, $len ) = @_;
121 739         426 my $ret = 0;
122              
123             #
124             # If the current file position, plus the length of the intended write
125             # is to exceed the maximum memory bucket threshold, then dump the file
126             # to disk if it hasn't already happened.
127             #
128 739 100       933 if ( $self->{'pos'} + $len > $self->{'max'} ) {
129 72 100       92 $self->_flush_to_disk($len) unless $self->{'fh'};
130             }
131              
132 738 100       719 if ( $self->{'fh'} ) {
133             Carp::confess("Unable to write to disk bucket")
134 71 100       96 unless fileno( $self->{'fh'} );
135 70         439 $ret = syswrite( $self->{'fh'}, $buf );
136             }
137             else {
138 667 100       820 if ( ( my $gap = $self->{'pos'} - $self->{'size'} ) > 0 ) {
139 1         3 $self->{'buf'} .= "\x00" x $gap;
140             }
141              
142 667         656 substr( $self->{'buf'}, $self->{'pos'}, $len ) =
143             substr( $buf, 0, $len );
144 667         453 $ret = $len;
145             }
146              
147 737         506 $self->{'pos'} += $ret;
148 737         456 $self->{'size'} += $ret;
149              
150 737 100       829 if ( $self->{'pos'} > $self->{'size'} ) {
151 1         2 $self->{'size'} = $self->{'pos'};
152             }
153              
154 737         522 $self->{'inode'}->{'size'} = $self->{'size'};
155              
156 737         706 return $ret;
157             }
158              
159             sub read {
160 216     216 1 2828 my $self = shift;
161 216         94 my $len = pop;
162 216         149 my $ret = 0;
163              
164 216 100       228 if ( $self->{'fh'} ) {
165             Carp::confess("Unable to read bucket: $!")
166 198 100       229 unless fileno( $self->{'fh'} );
167 197         263 $ret = sysread( $self->{'fh'}, $_[0], $len );
168             }
169             else {
170             my $pos =
171 18 100       47 $self->{'pos'} > $self->{'size'} ? $self->{'size'} : $self->{'pos'};
172 18         14 my $maxlen = $self->{'size'} - $pos;
173 18 100       35 $len = $maxlen if $len > $maxlen;
174              
175 18 100       36 unless ($len) {
176 4         4 $_[0] = '';
177 4         12 return 0;
178             }
179              
180 14         40 $_[0] = substr( $self->{'buf'}, $self->{'pos'}, $len );
181 14         16 $ret = $len;
182             }
183              
184 211         176 $self->{'pos'} += $ret;
185              
186 211         214 return $ret;
187             }
188              
189             sub seek {
190 14     14 1 627 my ( $self, $pos, $whence ) = @_;
191 14         15 my $newpos;
192              
193 14 100       32 if ( $self->{'fh'} ) {
    100          
    100          
    100          
194 5         15 $newpos = sysseek( $self->{'fh'}, $pos, $whence );
195             }
196             elsif ( $whence == $SEEK_SET ) {
197 6         7 $newpos = $pos;
198             }
199             elsif ( $whence == $SEEK_CUR ) {
200 1         3 $newpos = $self->{'pos'} + $pos;
201             }
202             elsif ( $whence == $SEEK_END ) {
203 1         2 $newpos = $self->{'size'} + $pos;
204             }
205             else {
206 1         6 throw &Errno::EINVAL;
207             }
208              
209 13         31 return $self->{'pos'} = $newpos;
210             }
211              
212             sub tell {
213 5     5 1 5 my ($self) = @_;
214              
215 5 100       17 if ( $self->{'fh'} ) {
216 1         5 return sysseek $self->{'fh'}, 0, 1;
217             }
218              
219 4         11 return $self->{'pos'};
220             }
221              
222             sub close {
223 86     86 1 2240 my ($self) = @_;
224              
225 86 100       166 if ( $self->{'fh'} ) {
226 7         43 close $self->{'fh'};
227 7         12 undef $self->{'fh'};
228             }
229              
230 86         126 $self->{'pos'} = 0;
231             }
232              
233             =head1 SEE ALSO
234              
235             =over
236              
237             =item L
238              
239             =back
240              
241             =cut
242              
243             1;
244              
245             __END__