Skip to content

Commit f6e6606

Browse files
committed
New VCS plugin for Perforce's p4 CLI client.
1 parent 4625afa commit f6e6606

File tree

1 file changed

+205
-0
lines changed
  • lib/Serge/Sync/Plugin/VCS

1 file changed

+205
-0
lines changed

lib/Serge/Sync/Plugin/VCS/p4.pm

Lines changed: 205 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,205 @@
1+
package Serge::Sync::Plugin::VCS::p4;
2+
3+
use 5.10.0;
4+
use strict;
5+
use warnings;
6+
7+
use parent 'Serge::Sync::Plugin::Base::VCS';
8+
9+
use File::Spec::Functions qw(catfile);
10+
use File::Temp qw(tempfile);
11+
use Serge::Util qw(subst_macros);
12+
use YAML::XS qw(LoadFile DumpFile);
13+
14+
# General strategy:
15+
# We set Perforce's SubmitOptions and Options in the client spec so that all
16+
# files are writable and clobberable by default. We then use p4 reconcile to
17+
# open changed files for edit and add new files.
18+
19+
# Perforce doesn't have concepts of repos or roots. Local directories can
20+
# contain files from any location in the depo. In practice there is a common
21+
# root (eg. //projects/my_fancy_pants_project). But that information is never
22+
# recorded by Perforce. So we record it in the file below in each local_path.
23+
# Note that this plugin never points p4 to this file. It's only used to store
24+
# the repo path for later use, and the client name for debugging purposes.
25+
my $SERGE_P4RC_FILENAME = '.p4rc_serge';
26+
27+
sub name {
28+
return 'Perforce sync plugin';
29+
}
30+
31+
sub init {
32+
my $self = shift;
33+
34+
$self->SUPER::init(@_);
35+
36+
$self->merge_schema({
37+
p4_cmd => 'STRING',
38+
client_name => 'STRING',
39+
client_owner => 'STRING',
40+
client_description => 'STRING',
41+
client_filespecs => 'ARRAY',
42+
});
43+
44+
return;
45+
}
46+
47+
sub validate_data {
48+
my $self = shift;
49+
50+
$self->SUPER::validate_data;
51+
52+
foreach my $key (qw/ client_name client_owner /) {
53+
if(!exists $self->{data}{$key}) {
54+
die "'$key' is not defined.";
55+
}
56+
}
57+
58+
# We use a few variables in nearly every command. Assign them once here
59+
# so they are slightly easier to read later.
60+
$self->{p4_cmd} = $self->{data}{p4_cmd} // 'p4';
61+
$self->{p4_client} = $self->{data}{client_name};
62+
63+
return;
64+
}
65+
66+
sub support_branch_switching {
67+
return 0;
68+
}
69+
70+
sub init_repo {
71+
my ($self, $local_path, $remote_path, $branch) = @_;
72+
73+
my $p4rc_file = catfile($local_path, $SERGE_P4RC_FILENAME);
74+
if(-f $p4rc_file) {
75+
die "It appears a Perforce client has already been configured at '$local_path'. Please rerun the command after deleting the client and directory.";
76+
}
77+
78+
my $client_name = $self->{data}{client_name} || die "client_name is not defined in Serge config.";
79+
my $client_owner = $self->{data}{client_owner} || die "client_owner is not defined in Serge config.";
80+
my $client_root_filespec = $remote_path;
81+
my $client_filespecs = $self->{data}{client_filespecs} || ['...'];
82+
my $desc = $self->{data}{client_description} || 'Created automatically by Serge';
83+
84+
my $view_mapping = join("\n", map { "\t$client_root_filespec$_ //$client_name/$_" } @$client_filespecs);
85+
# Ignore our local state file.
86+
$view_mapping .= "\n\t-$client_root_filespec$SERGE_P4RC_FILENAME //$client_name/$SERGE_P4RC_FILENAME";
87+
88+
my $clientspec_fn = do {
89+
my $template = <<"_TEMPLATE_";
90+
Client: $client_name
91+
Owner: $client_owner
92+
Description:
93+
$desc
94+
Root: $local_path
95+
Options: allwrite clobber nocompress unlocked nomodtime rmdir
96+
SubmitOptions: revertunchanged
97+
LineEnd: local
98+
View:
99+
$view_mapping
100+
_TEMPLATE_
101+
102+
my ($clientspec_fh, $clientspec_fn) = tempfile('p4_clientspec_XXXXX', TMPDIR => 1, UNLINK =>1);
103+
print $clientspec_fh $template;
104+
close $clientspec_fh;
105+
106+
$clientspec_fn;
107+
};
108+
109+
_save_p4rc($local_path, $client_root_filespec, $client_name, $client_owner);
110+
111+
$self->run_in($local_path, qq|$self->{p4_cmd} client -i < $clientspec_fn|);
112+
$self->run_in($local_path, qq|$self->{p4_cmd} -c $self->{p4_client} sync -f|);
113+
114+
return;
115+
}
116+
117+
sub get_remote_url {
118+
my ($self, $local_path) = @_;
119+
return _read_p4rc_setting($local_path, 'CLIENT_ROOT');
120+
}
121+
122+
sub checkout {
123+
my ($self, $local_path, $remote_path, $branch) = @_;
124+
$self->run_in($local_path, qq|$self->{p4_cmd} -c $self->{p4_client} sync -f $remote_path...|);
125+
return;
126+
}
127+
128+
sub add_unversioned {
129+
my ($self, $local_path) = @_;
130+
$self->run_in($local_path, qq|$self->{p4_cmd} -c $self->{p4_client} reconcile -a|, 0, 1);
131+
return;
132+
}
133+
134+
sub delete_unversioned {
135+
my ($self, $local_path) = @_;
136+
$self->run_in($local_path, qq|$self->{p4_cmd} -c $self->{p4_client} clean|, 1, 1);
137+
return;
138+
}
139+
140+
sub commit {
141+
my ($self, $local_path, $original_remote_path, $message) = @_;
142+
143+
$self->run_in($local_path, qq|$self->{p4_cmd} -c $self->{p4_client} reconcile -e|, 0, 0);
144+
145+
# We still have to check this even though we just reconciled above because Serge might have called
146+
# add_unversioned() and we have brand new files to submit.
147+
my $opened_output = $self->run_in($local_path, qq|$self->{p4_cmd} -c $self->{p4_client} opened|, 1, 0);
148+
if($opened_output !~ m/(add|edit) default change/) {
149+
print "Nothing to submit.\n";
150+
return;
151+
}
152+
153+
my $description = do {
154+
my $desc = $self->run_in($local_path, qq|$self->{p4_cmd} -c $self->{p4_client} change -o|, 1, 0);
155+
$desc =~ s/<enter description here>/$message/;
156+
$desc;
157+
};
158+
159+
my $description_fn = do {
160+
my ($desc_fh, $desc_fn) = tempfile('p4_submit_descXXXXX', TMPDIR => 1, UNLINK =>0);
161+
print $desc_fh $description;
162+
close $desc_fh;
163+
$desc_fn;
164+
};
165+
166+
$self->run_in($local_path, qq|$self->{p4_cmd} -c $self->{p4_client} submit -i < $description_fn|);
167+
168+
return;
169+
}
170+
171+
sub _save_p4rc {
172+
my ($local_path, $client_root, $client_name, $client_owner) = @_;
173+
174+
my $p4rc_file = catfile($local_path, $SERGE_P4RC_FILENAME);
175+
176+
open my $p4rc_fh, '>', $p4rc_file or die "Couldn't open $p4rc_file: $!";
177+
print $p4rc_fh "# Created by Sereg\n";
178+
print $p4rc_fh "# CLIENT_ROOT=$client_root\n"; # Comment this one out because it's not a real Perforce setting.
179+
print $p4rc_fh "P4USER=$client_owner\n";
180+
print $p4rc_fh "P4CLIENT=$client_name\n";
181+
close $p4rc_fh;
182+
183+
return;
184+
}
185+
186+
sub _read_p4rc_setting {
187+
my ($local_path, $key) = @_;
188+
189+
my $p4rc_file = catfile($local_path, $SERGE_P4RC_FILENAME);
190+
if(!-f $p4rc_file) {
191+
return;
192+
}
193+
194+
my $contents = do {
195+
local $/;
196+
open my $p4rc_fh, '<', $p4rc_file or die "Couldn't open $p4rc_file: $!";
197+
<$p4rc_fh>
198+
};
199+
my ($value) = $contents =~ m/$key=(.+)$/m or die "Couldn't find '$key' in '$p4rc_file'.";
200+
201+
return $value;
202+
}
203+
204+
205+
1;

0 commit comments

Comments
 (0)