1package VCS::Dir; 2 3use VCS::File; 4 5my $PREFIX = 'VCS'; 6 7sub new { 8 my $container_classtype = shift; 9 $container_classtype =~ s#^$PREFIX##; 10 my ($hostname, $impl_class, $path, $query) = VCS->parse_url(@_); 11 VCS->class_load($impl_class); 12 my $this_class = "$impl_class$container_classtype"; 13 return $this_class->new(@_); 14} 15 16# assumes no query string 17sub init { 18 my($class, $url) = @_; 19 my ($hostname, $impl_class, $path, $query) = VCS->parse_url($url); 20 if (substr($path, -1, 1) ne '/') { 21 $path .= '/'; 22 $url .= '/'; 23 } 24 my $self = {}; 25 $self->{HOSTNAME} = $hostname; 26 $self->{IMPL_CLASS} = $impl_class; 27 $self->{PATH} = $path; 28 $self->{URL} = $url; 29 bless $self, $class; 30 return $self; 31} 32 33sub url { 34 my $self = shift; 35 $self->{URL}; 36} 37 38sub content { 39} 40 41sub path { 42 my $self = shift; 43 $self->{PATH}; 44} 45 46sub tags { 47 my $self = shift; 48 my $rh = {}; # result hash 49 my @files = $self->recursive_read_dir(); 50 51 my $url; 52 53 foreach my $file (@files) { 54 my $vcsfile = eval { VCS::File->new('vcs://'.$self->{HOSTNAME}.'/'.$self->{IMPL_CLASS}.'/'.$file) } or next; 55 my $file_tag_information = $vcsfile->tags(); 56 foreach my $filetag (keys(%$file_tag_information)) { 57 $rh->{$filetag}->{$file} = $file_tag_information->{$filetag}; 58 } 59 } 60 61 return $rh; 62 63} 64 65 66sub recursive_read_dir { 67 my $self = shift; 68 my ($dir) = @_; 69 $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 $dir.='/' unless (substr($dir,-1,1) eq '/'); 76 my @files; 77 opendir(DIR,$dir); 78 my @contents = grep { (!/^\.\.?$/) } readdir(DIR); 79 @contents = grep { (!/,v$/) } @contents; # RCS files, shouldn't matter if they are RCS/*,v or just *,v 80 @contents = grep { (!/^CVS$/) } @contents; 81 82 closedir(DIR); 83 foreach my $content (@contents) { 84 if (-d $dir.$content) { 85 push(@files,($self->recursive_read_dir($dir.$content))); 86 } else { 87 push(@files,$dir.$content); 88 } 89 } 90 return @files; 91} 92 93sub read_dir { 94 my ($self, $dir) = @_; 95 local *DIR; 96 opendir DIR, $dir; 97 my @d = grep { (!/^\.\.?$/) } readdir DIR; 98 closedir DIR; 99#warn "d: @d\n"; 100 @d; 101} 102 1031; 104 105__END__ 106 107=head1 NAME 108 109VCS::Dir - module for access to a VCS directory 110 111=head1 SYNOPSIS 112 113 use VCS; 114 my $d = VCS::Dir->new($url); 115 print $d->url . "\n"; 116 foreach my $x ($d->content) { 117 print "\t" . $x->url . "\t" . ref($x) . "\n"; 118 } 119 120=head1 DESCRIPTION 121 122C<VCS::Dir> abstracts access to a directory under version control. 123 124=head1 METHODS 125 126Methods marked with a "*" are not yet finalised/implemented. 127 128=head2 VCS::Dir-E<gt>create_new($url) * 129 130C<$url> is a file-container URL. Creates data as 131appropriate to convince the VCS that there is a file-container, and 132returns an object of class C<VCS::Dir>, or throws an exception if it 133fails. This is a pure virtual method, which must be over-ridden, and 134cannot be called directly in this class (a C<die> will result). 135 136=head2 VCS::Dir-E<gt>introduce($name, $create_class) * 137 138C<$name> is a file or directory name, absolute or relative. 139C<$create_class> is either C<File> or C<Dir>, and implementation 140classes are expected to use something similar to this code, to call the 141appropriate create_new: 142 143 sub introduce { 144 my ($class, $name, $create_class) = @_; 145 my $call_class = $class; 146 $call_class =~ s/[^:]+$/$create_class/; 147 return $call_class->create_new($name); 148 } 149 150This is a pure virtual method, which must be over-ridden, and cannot be 151called directly in this class (a C<die> will result). 152 153=head2 VCS::Dir-E<gt>new($url) 154 155C<$url> is a file-container URL. Returns an object of class 156C<VCS::Dir>, or throws an exception if it fails. Normally, an override of 157this method will call C<VCS::Dir-E<gt>init($url)> to make an object, 158and then add to it as appropriate. 159 160=head2 VCS::Dir-E<gt>init($url) 161 162C<$url> is a file-container URL. Returns an object of class 163C<VCS::Dir>. This method calls C<VCS-E<gt>parse_url> to make sense of 164the URL. 165 166=head2 $dir-E<gt>tags 167 168* THIS METHOD WORKS RECURSIVELY ON THE DIRECTORY AT HAND * 169 170Returns all the tags inside a directory and a little bit more 171information. The actual datstructure is a hash of hashes. The first 172level hash is a hash keyed on tag names, in other words it lists as 173its keys every single tag name in or below a directory. Each of 174these tag names point to another hash with has filenames as keys 175and version numbers as values. 176 177=head2 $dir-E<gt>url 178 179Returns the C<$url> argument to C<new>. 180 181=head2 $dir-E<gt>content 182 183Returns a list of objects, either of class C<VCS::Dir> or 184C<VCS::File>, corresponding to files and directories within this 185directory. 186 187=head2 $dir-E<gt>path 188 189Returns the absolute path of the directory. 190 191=head2 $dir-E<gt>read_dir($dir) 192 193Returns the contents of the given filesystem directory. This is intended 194as a utility method for subclasses. 195 196=head1 SEE ALSO 197 198L<VCS>. 199 200=head1 COPYRIGHT 201 202This library is free software; you can redistribute it and/or 203modify it under the same terms as Perl itself. 204 205=cut 206