/
SVN.pm
85 lines (65 loc) · 2.12 KB
/
SVN.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
package Test::Chimps::Smoker::SVN;
use strict;
use warnings;
use base qw(Test::Chimps::Smoker::Source);
__PACKAGE__->mk_ro_accessors(qw/uri/);
use File::Path qw(remove_tree);
sub revision_info {
my $self = shift;
my $revision = shift;
my $cmd = 'svn info'. ($revision? " -r $revision" : '') .' '. $self->uri;
my $info_out = `$cmd`;
my ($latest_revision) = ($info_out =~ m/^Revision: (\d+)/m);
my ($last_changed) = ($info_out =~ m/^Last Changed Rev: (\d+)/m);
my ($committer) = ($info_out =~ m/^Last Changed Author: (\w+)/m);
my ($committed_date) = ($info_out =~ m/^Last Changed Date: ([^(]+)/m);
$committed_date =~ s/\s+$//;
return ($latest_revision, $last_changed, $committer, $committed_date);
}
sub committer {
my $self = shift;
return ($self->revision_info( @_ ))[2];
}
sub committed_date {
my $self = shift;
return ($self->revision_info( @_ ))[3];
}
sub clone {
my $self = shift;
$self->revision( ($self->revision_info)[0] - 1 ) unless $self->revision;
$self->run_cmd("checkout", "-r", $self->revision, $self->uri, $self->directory);
}
sub checkout {
my $self = shift;
my $revision = shift;
$self->run_cmd("update", "-r", ($revision || 'HEAD'), $self->directory);
}
sub clean {
my $self = shift;
$self->run_cmd(qw(revert -R .));
open my $status_fh, "-|", qw(svn status .)
or die "Can't call program `svn status .`: $!";
while ( my $s = <$status_fh> ) {
next unless my ($path) = ($s =~ /^\?\s*(.*)$/);
remove_tree( File::Spec->catdir($self->directory, $path) );
}
}
sub next {
my $self = shift;
my $revision = $self->revision;
my $cmd = "svn log --limit 1 -q -r ". ($revision+1) .":HEAD ". $self->uri;
my ($next, $committer, $committed_date) = (`$cmd` =~
m/^r([0-9]+)\s+\|\s*(.*?)\s*\|\s*([^(]*)/m);
return () unless $next;
$committed_date =~ s/\s+$//;
return (
revision => $next,
committer => $committer,
committed_date => $committed_date,
);
}
sub run_cmd {
my $self = shift;
return $self->SUPER::run_cmd( "svn", @_ );
}
1;