File Coverage

blib/lib/VCS/Dir.pm
Criterion Covered Total %
statement 37 61 60.6
branch 4 8 50.0
condition 1 3 33.3
subroutine 4 9 44.4
pod 7 8 87.5
total 53 89 59.5


line stmt bran cond sub pod time code
1             package VCS::Dir;
2              
3 1     1   283 use VCS::File;
  1         2  
  1         470  
4              
5             my $PREFIX = 'VCS';
6              
7             sub new {
8 1     1 1 525 my $container_classtype = shift;
9 1         11 $container_classtype =~ s#^$PREFIX##;
10 1         6 my ($hostname, $impl_class, $path, $query) = VCS->parse_url(@_);
11 1         15 VCS->class_load($impl_class);
12 1         2 my $this_class = "$impl_class$container_classtype";
13 1         6 return $this_class->new(@_);
14             }
15              
16             # assumes no query string
17             sub init {
18 1     1 1 6 my($class, $url) = @_;
19 1         2 my ($hostname, $impl_class, $path, $query) = VCS->parse_url($url);
20 1 50       19 if (substr($path, -1, 1) ne '/') {
21 0         0 $path .= '/';
22 0         0 $url .= '/';
23             }
24 1         2 my $self = {};
25 1         3 $self->{HOSTNAME} = $hostname;
26 1         1 $self->{IMPL_CLASS} = $impl_class;
27 1         2 $self->{PATH} = $path;
28 1         1 $self->{URL} = $url;
29 1         2 bless $self, $class;
30 1         3 return $self;
31             }
32              
33             sub url {
34 0     0 1 0 my $self = shift;
35 0         0 $self->{URL};
36             }
37              
38       0 1   sub content {
39             }
40              
41             sub path {
42 0     0 1 0 my $self = shift;
43 0         0 $self->{PATH};
44             }
45              
46             sub tags {
47 0     0 1 0 my $self = shift;
48 0         0 my $rh = {}; # result hash
49 0         0 my @files = $self->recursive_read_dir();
50              
51 0         0 my $url;
52              
53 0         0 foreach my $file (@files) {
54 0 0       0 my $vcsfile = eval { VCS::File->new('vcs://'.$self->{HOSTNAME}.'/'.$self->{IMPL_CLASS}.'/'.$file) } or next;
  0         0  
55 0         0 my $file_tag_information = $vcsfile->tags();
56 0         0 foreach my $filetag (keys(%$file_tag_information)) {
57 0         0 $rh->{$filetag}->{$file} = $file_tag_information->{$filetag};
58             }
59             }
60              
61 0         0 return $rh;
62              
63             }
64              
65              
66             sub recursive_read_dir {
67 7     7 0 10 my $self = shift;
68 7         8 my ($dir) = @_;
69 7   33     10 $dir ||= $self->path(); # let it take path if its not been
70             # defined, i'm not really sure about this,
71             # to be honest the whole things need an
72             # an overhaul in the way it works,
73             # but for now i'm just happy to get
74             # my work done. - Greg
75 7 50       15 $dir.='/' unless (substr($dir,-1,1) eq '/');
76 7         4 my @files;
77 7         71 opendir(DIR,$dir);
78 7         36 my @contents = grep { (!/^\.\.?$/) } readdir(DIR);
  26         48  
79 7         8 @contents = grep { (!/,v$/) } @contents; # RCS files, shouldn't matter if they are RCS/*,v or just *,v
  12         17  
80 7         8 @contents = grep { (!/^CVS$/) } @contents;
  12         16  
81              
82 7         41 closedir(DIR);
83 7         9 foreach my $content (@contents) {
84 12 100       88 if (-d $dir.$content) {
85 6         18 push(@files,($self->recursive_read_dir($dir.$content)));
86             } else {
87 6         13 push(@files,$dir.$content);
88             }
89             }
90 7         13 return @files;
91             }
92              
93             sub read_dir {
94 0     0 1   my ($self, $dir) = @_;
95 0           local *DIR;
96 0           opendir DIR, $dir;
97 0           my @d = grep { (!/^\.\.?$/) } readdir DIR;
  0            
98 0           closedir DIR;
99             #warn "d: @d\n";
100 0           @d;
101             }
102              
103             1;
104              
105             __END__