File Coverage

blib/lib/Algorithm/Classifier/NaiveBayes/App/Command/untrain.pm
Criterion Covered Total %
statement 34 40 85.0
branch 10 14 71.4
condition n/a
subroutine 9 11 81.8
pod 3 5 60.0
total 56 70 80.0


line stmt bran cond sub pod time code
1             package Algorithm::Classifier::NaiveBayes::App::Command::untrain;
2              
3 1     1   716 use 5.006;
  1         3  
4 1     1   4 use strict;
  1         2  
  1         38  
5 1     1   5 use warnings;
  1         1  
  1         36  
6 1     1   4 use Algorithm::Classifier::NaiveBayes ();
  1         1  
  1         17  
7 1     1   3 use Algorithm::Classifier::NaiveBayes::App -command;
  1         1  
  1         8  
8 1     1   289 use File::Slurp qw(read_file);
  1         1  
  1         372  
9              
10             sub options {
11             return (
12 3     3 0 31 [ 'm=s', 'Model JSON file path/name.', { 'default' => 'nb_model.json', 'completion' => 'files' } ],
13             [ 'c=s', 'Class to untrain.' ],
14             [ 'f=s', 'File to read the text from.', { 'completion' => 'files' } ],
15             );
16             }
17              
18 0     0 1 0 sub abstract { 'Untrain a class on the specified text' }
19              
20             sub description {
21 0     0 1 0 return 'Untrain a class on the specified text, reversing a previous train.
22              
23             The text is taken from the file specified via -f, the remaining args
24             joined by a space, or from stdin.
25              
26             nb_tool untrain -m model.json -c spam something that is not spam
27             nb_tool untrain -m model.json -c spam -f some_ham.txt
28             cat ham | nb_tool untrain -m model.json -c spam
29             ';
30             } ## end sub description
31              
32             sub validate {
33 3     3 0 7 my ( $self, $opt, $args ) = @_;
34              
35 3 50       10 if ( !defined( $opt->{'c'} ) ) {
36 0         0 $self->usage_error('-c has not been specified');
37             }
38              
39 3 50       78 if ( !-f $opt->{'m'} ) {
40 0         0 $self->usage_error( '-m, "' . $opt->{'m'} . '", is not a file or does not exist' );
41             }
42              
43 3 100       11 if ( defined( $opt->{'f'} ) ) {
44 2 100       31 if ( @{$args} ) {
  2         12  
45 1         16 $self->usage_error('-f and text args may not be used together');
46             }
47 1 50       27 if ( !-f $opt->{'f'} ) {
    50          
48 0         0 $self->usage_error( '-f, "' . $opt->{'f'} . '", is not a file or does not exist' );
49             } elsif ( !-r $opt->{'f'} ) {
50 0         0 $self->usage_error( '-f, "' . $opt->{'f'} . '", is not readable' );
51             }
52             } ## end if ( defined( $opt->{'f'} ) )
53              
54 2         6 return 1;
55             } ## end sub validate
56              
57             sub execute {
58 2     2 1 10 my ( $self, $opt, $args ) = @_;
59              
60 2         17 my $nb = Algorithm::Classifier::NaiveBayes->new;
61 2         10 $nb->load( $opt->{'m'} );
62              
63 2 100       17 my $text = defined( $opt->{'f'} ) ? read_file( $opt->{'f'} ) : $self->text_from($args);
64 2         108 $nb->untrain( $opt->{'c'}, $text );
65 2         9 $nb->save( $opt->{'m'} );
66              
67 2         17 print 'Untrained "' . $opt->{'c'} . '", ' . $nb->{'model'}{'total_docs'} . ' total documents in the model' . "\n";
68             } ## end sub execute
69              
70             1;