File Coverage

blib/lib/VCS/Which/Plugin.pm
Criterion Covered Total %
statement 34 71 47.8
branch 1 18 5.5
condition n/a
subroutine 11 21 52.3
pod 11 11 100.0
total 57 121 47.1


line stmt bran cond sub pod time code
1             package VCS::Which::Plugin;
2              
3             # Created on: 2009-05-16 17:50:07
4             # Create by: ivan
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 2     2   2447 use Moo;
  2         4  
  2         15  
10 2     2   639 use strict;
  2         4  
  2         74  
11 2     2   13 use warnings;
  2         3  
  2         58  
12 2     2   10 use version;
  2         3  
  2         13  
13 2     2   137 use Carp;
  2         4  
  2         107  
14 2     2   12 use Data::Dumper qw/Dumper/;
  2         4  
  2         95  
15 2     2   11 use English qw/ -no_match_vars /;
  2         4  
  2         12  
16 2     2   1721 use File::chdir;
  2         6405  
  2         269  
17              
18             our $VERSION = version->new('0.6.7');
19              
20             has [qw/_installed _base/] => (
21             is => 'rw',
22             );
23              
24             sub name {
25 55     55 1 95 my ($self) = @_;
26 55 50       104 my $package = ref $self ? ref $self : $self;
27              
28 2     2   16 no strict qw/refs/; ## no critic
  2         4  
  2         171  
29 55         76 return ${"$package\::name"};
  55         233  
30             }
31              
32             sub exe {
33 0     0 1   my ($self) = @_;
34 0 0         my $package = ref $self ? ref $self : $self;
35              
36 2     2   14 no strict qw/refs/; ## no critic
  2         4  
  2         1176  
37 0           return ${"$package\::exe"};
  0            
38             }
39              
40             sub installed {
41 0     0 1   my ($self) = @_;
42              
43 0           return die $self->name . ' does not currently implement installed!';
44             }
45              
46             sub used {
47 0     0 1   my ($self) = @_;
48              
49 0           return die $self->name . ' does not currently implement used!';
50             }
51              
52             sub uptodate {
53 0     0 1   my ($self) = @_;
54              
55 0           return die $self->name . ' does not currently implement uptodate!';
56             }
57              
58             sub exec {
59 0     0 1   my ($self, $dir, @args) = @_;
60              
61 0 0         die $self->name . " not installed\n" if !$self->installed();
62              
63 0           local $CWD = $dir;
64              
65 0 0         if ($CWD ne $dir) {
66 0           for my $arg (@args) {
67 0 0         $arg = $CWD if $arg eq $dir;
68             }
69             }
70              
71 0           my $cmd = $self->exe;
72 0           my $run = join ' ', $cmd, @args;
73 0 0         return defined wantarray ? `$run` : CORE::exec($run);
74             }
75              
76             sub cat {
77 0     0 1   my ($self, $file, $revision) = @_;
78              
79 0           my $exe = $self->exe;
80 0 0         my $rev = $revision ? "-r$revision " : '';
81              
82 0           return `$exe cat $rev$file`;
83             }
84              
85             sub pull {
86 0     0 1   die '"pull" not implemented for this Version Controll System!';
87             }
88              
89             sub push {
90 0     0 1   die '"push" not implemented for this Version Controll System!';
91             }
92              
93             sub versions {
94 0     0 1   my ($self, $file, $oldest, $newest, $max) = @_;
95              
96 0 0         my %logs = %{ $self->log($file, $max ? "--limit $max" : '') };
  0            
97 0           my @versions;
98              
99 0           for my $log (sort {$a <=> $b} keys %logs) {
  0            
100 0           CORE::push @versions, $logs{$log}{rev};# if $oldest && $logs{$log}{rev} <= $oldest;
101             }
102              
103 0           return @versions;
104             }
105              
106             sub add {
107 0     0 1   my ($self, $file, $revision) = @_;
108              
109 0           my $exe = $self->exe;
110 0 0         my $rev = $revision ? "-r$revision " : '';
111              
112 0           return `$exe add $rev$file`;
113             }
114              
115             1;
116              
117             __END__
118              
119             =head1 NAME
120              
121             VCS::Which::Plugin - Base class for the various VCS plugins
122              
123             =head1 VERSION
124              
125             This documentation refers to VCS::Which::Plugin version 0.6.7.
126              
127             =head1 SYNOPSIS
128              
129             use VCS::Which::Plugin;
130              
131             # Brief but working code example(s) here showing the most common usage(s)
132             # This section will be as far as many users bother reading, so make it as
133             # educational and exemplary as possible.
134              
135             =head1 DESCRIPTION
136              
137             This is the base module for VCS::Which plugins. It is not used directly by
138             itself. Many of the methods expect package variables to be defined by the
139             plugin module.
140              
141             This module is also usually called by L<VCS::Which> and not the plugins
142             directly as L<VCS::Which> is set up to do the work to determine which plugin
143             to use.
144              
145             =head2 PLUGINS
146              
147             Plugins are expected to define the following variables
148              
149             =over 4
150              
151             =item C<our $name>
152              
153             A pretty name to describe the version control system.
154              
155             =item C<our $exe>
156              
157             The executable used by the vcs (eg svn, git etc)
158              
159             =back
160              
161             =head1 SUBROUTINES/METHODS
162              
163             =head2 C<new ()>
164              
165             Return: VCS::Which::Plugin - A new plugin object
166              
167             Description: Simple constructor that should be inherited by plugins
168              
169             =head2 C<name ()>
170              
171             Return: string - The pretty name for the System
172              
173             Description: Returns the pretty name for the VCS
174              
175             =head2 C<exe ()>
176              
177             Return: string - The name of the executable that is used to run operations
178             with the appropriate plugin
179              
180             Description: Returns name of the executable for the appropriate version
181             control system.
182              
183             =head2 C<installed ()>
184              
185             Return: bool - True if the VCS is installed
186              
187             Description: Determines if VCS is actually installed and usable
188              
189             =head2 C<used ($dir)>
190              
191             Param: C<$dir> - string - Directory to check
192              
193             Return: bool - True if the directory is versioned by this VCS
194              
195             Description: Determines if the directory is under version control of this VCS
196              
197             =head2 C<uptodate ($dir)>
198              
199             Param: C<$dir> - string - Directory to check
200              
201             Return: bool - True if the directory has no uncommitted changes
202              
203             Description: Determines if the directory has no uncommitted changes
204              
205             =head2 C<exec (@params)>
206              
207             Param: C<@params> - array of strings - The parameters that you wish to pass
208             on to the vcs program.
209              
210             Description: Runs a command for the appropriate vcs. In void context it
211             actually exec()s the command so never returns if the context is scalar or
212             array backticks are used to run the command and the results are returned to
213             the caller.
214              
215             =head3 C<cat ( $file[, $revision] )>
216              
217             Param: C<$file> - string - The name of the file to cat
218              
219             Param: C<$revision> - string - The revision to get. If the revision is negative
220             it refers to the number of revisions old is desired. Any other value is
221             assumed to be a version control specific revision. If no revision is specified
222             the most recent revision is returned.
223              
224             Return: The file contents of the desired revision
225              
226             Description: Gets the contents of a specific revision of a file. This
227             implementation works for many version control systems so may not be overloaded
228             by specific plugins
229              
230             =head3 C<versions ( [$file], [@args] )>
231              
232             Description: Gets all the versions of $file
233              
234             =head3 C<pull ( [$dir] )>
235              
236             Description: Pulls or updates the directory $dir to the newest version
237              
238             =head3 C<push ( [$dir] )>
239              
240             Description: push updates to parent repository must be implemented by plugin
241              
242             =head3 C<add ( [$file] )>
243              
244             Add C<$file> to VCS
245              
246             =head1 DIAGNOSTICS
247              
248             =head1 CONFIGURATION AND ENVIRONMENT
249              
250             =head1 DEPENDENCIES
251              
252             =head1 INCOMPATIBILITIES
253              
254             =head1 BUGS AND LIMITATIONS
255              
256             There are no known bugs in this module.
257              
258             Please report problems to Ivan Wills (ivan.wills@gmail.com).
259              
260             Patches are welcome.
261              
262             =head1 AUTHOR
263              
264             Ivan Wills - (ivan.wills@gmail.com)
265              
266             =head1 LICENSE AND COPYRIGHT
267              
268             Copyright (c) 2009 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW, Australia 2077).
269             All rights reserved.
270              
271             This module is free software; you can redistribute it and/or modify it under
272             the same terms as Perl itself. See L<perlartistic>. This program is
273             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
274             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
275             PARTICULAR PURPOSE.
276              
277             =cut