File Coverage

blib/lib/Filename/Compressed.pm
Criterion Covered Total %
statement 16 16 100.0
branch 3 4 75.0
condition n/a
subroutine 4 4 100.0
pod 1 1 100.0
total 24 25 96.0


line stmt bran cond sub pod time code
1             package Filename::Compressed;
2              
3             our $DATE = '2014-12-30'; # DATE
4             our $VERSION = '0.01'; # VERSION
5              
6 1     1   5768 use 5.010001;
  1         25  
  1         170  
7 1     1   8 use strict;
  1         2  
  1         54  
8 1     1   6 use warnings;
  1         2  
  1         443  
9              
10             require Exporter;
11             our @ISA = qw(Exporter);
12             our @EXPORT_OK = qw(check_compressed_filename);
13             #list_compressor_suffixes
14              
15             our %SUFFIXES = (
16             '.Z' => {name=>'NCompress'},
17             '.gz' => {name=>'Gzip'},
18             '.bz2' => {name=>'Bzip2'},
19             '.xz' => {name=>'XZ'},
20             );
21              
22             our %SPEC;
23              
24             $SPEC{check_compressed_filename} = {
25             v => 1.1,
26             summary => 'Check whether filename indicates being compressed',
27             description => <<'_',
28              
29              
30             _
31             args => {
32             filename => {
33             schema => 'str*',
34             req => 1,
35             pos => 0,
36             },
37             # recurse?
38             # ci?
39             },
40             result_naked => 1,
41             result => {
42             schema => ['any*', of=>['bool*', 'hash*']],
43             description => <<'_',
44              
45             Return false if no compressor suffixes detected. Otherwise return a hash of
46             information, which contains these keys: `compressor_name`, `compressor_suffix`,
47             `uncompressed_filename`.
48              
49             _
50             },
51             };
52             sub check_compressed_filename {
53 5     5 1 27 my %args = @_;
54              
55 5         8 my $filename = $args{filename};
56 5 50       48 $filename =~ /(\.\w+)\z/ or return 0;
57 5         16 my $suffix = $1;
58 5 100       28 my $spec = $SUFFIXES{$1} or return 0;
59 4         23 (my $ufilename = $filename) =~ s/\.\w+\z//;
60              
61             return {
62 4         58 compressor_name => $spec->{name},
63             compressor_suffix => $suffix,
64             uncompressed_filename => $ufilename,
65             };
66             }
67              
68             1;
69             # ABSTRACT: Check whether filename indicates being compressed
70              
71             __END__