File Coverage

blib/lib/Filename/Video.pm
Criterion Covered Total %
statement 13 13 100.0
branch 2 2 100.0
condition n/a
subroutine 5 5 100.0
pod 1 1 100.0
total 21 21 100.0


line stmt bran cond sub pod time code
1             package Filename::Video;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2020-10-20'; # DATE
5             our $DIST = 'Filename-Video'; # DIST
6             our $VERSION = '0.004'; # VERSION
7              
8 1     1   57773 use 5.010001;
  1         11  
9 1     1   5 use strict;
  1         1  
  1         58  
10 1     1   5 use warnings;
  1         2  
  1         36  
11              
12 1     1   6 use Exporter qw(import);
  1         2  
  1         192  
13             our @EXPORT_OK = qw(check_video_filename);
14              
15             our $STR_RE = "movie|mpeg|webm|3gp|asf|asx|avi|axv|dif|fli|flv|lsf|lsx|mkv|mng|mov|mp4|mpe|mpg|mpv|mxu|ogv|wmv|wmx|wvx|dl|dv|gl|qt|ts|wm"; # STR_RE
16              
17             our $RE = qr(\.(?:$STR_RE)\z)i;
18              
19             our %SPEC;
20              
21             $SPEC{check_video_filename} = {
22             v => 1.1,
23             summary => 'Check whether filename indicates being a video file',
24             description => <<'_',
25              
26              
27             _
28             args => {
29             filename => {
30             schema => 'filename*',
31             req => 1,
32             pos => 0,
33             },
34             # XXX recurse?
35             #ci => {
36             # summary => 'Whether to match case-insensitively',
37             # schema => 'bool',
38             # default => 1,
39             #},
40             },
41             result_naked => 1,
42             result => {
43             schema => ['any*', of=>['bool*', 'hash*']],
44             description => <<'_',
45              
46             Return false if no archive suffixes detected. Otherwise return a hash of
47             information.
48              
49             _
50             },
51             examples => [
52             {
53             args => {filename => 'foo.txt'},
54             naked_result => 0,
55             },
56             {
57             args => {filename => 'foo.DOC'},
58             naked_result => 0,
59             },
60             {
61             args => {filename => 'foo.webm'},
62             naked_result => {},
63             },
64             {
65             args => {filename => 'foo.MP4'},
66             naked_result => {},
67             },
68             ],
69             };
70             sub check_video_filename {
71 4     4 1 79 my %args = @_;
72              
73 4 100       39 $args{filename} =~ $RE ? {} : 0;
74             }
75              
76             1;
77             # ABSTRACT: Check whether filename indicates being a video file
78              
79             __END__