1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
package VCS::Cvs;
use strict;
use vars qw($VERSION);
use Cwd qw(cwd);
use File::Spec::Functions qw(splitpath);
use VCS::Cvs::Dir;
use VCS::Cvs::File;
use VCS::Cvs::Version;
$VERSION = '0.06';
my $LOG_CMD = "cvs log";
my %LOG_CACHE;
sub _boiler_plate_info {
my ($self, $what) = @_;
my ($header, $log) = $self->_split_log($self->{VERSION});
my $rev_info = $self->_parse_log_rev($log);
$rev_info->{$what};
}
sub _split_log {
my ($self, $version) = @_;
my $log_text;
my $cache_id = $self->url;
unless (defined($log_text = $LOG_CACHE{$cache_id})) {
my $cwd = cwd();
my($volume, $path, $file) = splitpath($self->path);
chdir $path;
my $cmd =
$LOG_CMD .
" '" . $file . "' |";
#warn "cmd: $cmd\n";
$LOG_CACHE{$cache_id} = $log_text = $self->_read_pipe($cmd);
chdir $cwd;
}
my @sections = split /\n[=\-]+\n/, $log_text;
@sections = ($sections[0], grep { /^revision $version(?:\s+locked by.*)?\n/ } @sections)
if $version;
#map { print "SEC: $_\n" } @sections;
@sections;
}
sub _parse_log_rev {
my ($self, $text) = @_;
my ($rev_line, $blurb, @reason) = split /\n/, $text;
my %info = map {
split /:\s+/
} split /;\s*/, $blurb;
my ($junk, $rev) = split /\s+/, $rev_line;
$info{'revision'} = $rev;
$info{'reason'} = \@reason;
#print "REASON: @reason\n";
#map { print "$_ => $info{$_}\n" } keys %info;
\%info;
}
sub _parse_log_header {
my ($self, $text) = @_;
$text =~ s#(description:.*)##s;
my $desc = join "\n ", split /\n/, $1;
$text .= $desc;
my @parts = $text =~ /^(\S.*?)(?=^\S|\Z)/gms;
chomp @parts;
#map { print "PART: $_\n" } @parts;
my %info = map {
split /:\s*/, $_, 2
} @parts;
#map { print "$_ => $info{$_}\n" } keys %info;
\%info;
}
sub _read_pipe {
my ($self, $cmd) = @_;
local *PIPE;
open PIPE, $cmd;
local $/ = undef;
my $contents = <PIPE>;
close PIPE;
$contents = '' unless defined $contents;
return $contents;
}
1;
__END__
=head1 NAME
VCS::Cvs - notes for the CVS implementation
=head1 SYNOPSIS
$ENV{CVSROOT} = '/cvsroot';
use VCS;
$file = VCS::File->new('vcs://localhost/VCS::Cvs/source/project/Makefile');
=head1 DESCRIPTION
Currently, the user needs to ensure that the environmental requirements
for CVS command line tools are satisfied.
=head1 AVAILABILITY
VCS::Cvs is currently part of the main VCS distribution.
=head1 COPYRIGHT
Copyright (c) 1998-2003 Leon Brocard & Greg McCarroll. All rights
reserved. This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
=head1 SEE ALSO
L<VCS>.
=cut
|
