File Coverage

blib/lib/VCS/Which/Plugin/CVS.pm
Criterion Covered Total %
statement 39 88 44.3
branch 6 18 33.3
condition 0 12 0.0
subroutine 12 19 63.1
pod 6 6 100.0
total 63 143 44.0


line stmt bran cond sub pod time code
1             package VCS::Which::Plugin::CVS;
2              
3             # Created on: 2009-05-16 16:58:14
4             # Create by: ivan
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 2     2   1086 use Moo;
  2         4  
  2         12  
10 2     2   631 use strict;
  2         4  
  2         111  
11 2     2   13 use warnings;
  2         5  
  2         76  
12 2     2   12 use version;
  2         4  
  2         18  
13 2     2   137 use Carp;
  2         4  
  2         121  
14 2     2   11 use Data::Dumper qw/Dumper/;
  2         6  
  2         106  
15 2     2   13 use English qw/ -no_match_vars /;
  2         4  
  2         11  
16 2     2   773 use Path::Tiny;
  2         4  
  2         98  
17 2     2   14 use File::chdir;
  2         7  
  2         141  
18 2     2   12 use Contextual::Return;
  2         12  
  2         15  
19              
20             extends 'VCS::Which::Plugin';
21              
22             our $VERSION = version->new('0.6.7');
23             our $name = 'CVS';
24             our $exe = 'cvs';
25             our $meta = 'CVS';
26              
27             sub installed {
28 6     6 1 13 my ($self) = @_;
29              
30 6 100       22 return $self->_installed if defined $self->_installed;
31              
32 1         11 for my $path (split /[:;]/, $ENV{PATH}) {
33 9 50       154 next if !-x "$path/$exe";
34              
35 0         0 return $self->_installed( 1 );
36             }
37              
38 1         10 return $self->_installed( 0 );
39             }
40              
41             sub used {
42 21     21 1 42 my ( $self, $dir ) = @_;
43              
44 21 50       187 if (-f $dir) {
45 0         0 $dir = path($dir)->parent;
46             }
47              
48 21 100       260 croak "$dir is not a directory!" if !-d $dir;
49              
50 20         254 return -d "$dir/$meta";
51             }
52              
53             sub uptodate {
54 0     0 1   my ( $self, $dir ) = @_;
55              
56 0   0       $dir ||= $self->_base;
57              
58 0 0         croak "'$dir' is not a directory!" if !-e $dir;
59              
60 0           chdir $dir;
61              
62 0           return !grep {!/Up-to-date/} grep { /Status:/ } `$exe status 2>/dev/null`;
  0            
  0            
63             }
64              
65             sub pull {
66 0     0 1   my ( $self, $dir ) = @_;
67              
68 0   0       $dir ||= $self->_base;
69              
70 0 0         croak "'$dir' is not a directory!" if !-e $dir;
71              
72 0           local $CWD = $dir;
73 0           return !system "$exe update > /dev/null 2> /dev/null";
74             }
75              
76             sub cat {
77 0     0 1   my ($self, $file, $revision) = @_;
78              
79 0 0 0       if ( $revision && $revision =~ /^-\d+$/xms ) {
    0          
80 0           my @versions = reverse `$exe log -q $file` =~ /^ revision \s+ (\d+[.]\d+)/gxms;
81 0           $revision = $versions[$revision];
82             }
83             elsif ( !defined $revision ) {
84 0           $revision = '';
85             }
86              
87 0   0       $revision &&= "-r $revision";
88              
89 0           return `$exe update -p $revision $file`;
90             }
91              
92             sub log {
93 0     0 1   my ($self, $file, @args) = @_;
94              
95 0           my $args = join ' ', @args;
96 0 0         my $dir = -d $file ? path($file) : path($file)->parent;
97              
98 0           local $CWD = $dir;
99             return
100 0     0     SCALAR { scalar `$exe log $args` }
101             ARRAYREF {
102 0     0     my $logs = `$exe $args log 2> /dev/null`;
103 0           my @logs;
104 0           for my $file ( split /^={77}$/xms, $logs ) {
105 0           my ($details, @log) = split /^-{28}$/xms, $file;
106 0           push @logs, @log;
107             }
108              
109 0           return \@logs;
110             }
111             HASHREF {
112 0     0     my $logs = `$exe $args log 2> /dev/null`;
113 0           my %log_by_date;
114 0           for my $file ( split /^={77}$/xms, $logs ) {
115 0           my ($details, @log) = split /^-{28}$/xms, $file;
116 0           for my $log (@log) {
117 0           my (undef, $rev_line, $data_line, $description) = split /\r?\n/xms, $log, 4;
118              
119 0           chomp $description;
120 0           my ($rev) = $rev_line =~ /^revision \s+ ([\d.]+)$/xms;
121 0           my ($date, $author) = $data_line =~ /^date: \s* ([^;]+); \s* author: \s* ([^;]+)/xms;
122              
123 0           push @{ $log_by_date{$date} }, {
  0            
124             rev => $rev,
125             description => $description,
126             Date => $date,
127             Author => $author,
128             };
129             }
130             }
131              
132 0           my %log;
133 0           my $i = 1;
134 0           for my $date ( sort keys %log_by_date ) {
135 0           $log{$i++} = $log_by_date{$date}[0];
136             }
137 0           return \%log;
138             }
139 0           }
140              
141             1;
142              
143             __END__
144              
145             =head1 NAME
146              
147             VCS::Which::Plugin::CVS - CVS plugin for VCS::Which
148              
149             =head1 VERSION
150              
151             This documentation refers to VCS::Which::Plugin::CVS version 0.5.5.
152              
153             =head1 SYNOPSIS
154              
155             use VCS::Which::Plugin::CVS;
156              
157             # Brief but working code example(s) here showing the most common usage(s)
158             # This section will be as far as many users bother reading, so make it as
159             # educational and exemplary as possible.
160              
161             =head1 DESCRIPTION
162              
163             The plugin for the Concurrent Versioning System (CVS)
164              
165             =head1 SUBROUTINES/METHODS
166              
167             =head3 C<installed ()>
168              
169             Return: bool - True if the CVS is installed
170              
171             Description: Determines if CVS is actually installed and usable
172              
173             =head3 C<used ($dir)>
174              
175             Param: C<$dir> - string - Directory to check
176              
177             Return: bool - True if the directory is versioned by this CVS
178              
179             Description: Determines if the directory is under version control of this CVS
180              
181             =head3 C<uptodate ($dir)>
182              
183             Param: C<$dir> - string - Directory to check
184              
185             Return: bool - True if the directory has no uncommitted changes
186              
187             Description: Determines if the directory has no uncommitted changes
188              
189             =head3 C<cat ( $file[, $revision] )>
190              
191             Param: C<$file> - string - The name of the file to cat
192              
193             Param: C<$revision> - string - The revision to get. If the revision is negative
194             it refers to the number of revisions old is desired. Any other value is
195             assumed to be a version control specific revision. If no revision is specified
196             the most recent revision is returned.
197              
198             Return: The file contents of the desired revision
199              
200             Description: Gets the contents of a specific revision of a file.
201              
202             =head3 C<log ( @args )>
203              
204             TO DO: Body
205              
206             =head3 C<versions ( [$file], [@args] )>
207              
208             Description: Gets all the versions of $file
209              
210             =head3 C<pull ( [$dir] )>
211              
212             Description: Pulls or updates the directory $dir to the newest version
213              
214             =head1 DIAGNOSTICS
215              
216             =head1 CONFIGURATION AND ENVIRONMENT
217              
218             =head1 DEPENDENCIES
219              
220             =head1 INCOMPATIBILITIES
221              
222             =head1 BUGS AND LIMITATIONS
223              
224             There are no known bugs in this module.
225              
226             Please report problems to Ivan Wills (ivan.wills@gmail.com).
227              
228             Patches are welcome.
229              
230             =head1 AUTHOR
231              
232             Ivan Wills - (ivan.wills@gmail.com)
233              
234             =head1 LICENSE AND COPYRIGHT
235              
236             Copyright (c) 2009 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW, Australia 2077).
237             All rights reserved.
238              
239             This module is free software; you can redistribute it and/or modify it under
240             the same terms as Perl itself. See L<perlartistic>. This program is
241             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
242             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
243             PARTICULAR PURPOSE.
244              
245             =cut