3client.t

subversion-1.4.3-1.tar.gz 配置svn的源码

# No revnum for the working copy so we should get INVALID_REVNUM
is($ctx->status($wcpath, undef, sub { 
                                      my ($path,$wc_status) = @_;
                                      is($path,"$wcpath/dir1",
                                         'path param to status callback is' .
                                         'the correct path.');
                                      isa_ok($wc_status,'_p_svn_wc_status_t',
                                             'wc_stats param is a' .
                                             ' _p_svn_wc_status_t');
                                      is($wc_status->prop_status(),
                                         $SVN::Wc::status_modified,
                                         'prop_status is status_modified');
                                      # TODO test the rest of the members
                                    },
                1, 0, 0, 0),
   $SVN::Core::INVALID_REVNUM,
   'status returns INVALID_REVNUM when run against a working copy');

my ($ci_commit2) = $ctx->commit($wcpath,0);
isa_ok($ci_commit2,'_p_svn_client_commit_info_t',
       'commit returns a _p_svn_client_commit_info_t');
$current_rev++;
is($ci_commit2->revision(),$current_rev,
   "commit info revision equals $current_rev");

my $dir1_rev = $current_rev;


my($pl) = $ctx->proplist($reposurl,$current_rev,1);
isa_ok($pl,'ARRAY','proplist returns an ARRAY');
isa_ok($pl->[0], '_p_svn_client_proplist_item_t',
       'array element is a _p_svn_client_proplist_item_t');
is($pl->[0]->node_name(),"$reposurl/dir1",
   'node_name is the expected value');
my $plh = $pl->[0]->prop_hash();
isa_ok($plh,'HASH',
       'prop_hash returns a HASH');
is_deeply($plh, {'perl-test' => 'test-val'}, 'test prop list prop_hash values');

# add a dir to test update
my ($ci_dir2) = $ctx->mkdir(["$reposurl/dir2"]);
isa_ok($ci_dir2,'_p_svn_client_commit_info_t',
       'mkdir returns a _p_svn_client_commit_info_t');
$current_rev++;
is($ci_dir2->revision(),$current_rev,
   "commit info revision equals $current_rev");

# Use explicit revnum to test that instead of just HEAD.
is($ctx->update($wcpath,$current_rev,$current_rev),$current_rev,
   'update returns current rev');

# commit action against a repo returns undef
is($ctx->delete(["$wcpath/dir2"],0),undef,
   'delete returns undef');

# no return means success
is($ctx->revert($wcpath,1),undef,
   'revert returns undef');

my ($ci_copy) = $ctx->copy("$reposurl/dir1",2,"$reposurl/dir3");
isa_ok($ci_copy,'_p_svn_client_commit_info_t',
       'copy returns a _p_svn_client_commitn_info_t when run against repo');
$current_rev++;
is($ci_copy->revision,$current_rev,
   "commit info revision equals $current_rev");

ok(mkdir($importpath),'Make import path dir');
ok(open(FOO, ">$importpath/foo"),'Open file for writing in import path dir');
ok(print(FOO 'foobar'),'Print to the file in import path dir');
ok(close(FOO),'Close file in import path dir');

my ($ci_import) = $ctx->import($importpath,$reposurl,0);
isa_ok($ci_import,'_p_svn_client_commit_info_t',
       'Import returns _p_svn_client_commint_info_t');
$current_rev++;
is($ci_import->revision,$current_rev,
   "commit info revision equals $current_rev");

is($ctx->blame("$reposurl/foo",'HEAD','HEAD', sub {
                                              my ($line_no,$rev,$author,
                                                  $date, $line,$pool) = @_;
                                              is($line_no,0,
                                                 'line_no param is zero');
                                              is($rev,$current_rev,
                                                 'rev param is current rev');
                                              is($author,$username,
                                                 'author param is expected' .
                                                 'value');
                                              ok($date,'date is defined');
                                              is($line,'foobar',
                                                 'line is expected value');
                                              isa_ok($pool,'_p_apr_pool_t',
                                                     'pool param is ' .
                                                     '_p_apr_pool_t');
                                            }),
   undef,
   'blame returns undef');

ok(open(CAT, "+>$testpath/cattest"),'open file for cat output');
is($ctx->cat(\*CAT, "$reposurl/foo", 'HEAD'),undef,
   'cat returns undef');
ok(seek(CAT,0,0),
   'seek the beginning of the cat file');
