line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Prophet::Test; |
2
|
33
|
|
|
33
|
|
132670
|
use strict; |
|
33
|
|
|
|
|
52
|
|
|
33
|
|
|
|
|
1007
|
|
3
|
33
|
|
|
33
|
|
158
|
use warnings; |
|
33
|
|
|
|
|
46
|
|
|
33
|
|
|
|
|
1863
|
|
4
|
|
|
|
|
|
|
|
5
|
33
|
|
|
33
|
|
151
|
use base qw/Test::More Exporter/; |
|
33
|
|
|
|
|
47
|
|
|
33
|
|
|
|
|
26944
|
|
6
|
|
|
|
|
|
|
our @EXPORT = qw/as_alice as_bob as_charlie as_david as_user |
7
|
|
|
|
|
|
|
repo_uri_for replica_last_rev replica_uuid_for ok_added_revisions replica_uuid |
8
|
|
|
|
|
|
|
database_uuid database_uuid_for serialize_conflict serialize_changeset |
9
|
|
|
|
|
|
|
in_gladiator diag run_command set_editor set_editor_script load_record |
10
|
|
|
|
|
|
|
last_script_stdout last_script_stderr last_script_exit_code |
11
|
|
|
|
|
|
|
/; |
12
|
|
|
|
|
|
|
|
13
|
33
|
|
|
33
|
|
635827
|
use Cwd qw/getcwd/; |
|
33
|
|
|
|
|
69
|
|
|
33
|
|
|
|
|
2489
|
|
14
|
33
|
|
|
33
|
|
204
|
use File::Path 'rmtree'; |
|
33
|
|
|
|
|
60
|
|
|
33
|
|
|
|
|
2207
|
|
15
|
33
|
|
|
33
|
|
181
|
use File::Spec; |
|
33
|
|
|
|
|
59
|
|
|
33
|
|
|
|
|
936
|
|
16
|
33
|
|
|
33
|
|
28291
|
use File::Temp qw/tempdir tempfile/; |
|
33
|
|
|
|
|
745774
|
|
|
33
|
|
|
|
|
3073
|
|
17
|
33
|
|
|
33
|
|
17988
|
use Params::Validate ':all'; |
|
33
|
|
|
|
|
297666
|
|
|
33
|
|
|
|
|
7651
|
|
18
|
33
|
|
|
33
|
|
13053
|
use Prophet::Util; |
|
33
|
|
|
|
|
71
|
|
|
33
|
|
|
|
|
1120
|
|
19
|
|
|
|
|
|
|
|
20
|
33
|
|
|
33
|
|
14201
|
use Prophet::CLI; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
our $REPO_BASE = File::Temp::tempdir(); |
23
|
|
|
|
|
|
|
Test::More->import; |
24
|
|
|
|
|
|
|
diag( "Replicas can be found in $REPO_BASE" ); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# by default, load no configuration file |
27
|
|
|
|
|
|
|
$ENV{PROPHET_APP_CONFIG} = ''; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
{ |
30
|
|
|
|
|
|
|
no warnings 'redefine'; |
31
|
|
|
|
|
|
|
require Test::More; |
32
|
|
|
|
|
|
|
sub Test::More::diag { # bad bad bad # convenient convenient convenient |
33
|
|
|
|
|
|
|
Test::More->builder->diag(@_) if ( $Test::Harness::Verbose || $ENV{'TEST_VERBOSE'} ); |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
our $EDIT_TEXT = sub { shift }; |
38
|
|
|
|
|
|
|
do { |
39
|
|
|
|
|
|
|
no warnings 'redefine'; |
40
|
|
|
|
|
|
|
*Prophet::CLI::Command::edit_text = sub { |
41
|
|
|
|
|
|
|
my $self = shift; |
42
|
|
|
|
|
|
|
$EDIT_TEXT->(@_); |
43
|
|
|
|
|
|
|
}; |
44
|
|
|
|
|
|
|
}; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head2 set_editor($code) |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
Sets the subroutine that Prophet should use instead of |
49
|
|
|
|
|
|
|
C (as this routine invokes an interactive |
50
|
|
|
|
|
|
|
editor) to $code. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=cut |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub set_editor { |
55
|
|
|
|
|
|
|
$EDIT_TEXT = shift; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=head2 set_editor_script SCRIPT |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
Sets the editor that Proc::InvokeEditor uses. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
This should be a non-interactive script found in F. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=cut |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub set_editor_script { |
67
|
|
|
|
|
|
|
my ($self, $script) = @_; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
delete $ENV{'VISUAL'}; # Proc::InvokeEditor checks this first |
70
|
|
|
|
|
|
|
$ENV{'EDITOR'} = "$^X " . File::Spec->catfile(getcwd(), 't', 'scripts', $script); |
71
|
|
|
|
|
|
|
Test::More::diag "export EDITOR=" . $ENV{'EDITOR'} . "\n"; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=head2 import_extra($class, $args) |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=cut |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub import_extra { |
79
|
|
|
|
|
|
|
my $class = shift; |
80
|
|
|
|
|
|
|
my $args = shift; |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
Test::More->export_to_level(2); |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# Now, clobber Test::Builder::plan (if we got given a plan) so we |
85
|
|
|
|
|
|
|
# don't try to spit one out *again* later |
86
|
|
|
|
|
|
|
if ( $class->builder->has_plan ) { |
87
|
|
|
|
|
|
|
no warnings 'redefine'; |
88
|
|
|
|
|
|
|
*Test::Builder::plan = sub { }; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
delete $ENV{'PROPHET_APP_CONFIG'}; |
92
|
|
|
|
|
|
|
$ENV{'PROPHET_EMAIL'} = 'nobody@example.com'; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head2 in_gladiator($code) |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Run the given code using L. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=cut |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub in_gladiator (&) { |
102
|
|
|
|
|
|
|
my $code = shift; |
103
|
|
|
|
|
|
|
local $Test::Builder::Level = $Test::Builder::Level + 1; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
my $types; |
106
|
|
|
|
|
|
|
eval { require Devel::Gladiator; }; |
107
|
|
|
|
|
|
|
if ($@) { |
108
|
|
|
|
|
|
|
warn 'Devel::Gladiator not found'; |
109
|
|
|
|
|
|
|
return $code->(); |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
for ( @{ Devel::Gladiator::walk_arena() } ) { |
112
|
|
|
|
|
|
|
$types->{ ref($_) }--; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
$code->(); |
116
|
|
|
|
|
|
|
for ( @{ Devel::Gladiator::walk_arena() } ) { |
117
|
|
|
|
|
|
|
$types->{ ref($_) }++; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
map { $types->{$_} || delete $types->{$_} } keys %$types; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=head2 repo_path_for($username) |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
Returns a path on disk for where $username's replica is stored. |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=cut |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub repo_path_for { |
130
|
|
|
|
|
|
|
my $username = shift; |
131
|
|
|
|
|
|
|
return File::Spec->catdir($REPO_BASE => $username); |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub config_file_for { |
135
|
|
|
|
|
|
|
my $username = shift; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
return File::Spec->catdir($REPO_BASE, $username, 'config'); |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=head2 repo_uri_for($username) |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
Returns a file:// URI for $USERNAME'S replica (with the correct replica |
143
|
|
|
|
|
|
|
type prefix). |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=cut |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub repo_uri_for { |
148
|
|
|
|
|
|
|
my $username = shift; |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
my $path = repo_path_for($username); |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
return 'file://' . $path; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=head2 replica_uuid |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
Returns the UUID of the test replica. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=cut |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub replica_uuid { |
162
|
|
|
|
|
|
|
my $self = shift; |
163
|
|
|
|
|
|
|
my $cli = Prophet::CLI->new(); |
164
|
|
|
|
|
|
|
return $cli->handle->uuid; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=head2 database_uuid |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Returns the UUID of the test database. |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=cut |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub database_uuid { |
174
|
|
|
|
|
|
|
my $self = shift; |
175
|
|
|
|
|
|
|
my $cli = Prophet::CLI->new(); |
176
|
|
|
|
|
|
|
return eval { $cli->handle->db_uuid}; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head2 replica_last_rev |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Returns the sequence number of the last change in the test replica. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=cut |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub replica_last_rev { |
186
|
|
|
|
|
|
|
my $cli = Prophet::CLI->new(); |
187
|
|
|
|
|
|
|
return $cli->handle->latest_sequence_no; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=head2 as_user($username, $coderef) |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
Run this code block as $username. This routine sets up the %ENV hash so that |
193
|
|
|
|
|
|
|
when we go looking for a repository, we get the user's repo. |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=cut |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
our %REPLICA_UUIDS; |
198
|
|
|
|
|
|
|
our %DATABASE_UUIDS; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
sub as_user { |
201
|
|
|
|
|
|
|
my $username = shift; |
202
|
|
|
|
|
|
|
my $coderef = shift; |
203
|
|
|
|
|
|
|
local $ENV{'PROPHET_REPO'} = repo_path_for($username); |
204
|
|
|
|
|
|
|
local $ENV{'PROPHET_EMAIL'} = $username . '@example.com'; |
205
|
|
|
|
|
|
|
local $ENV{'PROPHET_APP_CONFIG'} = config_file_for($username); |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
my $ret = $coderef->(); |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
$REPLICA_UUIDS{$username} = replica_uuid(); |
210
|
|
|
|
|
|
|
$DATABASE_UUIDS{$username} = database_uuid(); |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
return $ret; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=head2 replica_uuid_for($username) |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
Returns the UUID of the given user's test replica. |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=cut |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
sub replica_uuid_for { |
222
|
|
|
|
|
|
|
my $user = shift; |
223
|
|
|
|
|
|
|
return $REPLICA_UUIDS{$user}; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=head2 database_uuid_for($username) |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Returns the UUID of the given user's test database. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=cut |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub database_uuid_for { |
233
|
|
|
|
|
|
|
my $user = shift; |
234
|
|
|
|
|
|
|
return $DATABASE_UUIDS{$user}; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=head2 ok_added_revisions( { CODE }, $numbers_of_new_revisions, $msg) |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
Checks that the given code block adds the given number of changes to the test |
240
|
|
|
|
|
|
|
replica. $msg is optional and will be printed with the test if given. |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=cut |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub ok_added_revisions (&$$) { |
245
|
|
|
|
|
|
|
my ( $code, $num, $msg ) = @_; |
246
|
|
|
|
|
|
|
local $Test::Builder::Level = $Test::Builder::Level + 1; |
247
|
|
|
|
|
|
|
my $last_rev = replica_last_rev(); |
248
|
|
|
|
|
|
|
$code->(); |
249
|
|
|
|
|
|
|
is( replica_last_rev(), $last_rev + $num, $msg ); |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=head2 serialize_conflict($conflict_obj) |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
Returns a simple, serialized version of a L object suitable |
255
|
|
|
|
|
|
|
for comparison in tests. |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
The serialized version is a hash reference containing the following keys: |
258
|
|
|
|
|
|
|
meta => { original_source_uuid => 'source_replica_uuid' } |
259
|
|
|
|
|
|
|
records => { 'record_uuid' => |
260
|
|
|
|
|
|
|
{ change_type => 'type', |
261
|
|
|
|
|
|
|
props => { propchange_name => { source_old => 'old_val', |
262
|
|
|
|
|
|
|
source_new => 'new_val', |
263
|
|
|
|
|
|
|
target_old => 'target_val', |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
}, |
267
|
|
|
|
|
|
|
'another_record_uuid' => |
268
|
|
|
|
|
|
|
{ change_type => 'type', |
269
|
|
|
|
|
|
|
props => { propchange_name => { source_old => 'old_val', |
270
|
|
|
|
|
|
|
source_new => 'new_val', |
271
|
|
|
|
|
|
|
target_old => 'target_val', |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
}, |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=cut |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
sub serialize_conflict { |
280
|
|
|
|
|
|
|
my ($conflict_obj) = validate_pos( @_, { isa => 'Prophet::Conflict' } ); |
281
|
|
|
|
|
|
|
my $conflicts; |
282
|
|
|
|
|
|
|
for my $change ( @{ $conflict_obj->conflicting_changes } ) { |
283
|
|
|
|
|
|
|
$conflicts->{meta} = { original_source_uuid => $conflict_obj->changeset->original_source_uuid }; |
284
|
|
|
|
|
|
|
$conflicts->{records}->{ $change->record_uuid } = { change_type => $change->change_type, }; |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
for my $propchange ( @{ $change->prop_conflicts } ) { |
287
|
|
|
|
|
|
|
$conflicts->{records}->{ $change->record_uuid }->{props}->{ $propchange->name } = { |
288
|
|
|
|
|
|
|
source_old => $propchange->source_old_value, |
289
|
|
|
|
|
|
|
source_new => $propchange->source_new_value, |
290
|
|
|
|
|
|
|
target_old => $propchange->target_value |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
return $conflicts; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=head2 serialize_changeset($changeset_obj) |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
Returns a simple, serialized version of a L object |
301
|
|
|
|
|
|
|
suitable for comparison in tests (a hash). |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=cut |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub serialize_changeset { |
306
|
|
|
|
|
|
|
my ($cs) = validate_pos( @_, { isa => 'Prophet::ChangeSet' } ); |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
return $cs->as_hash; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=head2 run_command($command, @args) |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
Run the given command with (optionally) the given args using a new |
314
|
|
|
|
|
|
|
L object. Returns the standard output of that command |
315
|
|
|
|
|
|
|
in scalar form or, in array context, the STDOUT in scalar form |
316
|
|
|
|
|
|
|
*and* the STDERR in scalar form. |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
Examples: |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
run_command('create', '--type=Foo'); |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=cut |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
our $CLI_CLASS = 'Prophet::CLI'; |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
sub run_command { |
327
|
|
|
|
|
|
|
my $output = ''; |
328
|
|
|
|
|
|
|
my $error = ''; |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
my $original_stdout = *STDOUT; |
331
|
|
|
|
|
|
|
my $original_stderr = *STDERR; |
332
|
|
|
|
|
|
|
open( my $out_handle, '>', \$output ); |
333
|
|
|
|
|
|
|
open( my $err_handle, '>', \$error ); |
334
|
|
|
|
|
|
|
*STDOUT = $out_handle; |
335
|
|
|
|
|
|
|
*STDERR = $err_handle; |
336
|
|
|
|
|
|
|
$|++; # autoflush |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
my $ret = eval { |
339
|
|
|
|
|
|
|
local $SIG{__DIE__} = 'DEFAULT'; |
340
|
|
|
|
|
|
|
$CLI_CLASS->new->run_one_command(@_); |
341
|
|
|
|
|
|
|
}; |
342
|
|
|
|
|
|
|
warn $@ if $@; |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
# restore to originals |
345
|
|
|
|
|
|
|
*STDOUT = $original_stdout; |
346
|
|
|
|
|
|
|
*STDERR = $original_stderr; |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
return wantarray ? ($output, $error) : $output; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
{ |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=head2 load_record($type, $uuid) |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
Loads and returns a record object for the record with the given type and uuid. |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
=cut |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
my $connection; |
360
|
|
|
|
|
|
|
sub load_record { |
361
|
|
|
|
|
|
|
my $type = shift; |
362
|
|
|
|
|
|
|
my $uuid = shift; |
363
|
|
|
|
|
|
|
require Prophet::Record; |
364
|
|
|
|
|
|
|
$connection ||= Prophet::CLI->new->handle; |
365
|
|
|
|
|
|
|
my $record = Prophet::Record->new(handle => $connection, type => $type); |
366
|
|
|
|
|
|
|
$record->load(uuid => $uuid); |
367
|
|
|
|
|
|
|
return $record; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=head2 as_alice CODE, as_bob CODE, as_charlie CODE, as_david CODE |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
Runs CODE as alice, bob, charlie or david. |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=cut |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
sub as_alice (&) { as_user( alice => shift ) } |
378
|
|
|
|
|
|
|
sub as_bob (&) { as_user( bob => shift ) } |
379
|
|
|
|
|
|
|
sub as_charlie(&) { as_user( charlie => shift ) } |
380
|
|
|
|
|
|
|
sub as_david(&) { as_user( david => shift ) } |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
# END { |
383
|
|
|
|
|
|
|
# for (qw(alice bob charlie david)) { |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
# # as_user( $_, sub { rmtree [ $ENV{'PROPHET_REPO'} ] } ); |
386
|
|
|
|
|
|
|
# } |
387
|
|
|
|
|
|
|
# } |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
1; |