File Coverage

blib/lib/VCS/Which/Plugin/Bazaar.pm
Criterion Covered Total %
statement 46 98 46.9
branch 9 30 30.0
condition 0 15 0.0
subroutine 12 19 63.1
pod 6 6 100.0
total 73 168 43.4


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