File Coverage

blib/lib/Mail/BIMI/App/Command/checksvg.pm
Criterion Covered Total %
statement 21 55 38.1
branch 0 12 0.0
condition 0 3 0.0
subroutine 8 13 61.5
pod 5 5 100.0
total 34 88 38.6


line stmt bran cond sub pod time code
1             package Mail::BIMI::App::Command::checksvg;
2             # ABSTRACT: Check an SVG for validation
3             our $VERSION = '3.20210512'; # VERSION
4 1     1   1132 use 5.20.0;
  1         5  
5 1     1   23 BEGIN { $ENV{MAIL_BIMI_CACHE_DEFAULT_BACKEND} = 'Null' };
6 1     1   7 use Mail::BIMI::Prelude;
  1         3  
  1         7  
7 1     1   281 use Mail::BIMI::App -command;
  1         3  
  1         21  
8 1     1   263 use Mail::BIMI;
  1         3  
  1         19  
9 1     1   6 use Mail::BIMI::Indicator;
  1         5  
  1         24  
10 1     1   6 use File::Slurp qw{ read_file write_file };
  1         4  
  1         55  
11 1     1   25 use Term::ANSIColor qw{ :constants };
  1         3  
  1         742  
12              
13              
14 0     0 1   sub description { 'Check a SVG from a given URI or File for validity' }
15 0     0 1   sub usage_desc { "%c checksvg %o <URI>" }
16              
17             sub opt_spec {
18             return (
19 0     0 1   [ 'profile=s', 'SVG Profile to validate against ('.join('|',@Mail::BIMI::Indicator::VALIDATOR_PROFILES).')' ],
20             [ 'fromfile', 'Fetch from file instead of from URI' ],
21             );
22             }
23              
24 0     0 1   sub validate_args($self,$opt,$args) {
  0            
  0            
  0            
  0            
25 0 0         $self->usage_error('No URI specified') if !@$args;
26 0 0         $self->usage_error('Multiple URIs specified') if scalar @$args > 1;
27 0 0 0       $self->usage_error('Unknown SVG Profile') if $opt->profile && !grep {;$_ eq $opt->profile} @Mail::BIMI::Indicator::VALIDATOR_PROFILES;
  0            
28             }
29              
30 0     0 1   sub execute($self,$opt,$args) {
  0            
  0            
  0            
  0            
31 0           my $uri = $args->[0];
32 0           my $bimi = Mail::BIMI->new(domain=>'example.com');
33              
34 0           my %bimi_opt = (
35             bimi_object => $bimi,
36             );
37 0 0         if ( $opt->fromfile ) {
38 0           my $data = scalar read_file($uri);
39 0           $bimi_opt{data} = $data;
40             }
41             else {
42 0           $bimi_opt{uri} = $uri;
43             }
44              
45 0           my $indicator = Mail::BIMI::Indicator->new(%bimi_opt);
46 0 0         $indicator->validator_profile($opt->profile) if $opt->profile;
47 0           say "BIMI SVG checker";
48 0           say '';
49 0           say 'Requested:';
50 0 0         say YELLOW.($opt->fromfile?'File':'URI').WHITE.': '.$uri.RESET;
51 0           say '';
52 0           $indicator->app_validate;
53 0           say '';
54              
55 0           $bimi->finish;
56             }
57              
58             1;
59              
60             __END__
61              
62             =pod
63              
64             =encoding UTF-8
65              
66             =head1 NAME
67              
68             Mail::BIMI::App::Command::checksvg - Check an SVG for validation
69              
70             =head1 VERSION
71              
72             version 3.20210512
73              
74             =head1 DESCRIPTION
75              
76             App::Cmd class implementing the 'mailbimi checksvg' command
77              
78             =head1 REQUIRES
79              
80             =over 4
81              
82             =item * L<File::Slurp|File::Slurp>
83              
84             =item * L<Mail::BIMI|Mail::BIMI>
85              
86             =item * L<Mail::BIMI::App|Mail::BIMI::App>
87              
88             =item * L<Mail::BIMI::Indicator|Mail::BIMI::Indicator>
89              
90             =item * L<Mail::BIMI::Prelude|Mail::BIMI::Prelude>
91              
92             =item * L<Term::ANSIColor|Term::ANSIColor>
93              
94             =back
95              
96             =head1 AUTHOR
97              
98             Marc Bradshaw <marc@marcbradshaw.net>
99              
100             =head1 COPYRIGHT AND LICENSE
101              
102             This software is copyright (c) 2020 by Marc Bradshaw.
103              
104             This is free software; you can redistribute it and/or modify it under
105             the same terms as the Perl 5 programming language system itself.
106              
107             =cut