File Coverage

blib/lib/Mail/Milter/Authentication/App/Blocker/App/Command/add.pm
Criterion Covered Total %
statement 23 77 29.8
branch 0 32 0.0
condition 0 9 0.0
subroutine 8 13 61.5
pod 5 5 100.0
total 36 136 26.4


line stmt bran cond sub pod time code
1             package Mail::Milter::Authentication::App::Blocker::App::Command::add;
2 1     1   1022 use 5.20.0;
  1         4  
3 1     1   6 use strict;
  1         2  
  1         20  
4 1     1   5 use warnings;
  1         2  
  1         25  
5 1     1   6 use Mail::Milter::Authentication::Pragmas;
  1         2  
  1         6  
6             # ABSTRACT: Command to add a block to a given file
7             our $VERSION = '3.20230911'; # VERSION
8 1     1   292 use Mail::Milter::Authentication::App::Blocker::App -command;
  1         2  
  1         7  
9 1     1   2159 use Date::Manip::Date;
  1         90756  
  1         51  
10 1     1   12 use TOML;
  1         3  
  1         83  
11 1     1   7 use Text::Table;
  1         5  
  1         880  
12              
13 0     0 1   sub abstract { 'Add a block to a given file' }
14 0     0 1   sub description { 'Add a block to a given toml file' };
15              
16             sub opt_spec {
17             return (
18 0     0 1   [ 'file=s', 'Config file to operate on' ],
19             [ 'id=s', 'ID of the block to add' ],
20             [ 'callback=s', 'callback stage of the block to add' ],
21             [ 'value=s', 'value of the block to add' ],
22             [ 'with=s', 'SMTP result of the block to add' ],
23             [ 'percent=s', 'percent of the mail to block' ],
24             [ 'until=s', 'time of block expiry' ],
25             );
26             }
27              
28 0     0 1   sub validate_args($self,$opt,$args) {
  0            
  0            
  0            
  0            
29             # no args allowed but options!
30 0 0         $self->usage_error('Must supply a filename') if ( !$opt->{file} );
31 0 0         $self->usage_error('Supplied filename does not exist') if ( ! -e $opt->{file} );
32 0 0         $self->usage_error('Must supply an id') if ( !$opt->{id} );
33              
34 0 0         $self->usage_error('Must supply a callback') if ( !$opt->{callback} );
35 0           my @valid_callbacks = ( qw{ connect helo envfrom envrcpt header });
36 0 0         unless ( grep { $opt->{callback} eq $_ } @valid_callbacks ) {
  0            
37 0           $self->usage_error('Callback must be one of '.join(', ',@valid_callbacks));
38             }
39              
40 0 0         $self->usage_error('Must supply a value') if ( !$opt->{value} );
41              
42 0 0         $self->usage_error('Must supply a with') if ( !$opt->{with} );
43 0           my ( $rcode, $xcode, $message ) = split( ' ', $opt->{with}, 3 );
44 0 0 0       if ($rcode !~ /^[4|5]\d\d$/ || $xcode !~ /^[4|5]\.\d+\.\d+$/ || substr($rcode, 0, 1) ne substr($xcode, 0, 1)) {
      0        
45 0           $self->usage_error('With is invalid, please use extended return code format');
46             }
47              
48 0 0         $self->usage_error('Must supply a percent') if ( ! defined $opt->{percent} );
49 0 0         $self->usage_error('Percent must be a number') if ( ! ($opt->{percent} =~ /^\d+$/) );
50 0 0 0       $self->usage_error('Percent must be a number between 0 and 100') if ( ( $opt->{percent} < 0 ) || ( $opt->{percent} > 100 ) );
51              
52 0 0         if ( $opt->{until} ) {
53 0           my $dmdate = Date::Manip::Date->new;
54 0 0         if ( !$dmdate->parse($opt->{until}) ) {
55 0           $opt->{until} = $dmdate->secs_since_1970_GMT();
56             }
57             else {
58 0           $self->usage_error('Could not parse until date');
59             }
60             }
61             else {
62 0           $opt->{until} = 0;
63             }
64              
65 0 0         $self->usage_error('No args allowed') if @$args;
66             }
67              
68 0     0 1   sub execute($self,$opt,$args) {
  0            
  0            
  0            
  0            
69              
70 0           open ( my $inf, '<', $opt->{file} );
71 0           my $body = do { local $/; <$inf> };
  0            
  0            
72 0           close $inf;
73 0           my ( $data, $error ) = from_toml( $body );
74              
75 0 0         if ( $error ) {
76 0           say 'Error parsing file';
77 0           say $error;
78 0           exit 1;
79             }
80              
81 0 0         if ( exists $data->{$opt->{id}} ) {
82 0           say 'The given ID already exists in that file';
83 0           exit 1;
84             }
85              
86             $data->{$opt->{id}} = {
87             callback => $opt->{callback},
88             value => $opt->{value},
89             with => $opt->{with},
90             percent => $opt->{percent},
91             until => $opt->{until},
92 0           };
93              
94 0           open my $outf, '>', $opt->{file};
95 0           print $outf to_toml($data);
96 0           close $outf;
97              
98 0           say 'Block added and file saved';
99              
100             }
101              
102             1;
103              
104             __END__
105              
106             =pod
107              
108             =encoding UTF-8
109              
110             =head1 NAME
111              
112             Mail::Milter::Authentication::App::Blocker::App::Command::add - Command to add a block to a given file
113              
114             =head1 VERSION
115              
116             version 3.20230911
117              
118             =head1 AUTHOR
119              
120             Marc Bradshaw <marc@marcbradshaw.net>
121              
122             =head1 COPYRIGHT AND LICENSE
123              
124             This software is copyright (c) 2020 by Marc Bradshaw.
125              
126             This is free software; you can redistribute it and/or modify it under
127             the same terms as the Perl 5 programming language system itself.
128              
129             =cut