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__ =head1 NAME VCS::Dir - module for access to a VCS directory =head1 SYNOPSIS use VCS; my $d = VCS::Dir->new($url); print $d->url . "\n"; foreach my $x ($d->content) { print "\t" . $x->url . "\t" . ref($x) . "\n"; } =head1 DESCRIPTION C abstracts access to a directory under version control. =head1 METHODS Methods marked with a "*" are not yet finalised/implemented. =head2 VCS::Dir-Ecreate_new($url) * C<$url> is a file-container URL. Creates data as appropriate to convince the VCS that there is a file-container, and returns an object of class C, or throws an exception if it fails. This is a pure virtual method, which must be over-ridden, and cannot be called directly in this class (a C will result). =head2 VCS::Dir-Eintroduce($name, $create_class) * C<$name> is a file or directory name, absolute or relative. C<$create_class> is either C or C, and implementation classes are expected to use something similar to this code, to call the appropriate create_new: sub introduce { my ($class, $name, $create_class) = @_; my $call_class = $class; $call_class =~ s/[^:]+$/$create_class/; return $call_class->create_new($name); } This is a pure virtual method, which must be over-ridden, and cannot be called directly in this class (a C will result). =head2 VCS::Dir-Enew($url) C<$url> is a file-container URL. Returns an object of class C, or throws an exception if it fails. Normally, an override of this method will call Cinit($url)> to make an object, and then add to it as appropriate. =head2 VCS::Dir-Einit($url) C<$url> is a file-container URL. Returns an object of class C. This method calls Cparse_url> to make sense of the URL. =head2 $dir-Etags * THIS METHOD WORKS RECURSIVELY ON THE DIRECTORY AT HAND * Returns all the tags inside a directory and a little bit more information. The actual datstructure is a hash of hashes. The first level hash is a hash keyed on tag names, in other words it lists as its keys every single tag name in or below a directory. Each of these tag names point to another hash with has filenames as keys and version numbers as values. =head2 $dir-Eurl Returns the C<$url> argument to C. =head2 $dir-Econtent Returns a list of objects, either of class C or C, corresponding to files and directories within this directory. =head2 $dir-Epath Returns the absolute path of the directory. =head2 $dir-Eread_dir($dir) Returns the contents of the given filesystem directory. This is intended as a utility method for subclasses. =head1 SEE ALSO L. =head1 COPYRIGHT This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut