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         2  
  1         87  
4 1     1   378 use TestConstants;
  1         9  
  1         188  
5              
6 1     1   8 use strict;
  1         3  
  1         50  
7 1     1   20 use warnings;
  1         3  
  1         87  
8              
9 1     1   6 use Test::More;
  1         2  
  1         25  
10 1     1   672 use Test::Exception;
  1         3  
  1         24  
11 1     1   500 use Set::Scalar;
  1         4  
  1         59  
12              
13 1     1   15 use File::Random;
  1         3  
  1         770  
14              
15             sub expected_files_found_ok {
16 122     122 0 5768 my ($self, $exp_files, $args, $testname) = @_;
17 122         533 my $exp = Set::Scalar->new(@$exp_files);
18 122         13055 my $found = Set::Scalar->new( grep defined, $self->sample(@$args) );
19            
20 122         122162 _remove_cvs_files( $found );
21 122 50       1266 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   340 my $f = shift;
32 122         661 foreach ($f->members) {
33 728 50 33     4070 $f->delete($_) if defined($_) && ($_ =~ /Repository|CVS|Entries|Root/);
34             }
35             }
36              
37             sub sample {
38 134     134 0 596 my ($self, %arg) = @_;
39 134         332 my @sample;
40 134         807 push @sample, $self->call_random_file(%arg) for (1 .. SAMPLE_SIZE);
41 134         17400 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 36053 my ($self, @args) = @_;
48 18060         35820 return File::Random::random_file(@args);
49             }
50              
51             sub content_of_random_file {
52 18560     18560 0 37438 my ($self, @args) = @_;
53 18560         42480 return File::Random::content_of_random_file(@args);
54             }
55              
56             sub call_random_file {
57 33500     33500 0 94290 my ($self, %arg) = @_;
58            
59 33500         63533 my ($path, $home) = @arg{'-path', '-home'};
60 33500         53418 delete @arg{'-path', '-home'};
61              
62             # either we know the directory directly
63 33500 100       107308 return $self->random_file(%arg) if $arg{-dir};
64              
65             # or have to go to the path itself
66 3000         27736 chdir $path;
67 3000         12541 my $rf = $self->random_file(%arg);
68 3000         32480 chdir $home;
69 3000         22281 return $rf;
70             }
71              
72              
73             1;