File Coverage

blib/lib/Data/Conveyor/Control/File.pm
Criterion Covered Total %
statement 13 45 28.8
branch 0 18 0.0
condition n/a
subroutine 5 6 83.3
pod 1 1 100.0
total 19 70 27.1


line stmt bran cond sub pod time code
1 1     1   28 use 5.008;
  1         6  
  1         58  
2 1     1   9 use strict;
  1         3  
  1         45  
3 1     1   5 use warnings;
  1         3  
  1         96  
4              
5             package Data::Conveyor::Control::File;
6             BEGIN {
7 1     1   30 $Data::Conveyor::Control::File::VERSION = '1.103130';
8             }
9             # ABSTRACT: Stage-based conveyor-belt-like ticket handling system
10              
11 1     1   6 use parent 'Data::Conveyor::Control';
  1         3  
  1         7  
12             __PACKAGE__->mk_scalar_accessors(qw(filename));
13              
14             sub read {
15 0     0 1   my $self = shift;
16              
17             # Read the file indicated by $self->filename, which has an entry for
18             # each stage to be disabled, or 'ALL' to disable all stages. As soon as
19             # the word 'all' is found, the rest of the file is discarded!
20             #
21             # The line '__end__' signals the end of the stage list; anything below is
22             # ignored. If there is no such line, the whole file will be read - this
23             # works like the __END__ directive in a perl program.
24             #
25             #
26             #
27             # This method is pretty strict; if you misspell a stage or include it more
28             # than once, it aborts. Here we feel it is better to err on the cautious
29             # side. Suppose you'd like to disable the 'keywords_end' stage but mistype
30             # it as 'keyword_end'. If we didn't abort on an unknown stage name, we
31             # might record an error in the logs but the 'keywords_end' stage would
32             # still run.
33 0           $self->ignore_ticket_no_clear;
34 0           $self->allowed_stages_clear;
35 0           $self->allowed_stages(map { $_ => 1 }
  0            
36             $self->delegate->allowed_dispatcher_stages);
37              
38             # It's ok for the file not to be there.
39 0 0         return unless -e $self->filename;
40 0           my ($fh, $error);
41 0 0         unless (open $fh, '<', $self->filename) {
42 0           $self->log->info("can't open %s: %s", $self->filename, $!);
43 0           return 0;
44             }
45 0           while (<$fh>) {
46 0           chomp;
47 0           s/#.*$//; # comments are being ignored
48 0           s/^\s*//;
49 0           s/\s*$//;
50 0 0         next unless length;
51 0           $_ = lc;
52 0 0         if ($_ eq 'all') {
    0          
    0          
    0          
53 0           $self->log->info("disallowing all stages");
54 0           $self->allowed_stages_clear;
55 0           last;
56             } elsif ($_ eq '__end__') {
57 0           last;
58             } elsif ($self->allowed_stages($_)) {
59 0           $self->allowed_stages_delete($_);
60             } elsif ($self->make_obj('value_ticket_number')->check($_)) {
61 0           $self->ignore_ticket_no($_ => 1);
62             } else {
63 0           $self->log->info(
64             "[%s] isn't a ticket number or a known stage, or a duplicate",
65             $_);
66 0           $error++;
67 0           last;
68             }
69             }
70 0 0         unless (close $fh) {
71 0           $self->log->info("can't close %s: %s", $self->filename, $!);
72 0           return 0;
73             }
74 0 0         return 0 if $error;
75 0           1;
76             }
77             1;
78              
79              
80             __END__