File Coverage

blib/lib/AnyData2/Storage/File.pm
Criterion Covered Total %
statement 34 45 75.5
branch 6 14 42.8
condition n/a
subroutine 9 13 69.2
pod 4 4 100.0
total 53 76 69.7


line stmt bran cond sub pod time code
1             package AnyData2::Storage::File;
2              
3 3     3   848 use 5.008001;
  3         7  
  3         90  
4 3     3   10 use strict;
  3         3  
  3         87  
5 3     3   11 use warnings FATAL => 'all';
  3         4  
  3         101  
6              
7 3     3   9 use base qw(AnyData2::Storage);
  3         4  
  3         963  
8              
9 3     3   13 use Carp qw/croak/;
  3         3  
  3         107  
10 3     3   10 use Fcntl qw(:seek);
  3         4  
  3         347  
11 3     3   1602 use IO::File ();
  3         21788  
  3         80  
12 3     3   22 use Module::Runtime qw(require_module);
  3         4  
  3         21  
13              
14             =head1 NAME
15              
16             AnyData2::Storage::File - AnyData2 file storage
17              
18             =cut
19              
20             our $VERSION = '0.001';
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 6 my ( $class, %options ) = @_;
48 2         12 my $self = $class->SUPER::new();
49 2 100       11 defined $options{filemode} or $options{filemode} = "r";
50 2         5 my @openparms = qw(filename filemode);
51 2 100       6 unless ( $options{filemode} =~ m/^[<>]/ )
52             {
53 1 50       2 defined $options{fileperms} or $options{fileperms} = 0644;
54 1         2 push @openparms, qw(fileperms);
55             }
56 2 50       10 $self->{fh} = IO::File->new( @options{@openparms} ) or die "Can't open $options{filename}: $!";
57 2         180 @$self{qw(filename filemode fileperms)} = @options{qw(filename filemode fileperms)};
58 2         6 $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 meta
91              
92             Experimental
93              
94             Returns a meta storage - if any. Imaging it as an object dealing with
95             underlying filesystem for a file storage.
96              
97             =cut
98              
99             sub _build_meta
100             {
101 0     0     my $self = shift;
102 0           require_module("AnyData2::Format::FileSystem");
103 0           AnyData2::Format::FileSystem->new( dirname => dirname( $self->{filename} ) );
104             }
105              
106             sub meta
107             {
108 0     0 1   my $self = shift;
109 0 0         $self->{meta} or $self->{meta} = $self->_build_meta;
110 0           $self->{meta};
111             }
112              
113             =head1 LICENSE AND COPYRIGHT
114              
115             Copyright 2015 Jens Rehsack.
116              
117             This program is free software; you can redistribute it and/or modify it
118             under the terms of either: the GNU General Public License as published
119             by the Free Software Foundation; or the Artistic License.
120              
121             See http://dev.perl.org/licenses/ for more information.
122              
123             If your Modified Version has been derived from a Modified Version made
124             by someone other than you, you are nevertheless required to ensure that
125             your Modified Version complies with the requirements of this license.
126              
127             This license does not grant you the right to use any trademark, service
128             mark, tradename, or logo of the Copyright Holder.
129              
130             This license includes the non-exclusive, worldwide, free-of-charge
131             patent license to make, have made, use, offer to sell, sell, import and
132             otherwise transfer the Package with respect to any patent claims
133             licensable by the Copyright Holder that are necessarily infringed by the
134             Package. If you institute patent litigation (including a cross-claim or
135             counterclaim) against any party alleging that the Package constitutes
136             direct or contributory patent infringement, then this License
137             to you shall terminate on the date that such litigation is filed.
138              
139             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
140             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
141             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
142             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
143             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
144             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
145             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
146             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
147              
148             =cut
149              
150             1;