File Coverage

blib/lib/Mail/Milter/Authentication/App/Blocker/App/Command/delete.pm
Criterion Covered Total %
statement 20 55 36.3
branch 0 12 0.0
condition n/a
subroutine 7 12 58.3
pod 5 5 100.0
total 32 84 38.1


line stmt bran cond sub pod time code
1             package Mail::Milter::Authentication::App::Blocker::App::Command::delete;
2 1     1   1442 use 5.20.0;
  1         4  
3 1     1   7 use strict;
  1         3  
  1         23  
4 1     1   10 use warnings;
  1         8  
  1         26  
5 1     1   7 use Mail::Milter::Authentication::Pragmas;
  1         4  
  1         10  
6             # ABSTRACT: Command to delete a block for a given file
7             our $VERSION = '3.20230911'; # VERSION
8 1     1   248 use Mail::Milter::Authentication::App::Blocker::App -command;
  1         3  
  1         10  
9 1     1   358 use TOML;
  1         3  
  1         50  
10 1     1   6 use Text::Table;
  1         4  
  1         511  
11              
12 0     0 1   sub abstract { 'Delete a block in a given file' }
13 0     0 1   sub description { 'Delete a block from a given toml file' };
14              
15             sub opt_spec {
16             return (
17 0     0 1   [ 'file=s', 'Config file to operate on' ],
18             [ 'id=s', 'ID of the block to delete' ],
19             );
20             }
21              
22 0     0 1   sub validate_args($self,$opt,$args) {
  0            
  0            
  0            
  0            
23             # no args allowed but options!
24 0 0         $self->usage_error('Must supply a filename') if ( !$opt->{file} );
25 0 0         $self->usage_error('Supplied filename does not exist') if ( ! -e $opt->{file} );
26 0 0         $self->usage_error('Must supply an id') if ( !$opt->{id} );
27 0 0         $self->usage_error('No args allowed') if @$args;
28             }
29              
30 0     0 1   sub execute($self,$opt,$args) {
  0            
  0            
  0            
  0            
31              
32 0           open ( my $inf, '<', $opt->{file} );
33 0           my $body = do { local $/; <$inf> };
  0            
  0            
34 0           close $inf;
35 0           my ( $data, $error ) = from_toml( $body );
36              
37 0 0         if ( $error ) {
38 0           say 'Error parsing file';
39 0           say $error;
40 0           exit 1;
41             }
42              
43 0 0         if ( ! exists $data->{$opt->{id}} ) {
44 0           say 'The given ID does not exist in that file';
45 0           exit 1;
46             }
47              
48 0           delete $data->{$opt->{id}};
49 0           open my $outf, '>', $opt->{file};
50 0           print $outf to_toml($data);
51 0           close $outf;
52              
53 0           say 'Block deleted and file saved';
54              
55             }
56              
57             1;
58              
59             __END__
60              
61             =pod
62              
63             =encoding UTF-8
64              
65             =head1 NAME
66              
67             Mail::Milter::Authentication::App::Blocker::App::Command::delete - Command to delete a block for a given file
68              
69             =head1 VERSION
70              
71             version 3.20230911
72              
73             =head1 AUTHOR
74              
75             Marc Bradshaw <marc@marcbradshaw.net>
76              
77             =head1 COPYRIGHT AND LICENSE
78              
79             This software is copyright (c) 2020 by Marc Bradshaw.
80              
81             This is free software; you can redistribute it and/or modify it under
82             the same terms as the Perl 5 programming language system itself.
83              
84             =cut