is(readline(*CAT),'foobar',
   'read the first line of the cat file');
ok(close(CAT),'close cat file');

# the string around the $current_rev exists to expose a past
# bug.  In the past we did not accept values that simply
# had not been converted to a number yet.
my ($dirents) = $ctx->ls($reposurl,"$current_rev", 1);
isa_ok($dirents, 'HASH','ls returns a HASH');
isa_ok($dirents->{'dir1'},'_p_svn_dirent_t',
       'hash value is a _p_svn_dirent_t');
is($dirents->{'dir1'}->kind(),$SVN::Core::node_dir,
   'kind() returns a dir node');
is($dirents->{'dir1'}->size(),0,
   'size() returns 0 for a directory');
is($dirents->{'dir1'}->has_props(),1,
   'has_props() returns true');
is($dirents->{'dir1'}->created_rev(),$dir1_rev,
   'created_rev() returns expected rev');
ok($dirents->{'dir1'}->time(),
   'time is defined');
#diag(scalar(localtime($dirents->{'dir1'}->time() / 1000000)));
is($dirents->{'dir1'}->last_author(),$username,
   'last_auth() returns expected username');

# test removing a property
is($ctx->propset('perl-test', undef, "$wcpath/dir1", 0),undef,
   'propset returns undef');

my ($ph2) = $ctx->propget('perl-test', "$wcpath/dir1", 'WORKING', 0);
isa_ok($ph2,'HASH','propget returns HASH');
is(scalar(keys %$ph2),0,
   'No properties after deleting a property');

SKIP: {
    # This is ugly.  It is included here as an aide to understand how
    # to test this and because it makes my life easier as I only have
    # one command to run to test it.  If you want to use this you need
    # to change the usernames, passwords, and paths to the client cert.
    # It assumes that there is a repo running on localhost port 443 at
    # via SSL.  The repo cert should trip a client trust issue.  The 
    # client cert should be encrypted and require a pass to use it.
    # Finally uncomment the skip line below.

    # Before shipping make sure the following line is uncommented. 
    skip 'Impossible to test without external effort to setup https', 7;
 
    sub simple_prompt {
        my $cred = shift;
        my $realm = shift;
        my $username_passed = shift;
        my $may_save = shift; 
        my $pool = shift;
 
        ok(1,'simple_prompt called'); 
        $cred->username('breser');
        $cred->password('foo');
    }

    sub ssl_server_trust_prompt {
        my $cred = shift;
        my $realm = shift;
        my $failures = shift;
        my $cert_info = shift;
        my $may_save = shift;
        my $pool = shift;
  
        ok(1,'ssl_server_trust_prompt called');
        $cred->may_save(0);
        $cred->accepted_failures($failures);
    }

    sub ssl_client_cert_prompt {
        my $cred = shift;
        my $realm = shift;
        my $may_save = shift;
        my $pool = shift;

        ok(1,'ssl_client_cert_prompt called');
        $cred->cert_file('/home/breser/client-pass.p12');
    }

    sub ssl_client_cert_pw_prompt {
        my $cred = shift;
        my $may_save = shift;
        my $pool = shift;
    
        ok(1,'ssl_client_cert_pw_prompt called');
        $cred->password('test');
    } 

    my $oldauthbaton = $ctx->auth();

    isa_ok($ctx->auth(SVN::Client::get_simple_prompt_provider(
                                sub { simple_prompt(@_,'x') },2),
               SVN::Client::get_ssl_server_trust_prompt_provider(
                                \&ssl_server_trust_prompt),
               SVN::Client::get_ssl_client_cert_prompt_provider(
                                \&ssl_client_cert_prompt,2),
               SVN::Client::get_ssl_client_cert_pw_prompt_provider(
                                \&ssl_client_cert_pw_prompt,2)
              ),'_p_svn_auth_baton_t',
              'auth() accessor returns _p_svn_auth_baton');
     
    # if this doesn't work we will get an svn_error_t so by 
    # getting a hash we know it worked. 
    my ($dirents) = $ctx->ls('https://localhost/svn/test','HEAD',1);
    isa_ok($dirents,'HASH','ls returns a HASH');

    # return the auth baton to its original setting
    isa_ok($ctx->auth($oldauthbaton),'_p_svn_auth_baton_t',
           'Successfully set auth_baton back to old value');
}

END {
diag('cleanup');
rmtree($testpath);
}