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   1136 use Moo;
  2         5  
  2         16  
10 2     2   677 use strict;
  2         5  
  2         40  
11 2     2   8 use warnings;
  2         6  
  2         64  
12 2     2   13 use version;
  2         4  
  2         23  
13 2     2   170 use Carp;
  2         4  
  2         120  
14 2     2   13 use Data::Dumper qw/Dumper/;
  2         4  
  2         108  
15 2     2   13 use English qw/ -no_match_vars /;
  2         4  
  2         23  
16 2     2   802 use Path::Tiny;
  2         24  
  2         101  
17 2     2   14 use File::chdir;
  2         4  
  2         141  
18 2     2   975 use Contextual::Return;
  2         17197  
  2         25  
19              
20             extends 'VCS::Which::Plugin';
21              
22             our $VERSION = version->new('0.6.9');
23             our $name = 'Bazaar';
24             our $exe = 'bzr';
25             our $meta = '.bzr';
26              
27             sub installed {
28 6     6 1 10 my ($self) = @_;
29              
30 6 100       27 return $self->_installed if defined $self->_installed;
31              
32 1         8 for my $path (split /[:;]/, $ENV{PATH}) {
33 9 50       186 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 42 my ( $self, $dir ) = @_;
43              
44 21 50       213 if (-f $dir) {
45 0         0 $dir = path($dir)->parent;
46             }
47              
48 21 100       294 croak "$dir is not a directory!" if !-d $dir;
49              
50 20         168 my $current_dir = path($dir)->absolute;
51 20         1921 my $level = 1;
52              
53 20         74 while ($current_dir) {
54 111 50       3599 if ( -d "$current_dir/$meta" ) {
55 0         0 $self->_base( $current_dir );
56 0         0 return $level;
57             }
58              
59 111         4897 $level++;
60              
61             # check that we still have a parent directory
62 111 100       349 last if $current_dir eq $current_dir->parent;
63              
64 91         5639 $current_dir = $current_dir->parent;
65             }
66              
67 20         1338 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__