File Coverage

blib/lib/VCS/Dir.pm

Criterion	Covered	Total	%
statement	37	62	59.6
branch	4	8	50.0
condition	1	3	33.3
subroutine	4	9	44.4
pod	7	8	87.5
total	53	90	58.8

package VCS::Dir;

use VCS::File;

my $PREFIX = 'VCS';

sub new {
    my $container_classtype = shift;
    $container_classtype =~ s#^$PREFIX##;
    my ($hostname, $impl_class, $path, $query) = VCS->parse_url(@_);
    VCS->class_load($impl_class);
    my $this_class = "$impl_class$container_classtype";
    return $this_class->new(@_);
}

# assumes no query string
sub init {
    my($class, $url) = @_;
    my ($hostname, $impl_class, $path, $query) = VCS->parse_url($url);
    if (substr($path, -1, 1) ne '/') {
        $path .= '/';
        $url .= '/';
    }
    my $self = {};
    $self->{HOSTNAME} = $hostname;
    $self->{IMPL_CLASS} = $impl_class;
    $self->{PATH} = $path;
    $self->{URL} = $url;
    bless $self, $class;
    return $self;
}

sub url {
    my $self = shift;
    $self->{URL};
}

sub content {
}

sub path {
    my $self = shift;
    $self->{PATH};
}

sub tags {
  my $self = shift;
  my $rh = {}; # result hash
  my @files = $self->recursive_read_dir();

  my $url;

  foreach my $file (@files) {
    my $vcsfile = eval { VCS::File->new('vcs://'.$self->{HOSTNAME}.'/'.$self->{IMPL_CLASS}.'/'.$file) } or next;
    my $file_tag_information = $vcsfile->tags();
    foreach my $filetag (keys(%$file_tag_information)) {
      $rh->{$filetag}->{$file} = $file_tag_information->{$filetag};
    }
  }

  return $rh;

}


sub recursive_read_dir {
  my $self = shift;
  my ($dir) = @_;
  $dir ||= $self->path(); # let it take path if its not been
                          # defined, i'm not really sure about this,
                          # to be honest the whole things need an
                          # an overhaul in the way it works,
                          # but for now i'm just happy to get
                          # my work done. - Greg
  $dir.='/' unless (substr($dir,-1,1) eq '/');
  my @files;
  opendir(DIR,$dir);
  my @contents = grep { (!/^\.\.?$/) } readdir(DIR);
  @contents = grep { (!/,v$/) } @contents; # RCS files, shouldn't matter if they are RCS/*,v or just *,v
  @contents = grep { (!/^CVS$/) } @contents;

  closedir(DIR);
  foreach my $content (@contents) {
    if (-d $dir.$content) {
      push(@files,($self->recursive_read_dir($dir.$content)));
    } else {
      push(@files,$dir.$content);
    }
  }
  return @files;
}

sub read_dir {
    my ($self, $dir) = @_;
    local *DIR;
    opendir DIR, $dir;
    my @d = grep { (!/^\.\.?$/) } readdir DIR;
    closedir DIR;
#warn "d: @d\n";
    @d;
}

1;

__END__