File Coverage

blib/lib/AnyData2/Storage/File.pm
Criterion Covered Total %
statement 33 47 70.2
branch 6 16 37.5
condition n/a
subroutine 9 14 64.2
pod 5 5 100.0
total 53 82 64.6


line stmt bran cond sub pod time code
1             package AnyData2::Storage::File;
2              
3 3     3   667 use 5.008001;
  3         6  
4 3     3   8 use strict;
  3         3  
  3         49  
5 3     3   8 use warnings FATAL => 'all';
  3         3  
  3         80  
6              
7 3     3   9 use base qw(AnyData2::Storage);
  3         4  
  3         925  
8              
9 3     3   10 use Carp qw/croak/;
  3         4  
  3         97  
10 3     3   8 use Fcntl qw(:seek);
  3         3  
  3         306  
11 3     3   1188 use IO::File ();
  3         18264  
  3         67  
12 3     3   12 use Module::Runtime qw(require_module);
  3         3  
  3         15  
13              
14             =head1 NAME
15              
16             AnyData2::Storage::File - AnyData2 file storage
17              
18             =cut
19              
20             our $VERSION = '0.002';
21              
22             =head1 DESCRIPTION
23              
24             Base class for L and L to handle common stuff
25              
26             =head1 METHODS
27              
28             =head2 new
29              
30             my $as2 = AnyData2::Storage::File->new(
31             filename => "data.ext",
32             filemode => "r",
33             fileperms => 0644
34             );
35              
36             my $as2 = AnyData2::Storage::File->new(
37             filename => "data.ext",
38             filemode => "<:raw"
39             );
40              
41             constructs a storage.
42              
43             =cut
44              
45             sub new
46             {
47 2     2 1 4 my ( $class, %options ) = @_;
48 2         10 my $self = $class->SUPER::new();
49 2 100       14 defined $options{filemode} or $options{filemode} = "r";
50 2         3 my @openparms = qw(filename filemode);
51 2 100       7 unless ( $options{filemode} =~ m/^[<>]/ )
52             {
53 1 50       3 defined $options{fileperms} or $options{fileperms} = 0644;
54 1         2 push @openparms, qw(fileperms);
55             }
56 2 50       7 $self->{fh} = IO::File->new( @options{@openparms} ) or die "Can't open $options{filename}: $!";
57 2         147 @$self{qw(filename filemode fileperms)} = @options{qw(filename filemode fileperms)};
58 2         7 $self;
59             }
60              
61             =head2 seek
62              
63             $stor->seek(pos, whence)
64              
65             Moves the storage pointer to given position. See L for details.
66              
67             =cut
68              
69             sub seek
70             {
71 0     0 1   my ( $self, $pos, $whence ) = @_;
72 0 0         $self->{fh}->seek( $pos, $whence ) or croak "Can't seek to $pos from $whence for $self->{filename}: $!";
73 0           "0E0";
74             }
75              
76             =head2 truncate
77              
78             $stor->truncate
79              
80             Truncates the underlying storage backend at it's current position.
81              
82             =cut
83              
84             sub truncate
85             {
86 0     0 1   my $self = shift;
87 0 0         $self->{fh}->truncate( $self->{fh}->tell() ) or die "Can't truncate $self->{filename}: $!";
88             }
89              
90             =head2 drop
91              
92             $stor->drop
93              
94             Drops the underlying storage (e.g. delete file)
95              
96             =cut
97              
98             sub drop
99             {
100 0     0 1   my $self = shift;
101 0 0         $self->{fh} and $self->{fh}->close;
102 0           unlink $self->{filename};
103             }
104              
105             =head2 meta
106              
107             Experimental
108              
109             Returns a meta storage - if any. Imaging it as an object dealing with
110             underlying filesystem for a file storage.
111              
112             =cut
113              
114             sub _build_meta
115             {
116 0     0     my $self = shift;
117 0           require_module("AnyData2::Format::FileSystem");
118 0           AnyData2::Format::FileSystem->new( dirname => dirname( $self->{filename} ) );
119             }
120              
121             sub meta
122             {
123 0     0 1   my $self = shift;
124 0 0         $self->{meta} or $self->{meta} = $self->_build_meta;
125 0           $self->{meta};
126             }
127              
128             =head1 LICENSE AND COPYRIGHT
129              
130             Copyright 2015,2016 Jens Rehsack.
131              
132             This program is free software; you can redistribute it and/or modify it
133             under the terms of either: the GNU General Public License as published
134             by the Free Software Foundation; or the Artistic License.
135              
136             See http://dev.perl.org/licenses/ for more information.
137              
138             If your Modified Version has been derived from a Modified Version made
139             by someone other than you, you are nevertheless required to ensure that
140             your Modified Version complies with the requirements of this license.
141              
142             This license does not grant you the right to use any trademark, service
143             mark, tradename, or logo of the Copyright Holder.
144              
145             This license includes the non-exclusive, worldwide, free-of-charge
146             patent license to make, have made, use, offer to sell, sell, import and
147             otherwise transfer the Package with respect to any patent claims
148             licensable by the Copyright Holder that are necessarily infringed by the
149             Package. If you institute patent litigation (including a cross-claim or
150             counterclaim) against any party alleging that the Package constitutes
151             direct or contributory patent infringement, then this License
152             to you shall terminate on the date that such litigation is filed.
153              
154             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
155             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
156             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
157             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
158             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
159             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
160             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
161             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
162              
163             =cut
164              
165             1;