File Coverage

blib/lib/Filename/Backup.pm
Criterion Covered Total %
statement 24 24 100.0
branch 7 8 87.5
condition 2 2 100.0
subroutine 4 4 100.0
pod 1 1 100.0
total 38 39 97.4


line stmt bran cond sub pod time code
1             package Filename::Backup;
2              
3             our $DATE = '2015-09-03'; # DATE
4             our $VERSION = '0.02'; # VERSION
5              
6 1     1   609 use 5.010001;
  1         3  
7 1     1   4 use strict;
  1         2  
  1         17  
8 1     1   4 use warnings;
  1         1  
  1         561  
9              
10             require Exporter;
11             our @ISA = qw(Exporter);
12             our @EXPORT_OK = qw(check_backup_filename);
13              
14             our %SPEC;
15              
16             our %SUFFIXES = (
17             '~' => 1,
18             '.bak' => 1,
19             '.old' => 1,
20             # XXX % (from /etc/mime.types)
21             # XXX sik? (from /etc/mime.types)
22             );
23              
24             $SPEC{check_backup_filename} = {
25             v => 1.1,
26             summary => 'Check whether filename indicates being a backup file',
27             description => <<'_',
28              
29              
30             _
31             args => {
32             filename => {
33             schema => 'str*',
34             req => 1,
35             pos => 0,
36             },
37             # XXX recurse?
38             ci => {
39             summary => 'Whether to match case-insensitively',
40             schema => 'bool',
41             default => 1,
42             },
43             },
44             result_naked => 1,
45             result => {
46             schema => ['any*', of=>['bool*', 'hash*']],
47             description => <<'_',
48              
49             Return false if not detected as backup name. Otherwise return a hash, which may
50             contain these keys: `original_filename`. In the future there will be extra
51             information returned, e.g. editor name (if filename indicates backup from
52             certain backup program), date (if filename contains date information), and so
53             on.
54              
55             _
56             },
57             };
58             sub check_backup_filename {
59 6     6 1 24 my %args = @_;
60              
61 6         10 my $filename = $args{filename};
62              
63 6 50       44 $filename =~ /(~|\.\w+)\z/ or return 0;
64 6   100     26 my $ci = $args{ci} // 1;
65              
66 6         14 my $suffix = $1;
67              
68 6         6 my $spec;
69 6 100       12 if ($ci) {
70 5         8 my $suffix_lc = lc($suffix);
71 5         16 for (keys %SUFFIXES) {
72 10 100       28 if (lc($_) eq $suffix_lc) {
73 4         7 $spec = $SUFFIXES{$_};
74 4         8 last;
75             }
76             }
77             } else {
78 1         4 $spec = $SUFFIXES{$suffix};
79             }
80 6 100       24 return 0 unless $spec;
81              
82 4         59 (my $orig_filename = $filename) =~ s/\Q$suffix\E\z//;
83              
84             return {
85 4         27 original_filename => $orig_filename,
86             };
87             }
88              
89             1;
90             # ABSTRACT: Check whether filename indicates being a backup file
91              
92             __END__