File Coverage

blib/lib/VCS/Which/Plugin/Subversion.pm
Criterion Covered Total %
statement 39 97 40.2
branch 6 26 23.0
condition 0 15 0.0
subroutine 12 20 60.0
pod 7 7 100.0
total 64 165 38.7


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