File Coverage

test/lib/RandomFileMethodBase.pm
Criterion Covered Total %
statement 48 48 100.0
branch 4 6 66.6
condition 1 3 33.3
subroutine 14 14 100.0
pod 0 5 0.0
total 67 76 88.1


line stmt bran cond sub pod time code
1             package
2             RandomFileMethodBase;
3 1     1   9 use base qw/Test::Class/;
  1         1  
  1         80  
4 1     1   359 use TestConstants;
  1         8  
  1         157  
5              
6 1     1   8 use strict;
  1         2  
  1         41  
7 1     1   7 use warnings;
  1         1  
  1         58  
8              
9 1     1   11 use Test::More;
  1         3  
  1         19  
10 1     1   579 use Test::Exception;
  1         1  
  1         20  
11 1     1   407 use Set::Scalar;
  1         1  
  1         393  
12              
13 1     1   6 use File::Random;
  1         9  
  1         616  
14              
15             sub expected_files_found_ok {
16 122     122 0 6088 my ($self, $exp_files, $args, $testname) = @_;
17 122         511 my $exp = Set::Scalar->new(@$exp_files);
18 122         12891 my $found = Set::Scalar->new( grep defined, $self->sample(@$args) );
19            
20 122         126865 _remove_cvs_files( $found );
21 122 50       1182 is $found, $exp, $testname
22             or diag "found: $found",
23             "expected $exp",
24             "called with " . join (", " => @$args);
25             }
26              
27             # I use a CVS System at home,
28             # so there are always some files more than needed
29             # that's why I delete them from the found files
30             sub _remove_cvs_files($) {
31 122     122   257 my $f = shift;
32 122         525 foreach ($f->members) {
33 728 50 33     3879 $f->delete($_) if defined($_) && ($_ =~ /Repository|CVS|Entries|Root/);
34             }
35             }
36              
37             sub sample {
38 134     134 0 657 my ($self, %arg) = @_;
39 134         303 my @sample;
40 134         692 push @sample, $self->call_random_file(%arg) for (1 .. SAMPLE_SIZE);
41 134         16663 return @sample;
42             }
43              
44             # Methods for overwriting -
45             # from practical reasons I didn't want to use the underscore _random_file
46             sub random_file {
47 18060     18060 0 33832 my ($self, @args) = @_;
48 18060         38717 return File::Random::random_file(@args);
49             }
50              
51             sub content_of_random_file {
52 18560     18560 0 39470 my ($self, @args) = @_;
53 18560         43354 return File::Random::content_of_random_file(@args);
54             }
55              
56             sub call_random_file {
57 33500     33500 0 101785 my ($self, %arg) = @_;
58            
59 33500         65017 my ($path, $home) = @arg{'-path', '-home'};
60 33500         61987 delete @arg{'-path', '-home'};
61              
62             # either we know the directory directly
63 33500 100       114047 return $self->random_file(%arg) if $arg{-dir};
64              
65             # or have to go to the path itself
66 3000         28870 chdir $path;
67 3000         13806 my $rf = $self->random_file(%arg);
68 3000         33107 chdir $home;
69 3000         23302 return $rf;
70             }
71              
72              
73             1;