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