3
use Test::More tests => 112;
6
# shut up about variables that are only used once.
7
# these come from constants and variables used
8
# by the bindings but not elsewhere in perl space.
13
use_ok('SVN::Client');
14
use_ok('SVN::Wc'); # needed for status
15
use File::Spec::Functions;
16
use File::Temp qw(tempdir);
17
use File::Path qw(rmtree);
19
# do not use cleanup because it will fail, some files we
20
# will not have write perms to.
21
my $testpath = tempdir('svn-perl-test-XXXXXX', TMPDIR => 1);
23
my $repospath = catdir($testpath,'repo');
24
my $reposurl = 'file://' . (substr($repospath,0,1) ne '/' ? '/' : '')
26
my $wcpath = catdir($testpath,'wc');
27
my $importpath = catdir($testpath,'import');
29
# track current rev ourselves to test against
32
# We want to trap errors ourself
33
$SVN::Error::handler = undef;
35
# Get username we are running as
36
my $username = getpwuid($>);
38
# This is ugly to create the test repo with SVN::Repos, but
39
# it seems to be the most reliable way.
40
ok(SVN::Repos::create("$repospath", undef, undef, undef, undef),
41
"create repository at $repospath");
43
my ($ctx) = SVN::Client->new;
44
isa_ok($ctx,'SVN::Client','Client Object');
46
my $uuid_from_url = $ctx->uuid_from_url($reposurl);
47
ok($uuid_from_url,'Valid return from uuid_from_url method form');
49
# test non method invocation passing a SVN::Client
50
ok(SVN::Client::uuid_from_url($reposurl,$ctx),
51
'Valid return from uuid_from_url function form with SVN::Client object');
53
# test non method invocation passing a _p_svn_client_ctx_t
54
ok(SVN::Client::uuid_from_url($reposurl,$ctx->{'ctx'}),
55
'Valid return from uuid_from_url function form with _p_svn_client_ctx object');
58
my ($ci_dir1) = $ctx->mkdir(["$reposurl/dir1"]);
59
isa_ok($ci_dir1,'_p_svn_client_commit_info_t');
61
is($ci_dir1->revision,$current_rev,"commit info revision equals $current_rev");
65
my ($rpgval,$rpgrev) = $ctx->revprop_get('svn:author',$reposurl,$current_rev);
66
is($rpgval,$username,'svn:author set to expected username from revprop_get');
67
is($rpgrev,$current_rev,'Returned revnum of current rev from revprop_get');
70
skip 'Difficult to test on Win32', 3 if $^O eq 'MSWin32';
72
ok(rename("$repospath/hooks/pre-revprop-change.tmpl",
73
"$repospath/hooks/pre-revprop-change"),
74
'Rename pre-revprop-change hook');
75
ok(chmod(0700,"$repospath/hooks/pre-revprop-change"),
76
'Change permissions on pre-revprop-change hook');
78
my ($rps_rev) = $ctx->revprop_set('svn:log','mkdir dir1',
79
$reposurl, $current_rev, 0);
80
is($rps_rev,$current_rev,
81
'Returned revnum of current rev from revprop_set');
85
my ($rph, $rplrev) = $ctx->revprop_list($reposurl,$current_rev);
86
isa_ok($rph,'HASH','Returned hash reference form revprop_list');
87
is($rplrev,$current_rev,'Returned current rev from revprop_list');
88
is($rph->{'svn:author'},$username,
89
'svn:author is expected user from revprop_list');
90
if ($^O eq 'MSWin32') {
91
# we skip the log change test on win32 so we have to test
92
# for a different var here
93
is($rph->{'svn:log'},'Make dir1',
94
'svn:log is expected value from revprop_list');
96
is($rph->{'svn:log'},'mkdir dir1',
97
'svn:log is expected value from revprop_list');
99
ok($rph->{'svn:date'},'svn:date is set from revprop_list');
101
is($ctx->checkout($reposurl,$wcpath,'HEAD',1),$current_rev,
102
'Returned current rev from checkout');
104
is(SVN::Client::url_from_path($wcpath),$reposurl,
105
"Returned $reposurl from url_from_path");
107
ok(open(NEW, ">$wcpath/dir1/new"),'Open new file for writing');
108
ok(print(NEW 'addtest'), 'Print to new file');
109
ok(close(NEW),'Close new file');
111
# no return means success
112
is($ctx->add("$wcpath/dir1/new",0),undef,
113
'Returned undef from add schedule operation');
115
# test the log_msg callback
119
my ($log_msg,$tmp_file,$commit_items,$pool) = @_;
120
isa_ok($log_msg,'SCALAR','log_msg param to callback is a SCALAR');
121
isa_ok($tmp_file,'SCALAR','tmp_file param to callback is a SCALAR');
122
isa_ok($commit_items,'ARRAY',
123
'commit_items param to callback is a SCALAR');
124
isa_ok($pool,'_p_apr_pool_t',
125
'pool param to callback is a _p_apr_pool_t');
126
my $commit_item = shift @$commit_items;
127
isa_ok($commit_item,'_p_svn_client_commit_item_t',
128
'commit_item element is a _p_svn_client_commit_item_t');
129
is($commit_item->path(),"$wcpath/dir1/new",
130
"commit_item has proper path for committed file");
131
is($commit_item->kind(),$SVN::Node::file,
132
"kind() shows the node as a file");
133
is($commit_item->url(),"$reposurl/dir1/new",
134
'URL matches our repos url');
135
# revision is 0 because the commit has not happened yet
136
# and this is not a copy
137
is($commit_item->revision(),0,
138
'Revision is 0 since commit has not happened yet');
139
is($commit_item->copyfrom_url(),undef,
140
'copyfrom_url is undef since file is not a copy');
141
is($commit_item->state_flags(),$SVN::Client::COMMIT_ITEM_ADD |
142
$SVN::Client::COMMIT_ITEM_TEXT_MODS,
143
'state_flags are ADD and TEXT_MODS');
144
my $wcprop_changes = $commit_item->wcprop_changes();
145
isa_ok($wcprop_changes,'ARRAY','wcprop_changes returns an ARRAY');
146
is(scalar(@$wcprop_changes),0,
147
'No elements in the wcprop_changes array because '.
148
' we did not make any');
149
$$log_msg = 'Add new';
154
my ($ci_commit1) = $ctx->commit($wcpath,0);
155
isa_ok($ci_commit1,'_p_svn_client_commit_info_t',
156
'Commit returns a _p_svn_client_commit_info');
158
is($ci_commit1->revision,$current_rev,
159
"commit info revision equals $current_rev");
161
# get rid of log_msg callback
162
is($ctx->log_msg(undef),undef,
163
'Clearing the log_msg callback works');
165
# test getting the log
166
is($ctx->log("$reposurl/dir1/new",$current_rev,$current_rev,1,0,
169
my ($changed_paths,$revision,
170
$author,$date,$message,$pool) = @_;
171
isa_ok($changed_paths,'HASH',
172
'changed_paths param is a HASH');
173
isa_ok($changed_paths->{'/dir1/new'},
174
'_p_svn_log_changed_path_t',
175
'Hash value is a _p_svn_log_changed_path_t');
176
is($changed_paths->{'/dir1/new'}->action(),'A',
177
'action returns A for add');
178
is($changed_paths->{'/dir1/new'}->copyfrom_path(),undef,
179
'copyfrom_path returns undef as it is not a copy');
180
is($changed_paths->{'/dir1/new'}->copyfrom_rev(),
181
$SVN::Core::INVALID_REVNUM,
182
'copyfrom_rev is set to INVALID as it is not a copy');
183
is($revision,$current_rev,
184
'revision param matches current rev');
185
is($author,$username,
186
'author param matches expected username');
187
ok($date,'date param is defined');
188
is($message,'Add new',
189
'message param is the expected value');
190
isa_ok($pool,'_p_apr_pool_t',
191
'pool param is _p_apr_pool_t');
194
'log returns undef');
196
is($ctx->update($wcpath,'HEAD',1),$current_rev,
197
'Return from update is the current rev');
199
# no return so we should get undef as the result
200
# we will get a _p_svn_error_t if there is an error.
201
is($ctx->propset('perl-test','test-val',"$wcpath/dir1",0),undef,
202
'propset on a working copy path returns undef');
204
my ($ph) = $ctx->propget('perl-test',"$wcpath/dir1",undef,0);
205
isa_ok($ph,'HASH','propget returns a hash');
206
is($ph->{"$wcpath/dir1"},'test-val','perl-test property has the correct value');
208
# No revnum for the working copy so we should get INVALID_REVNUM
209
is($ctx->status($wcpath, undef, sub {
210
my ($path,$wc_status) = @_;
211
is($path,"$wcpath/dir1",
212
'path param to status callback is' .
213
'the correct path.');
214
isa_ok($wc_status,'_p_svn_wc_status_t',
215
'wc_stats param is a' .
216
' _p_svn_wc_status_t');
217
is($wc_status->prop_status(),
218
$SVN::Wc::status_modified,
219
'prop_status is status_modified');
220
# TODO test the rest of the members
223
$SVN::Core::INVALID_REVNUM,
224
'status returns INVALID_REVNUM when run against a working copy');
226
my ($ci_commit2) = $ctx->commit($wcpath,0);
227
isa_ok($ci_commit2,'_p_svn_client_commit_info_t',
228
'commit returns a _p_svn_client_commit_info_t');
230
is($ci_commit2->revision(),$current_rev,
231
"commit info revision equals $current_rev");
233
my $dir1_rev = $current_rev;
236
my($pl) = $ctx->proplist($reposurl,$current_rev,1);
237
isa_ok($pl,'ARRAY','proplist returns an ARRAY');
238
isa_ok($pl->[0], '_p_svn_client_proplist_item_t',
239
'array element is a _p_svn_client_proplist_item_t');
240
is($pl->[0]->node_name(),"$reposurl/dir1",
241
'node_name is the expected value');
242
my $plh = $pl->[0]->prop_hash();
244
'prop_hash returns a HASH');
245
is_deeply($plh, {'perl-test' => 'test-val'}, 'test prop list prop_hash values');
247
# add a dir to test update
248
my ($ci_dir2) = $ctx->mkdir(["$reposurl/dir2"]);
249
isa_ok($ci_dir2,'_p_svn_client_commit_info_t',
250
'mkdir returns a _p_svn_client_commit_info_t');
252
is($ci_dir2->revision(),$current_rev,
253
"commit info revision equals $current_rev");
255
# Use explicit revnum to test that instead of just HEAD.
256
is($ctx->update($wcpath,$current_rev,$current_rev),$current_rev,
257
'update returns current rev');
259
# commit action against a repo returns undef
260
is($ctx->delete(["$wcpath/dir2"],0),undef,
261
'delete returns undef');
263
# no return means success
264
is($ctx->revert($wcpath,1),undef,
265
'revert returns undef');
267
my ($ci_copy) = $ctx->copy("$reposurl/dir1",2,"$reposurl/dir3");
268
isa_ok($ci_copy,'_p_svn_client_commit_info_t',
269
'copy returns a _p_svn_client_commitn_info_t when run against repo');
271
is($ci_copy->revision,$current_rev,
272
"commit info revision equals $current_rev");
274
ok(mkdir($importpath),'Make import path dir');
275
ok(open(FOO, ">$importpath/foo"),'Open file for writing in import path dir');
276
ok(print(FOO 'foobar'),'Print to the file in import path dir');
277
ok(close(FOO),'Close file in import path dir');
279
my ($ci_import) = $ctx->import($importpath,$reposurl,0);
280
isa_ok($ci_import,'_p_svn_client_commit_info_t',
281
'Import returns _p_svn_client_commint_info_t');
283
is($ci_import->revision,$current_rev,
284
"commit info revision equals $current_rev");
286
is($ctx->blame("$reposurl/foo",'HEAD','HEAD', sub {
287
my ($line_no,$rev,$author,
288
$date, $line,$pool) = @_;
290
'line_no param is zero');
291
is($rev,$current_rev,
292
'rev param is current rev');
293
is($author,$username,
294
'author param is expected' .
296
ok($date,'date is defined');
298
'line is expected value');
299
isa_ok($pool,'_p_apr_pool_t',
304
'blame returns undef');
306
ok(open(CAT, "+>$testpath/cattest"),'open file for cat output');
307
is($ctx->cat(\*CAT, "$reposurl/foo", 'HEAD'),undef,
308
'cat returns undef');
310
'seek the beginning of the cat file');
311
is(readline(*CAT),'foobar',
312
'read the first line of the cat file');
313
ok(close(CAT),'close cat file');
315
# the string around the $current_rev exists to expose a past
316
# bug. In the past we did not accept values that simply
317
# had not been converted to a number yet.
318
my ($dirents) = $ctx->ls($reposurl,"$current_rev", 1);
319
isa_ok($dirents, 'HASH','ls returns a HASH');
320
isa_ok($dirents->{'dir1'},'_p_svn_dirent_t',
321
'hash value is a _p_svn_dirent_t');
322
is($dirents->{'dir1'}->kind(),$SVN::Core::node_dir,
323
'kind() returns a dir node');
324
is($dirents->{'dir1'}->size(),0,
325
'size() returns 0 for a directory');
326
is($dirents->{'dir1'}->has_props(),1,
327
'has_props() returns true');
328
is($dirents->{'dir1'}->created_rev(),$dir1_rev,
329
'created_rev() returns expected rev');
330
ok($dirents->{'dir1'}->time(),
332
#diag(scalar(localtime($dirents->{'dir1'}->time() / 1000000)));
333
is($dirents->{'dir1'}->last_author(),$username,
334
'last_auth() returns expected username');
336
# test removing a property
337
is($ctx->propset('perl-test', undef, "$wcpath/dir1", 0),undef,
338
'propset returns undef');
340
my ($ph2) = $ctx->propget('perl-test', "$wcpath/dir1", 'WORKING', 0);
341
isa_ok($ph2,'HASH','propget returns HASH');
342
is(scalar(keys %$ph2),0,
343
'No properties after deleting a property');
346
# This is ugly. It is included here as an aide to understand how
347
# to test this and because it makes my life easier as I only have
348
# one command to run to test it. If you want to use this you need
349
# to change the usernames, passwords, and paths to the client cert.
350
# It assumes that there is a repo running on localhost port 443 at
351
# via SSL. The repo cert should trip a client trust issue. The
352
# client cert should be encrypted and require a pass to use it.
353
# Finally uncomment the skip line below.
355
# Before shipping make sure the following line is uncommented.
356
skip 'Impossible to test without external effort to setup https', 7;
361
my $username_passed = shift;
362
my $may_save = shift;
365
ok(1,'simple_prompt called');
366
$cred->username('breser');
367
$cred->password('foo');
370
sub ssl_server_trust_prompt {
373
my $failures = shift;
374
my $cert_info = shift;
375
my $may_save = shift;
378
ok(1,'ssl_server_trust_prompt called');
380
$cred->accepted_failures($failures);
383
sub ssl_client_cert_prompt {
386
my $may_save = shift;
389
ok(1,'ssl_client_cert_prompt called');
390
$cred->cert_file('/home/breser/client-pass.p12');
393
sub ssl_client_cert_pw_prompt {
395
my $may_save = shift;
398
ok(1,'ssl_client_cert_pw_prompt called');
399
$cred->password('test');
402
my $oldauthbaton = $ctx->auth();
404
isa_ok($ctx->auth(SVN::Client::get_simple_prompt_provider(
405
sub { simple_prompt(@_,'x') },2),
406
SVN::Client::get_ssl_server_trust_prompt_provider(
407
\&ssl_server_trust_prompt),
408
SVN::Client::get_ssl_client_cert_prompt_provider(
409
\&ssl_client_cert_prompt,2),
410
SVN::Client::get_ssl_client_cert_pw_prompt_provider(
411
\&ssl_client_cert_pw_prompt,2)
412
),'_p_svn_auth_baton_t',
413
'auth() accessor returns _p_svn_auth_baton');
415
# if this doesn't work we will get an svn_error_t so by
416
# getting a hash we know it worked.
417
my ($dirents) = $ctx->ls('https://localhost/svn/test','HEAD',1);
418
isa_ok($dirents,'HASH','ls returns a HASH');
420
# return the auth baton to its original setting
421
isa_ok($ctx->auth($oldauthbaton),'_p_svn_auth_baton_t',
422
'Successfully set auth_baton back to old value');
added
removed
subversion/bindings/swig/perl/native/t/3client.t
