File Coverage

blib/lib/File/ArchivableFormats.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package File::ArchivableFormats;
2 3     3   213960 use Moose;
  3         1362917  
  3         32  
3              
4             # ABSTRACT: Be able to select archivable formats
5              
6 3     3   29807 use File::Basename qw(fileparse);
  3         12  
  3         797  
7 3     3   5119 use File::LibMagic;
  0            
  0            
8             use Image::ExifTool qw(ImageInfo);
9             use List::Util qw(first);
10             use Module::Pluggable::Object;
11             use Moose::Util::TypeConstraints;
12             # Only using it for insert dependency in cpanfile/Makefile.PL for
13             # Distzilla
14             use Archive::Zip qw();
15              
16             our $VERSION = '1.3';
17              
18             subtype 'PluginRole'
19             => as 'Object'
20             => where sub { $_->does('File::ArchivableFormats::Plugin') };
21              
22             has magic => (
23             is => 'ro',
24             isa => 'File::LibMagic',
25             lazy => 1,
26             default => sub { return File::LibMagic->new(); },
27             );
28              
29             has driver => (
30             is => 'ro',
31             isa => 'Str',
32             predicate => 'has_driver',
33             );
34              
35             has _driver => (
36             is => 'ro',
37             isa => 'PluginRole',
38             builder => '_build_driver',
39             lazy => 1,
40             );
41              
42             sub _build_driver {
43             my $self = shift;
44             return first { $_->name eq $self->driver } $self->installed_drivers;
45             }
46              
47             my @DRIVERS;
48              
49             sub installed_drivers {
50             if (!@DRIVERS) {
51             my $finder = Module::Pluggable::Object->new(
52             search_path => 'File::ArchivableFormats::Plugin',
53             instantiate => 'new',
54             );
55             @DRIVERS = $finder->plugins;
56             }
57             return @DRIVERS;
58             }
59              
60             sub identify_via_libexif {
61             my $self = shift;
62             my $info = ImageInfo(shift);
63              
64             if ($info->{MIMEType}) {
65             return { mime_type => $info->{MIMEType} };
66             }
67             return;
68             }
69              
70             sub identify_from_fh {
71             my ($self, $fh) = @_;
72              
73             my $info = $self->identify_via_libexif($fh);
74             if (!$info) {
75             $info = $self->magic->info_from_handle($fh);
76             }
77             return $self->identify_from_mimetype($info->{mime_type})
78              
79             }
80              
81             sub identify_from_path {
82             my ($self, $path) = @_;
83              
84             my $info = $self->identify_via_libexif($path);
85             if (!$info) {
86             $info = $self->magic->info_from_filename($path);
87             return $self->identify_from_mimetype($info->{mime_type})
88             }
89             return $self->identify_from_mimetype($info->{mime_type})
90             }
91              
92             sub parse_extension {
93             my ($self, $filename) = @_;
94              
95             my (undef, undef, $ext) = fileparse($filename, '\.[^\.]*');
96             return lc($ext);
97             }
98              
99             sub identify_from_mimetype {
100             my ($self, $mimetype) = @_;
101              
102             my %rv = ( mime_type => $mimetype );
103              
104             if ($self->has_driver) {
105             $rv{ $self->driver } = $self->_driver_mimetype($self->_driver, $mimetype);
106             }
107             else {
108             for my $driver ($self->installed_drivers) {
109             $rv{ $driver->name } = $self->_driver_mimetype($driver, $mimetype);
110             }
111             }
112              
113             return \%rv;
114             }
115              
116             sub _driver_mimetype {
117             my ($self, $driver, $mimetype) = @_;
118             return {
119             archivable => $driver->is_archivable($mimetype) || 0,
120             %{ $driver->allowed_extensions($mimetype) },
121             };
122              
123             }
124              
125             __PACKAGE__->meta->make_immutable;
126              
127             __END__
128              
129             =pod
130              
131             =encoding UTF-8
132              
133             =head1 NAME
134              
135             File::ArchivableFormats - Be able to select archivable formats
136              
137             =head1 VERSION
138              
139             version 1.3
140              
141             =head1 SYNOPSIS
142              
143             use File::ArchivableFormat;
144              
145             my $archive = File::ArchivableFormat->new();
146              
147             open my $fh, '<', 'path/to/file';
148              
149             my $result = $archive->identify_from_fh($fh);
150              
151             my $result = $archive->identify_from_path('/path/to/file');
152              
153             =head1 DESCRIPTION
154              
155             TODO: Add clear description
156              
157             =head1 ATTRIBUTES
158              
159             =head2 magic
160              
161             The L<File::LibMagic> accessor
162              
163             =head1 METHODS
164              
165             =head2 parse_extension
166              
167             Parses the filename and returns the extension. Uses
168             L<File::Basename/fileparse>
169              
170             =head2 identify_from_fh
171              
172             Identify the file from a file handle. Please note that this does not
173             work with a L<File::Temp> filehandle.
174              
175             Returns a data structure like this:
176              
177             {
178             # DANS is the Prefered format list
179             'DANS' => {
180             # Types tell you something about why something is on the
181             # prefered format list
182             'types' => [
183             'Plain text (Unicode)',
184             'Plain text (Non-Unicode)',
185             'Statistical data (data (.csv) + setup)',
186             'Raspter GIS (ASCII GRID)',
187             'Raspter GIS (ASCII GRID)'
188             ],
189             # The extensions by which belongs to the mime type/file
190             'allowed_extensions' => ['.asc', '.txt'],
191             # Boolean which tells you if the file is archivable and
192             # therfore prefered.
193             'archivable' => 1
194             },
195             'mime_type' => 'text/plain'
196             };
197              
198             =head2 identify_from_path
199              
200             Identify the file from path/filename.
201              
202             =head2 identify_from_mimetype
203              
204             Identify based on the mimetype
205              
206             =head2 identify_via_libexif
207              
208             Identify mimetype via libexif.
209             You will need to have L<Archive::Zip> installed for MS Office documents
210              
211             =head1 FUNCTIONS
212              
213             =head2 installed_drivers
214              
215             Returns an array with all the installed plugins.
216              
217             =head1 SEE ALSO
218              
219             =over
220              
221             =item IANA
222              
223             L<http://www.iana.org/assignments/media-types/media-types.xhtml>
224              
225             L<http://www.iana.org/assignments/media-types/application.csv>
226              
227             =item L<File::LibMagic>
228              
229             =back
230              
231             =head1 AUTHOR
232              
233             Wesley Schwengle <wesley@mintlab.nl>
234              
235             =head1 COPYRIGHT AND LICENSE
236              
237             This software is Copyright (c) 2017 by Mintlab BV.
238              
239             This is free software, licensed under:
240              
241             The European Union Public License (EUPL) v1.1
242              
243             =cut