3client.t

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

#!/usr/bin/perl -w

use Test::More tests => 117;
use strict;

# shut up about variables that are only used once.
# these come from constants and variables used
# by the bindings but not elsewhere in perl space.
no warnings 'once'; 

use_ok('SVN::Core');
use_ok('SVN::Repos');
use_ok('SVN::Client');
use_ok('SVN::Wc'); # needed for status
use File::Spec::Functions;
use File::Temp qw(tempdir);
use File::Path qw(rmtree);

# do not use cleanup because it will fail, some files we
# will not have write perms to.
my $testpath = tempdir('svn-perl-test-XXXXXX', TMPDIR => 1, CLEANUP => 1);

my $repospath = catdir($testpath,'repo');
my $reposurl = 'file://' . (substr($repospath,0,1) ne '/' ? '/' : '')
               . $repospath;
my $wcpath = catdir($testpath,'wc');
my $importpath = catdir($testpath,'import');

# track current rev ourselves to test against
my $current_rev = 0;

# We want to trap errors ourself
$SVN::Error::handler = undef;

# Get username we are running as
my $username = getpwuid($>);

# This is ugly to create the test repo with SVN::Repos, but
# it seems to be the most reliable way.
ok(SVN::Repos::create("$repospath", undef, undef, undef, undef),
   "create repository at $repospath");

my ($ctx) = SVN::Client->new;
isa_ok($ctx,'SVN::Client','Client Object');

my $uuid_from_url = $ctx->uuid_from_url($reposurl);
ok($uuid_from_url,'Valid return from uuid_from_url method form');

# test non method invocation passing a SVN::Client
ok(SVN::Client::uuid_from_url($reposurl,$ctx),
   'Valid return from uuid_from_url function form with SVN::Client object');

# test non method invocation passing a _p_svn_client_ctx_t
ok(SVN::Client::uuid_from_url($reposurl,$ctx->{'ctx'}),
   'Valid return from uuid_from_url function form with _p_svn_client_ctx object');

             
my ($ci_dir1) = $ctx->mkdir(["$reposurl/dir1"]);
isa_ok($ci_dir1,'_p_svn_client_commit_info_t');
$current_rev++;
is($ci_dir1->revision,$current_rev,"commit info revision equals $current_rev");



my ($rpgval,$rpgrev) = $ctx->revprop_get('svn:author',$reposurl,$current_rev);
is($rpgval,$username,'svn:author set to expected username from revprop_get');
is($rpgrev,$current_rev,'Returned revnum of current rev from revprop_get');

SKIP: {
    skip 'Difficult to test on Win32', 3 if $^O eq 'MSWin32';

    ok(rename("$repospath/hooks/pre-revprop-change.tmpl",
              "$repospath/hooks/pre-revprop-change"),
       'Rename pre-revprop-change hook');
    ok(chmod(0700,"$repospath/hooks/pre-revprop-change"),
       'Change permissions on pre-revprop-change hook');

    my ($rps_rev) = $ctx->revprop_set('svn:log','mkdir dir1',
                                      $reposurl, $current_rev, 0);
    is($rps_rev,$current_rev,
       'Returned revnum of current rev from revprop_set');

}

my ($rph, $rplrev) = $ctx->revprop_list($reposurl,$current_rev);
isa_ok($rph,'HASH','Returned hash reference form revprop_list');
is($rplrev,$current_rev,'Returned current rev from revprop_list');
is($rph->{'svn:author'},$username,
   'svn:author is expected user from revprop_list');
if ($^O eq 'MSWin32') {
    # we skip the log change test on win32 so we have to test
    # for a different var here
    is($rph->{'svn:log'},'Make dir1',
       'svn:log is expected value from revprop_list');
} else {
    is($rph->{'svn:log'},'mkdir dir1',
       'svn:log is expected value from revprop_list');
}
ok($rph->{'svn:date'},'svn:date is set from revprop_list');

is($ctx->checkout($reposurl,$wcpath,'HEAD',1),$current_rev,
   'Returned current rev from checkout');

is(SVN::Client::url_from_path($wcpath),$reposurl,
   "Returned $reposurl from url_from_path");

ok(open(NEW, ">$wcpath/dir1/new"),'Open new file for writing');
ok(print(NEW 'addtest'), 'Print to new file');
ok(close(NEW),'Close new file');

# no return means success
is($ctx->add("$wcpath/dir1/new",0),undef,
   'Returned undef from add schedule operation');

# test the log_msg callback
$ctx->log_msg( 
    sub 
    {
        my ($log_msg,$tmp_file,$commit_items,$pool) = @_;
        isa_ok($log_msg,'SCALAR','log_msg param to callback is a SCALAR');
        isa_ok($tmp_file,'SCALAR','tmp_file param to callback is a SCALAR');
        isa_ok($commit_items,'ARRAY',
               'commit_items param to callback is a SCALAR');
        isa_ok($pool,'_p_apr_pool_t',
               'pool param to callback is a _p_apr_pool_t');
        my $commit_item = shift @$commit_items;
        isa_ok($commit_item,'_p_svn_client_commit_item_t',
               'commit_item element is a _p_svn_client_commit_item_t');
        is($commit_item->path(),"$wcpath/dir1/new",
           "commit_item has proper path for committed file");
        is($commit_item->kind(),$SVN::Node::file,
           "kind() shows the node as a file");
        is($commit_item->url(),"$reposurl/dir1/new",
           'URL matches our repos url');
        # revision is 0 because the commit has not happened yet
        # and this is not a copy
        is($commit_item->revision(),0,
           'Revision is 0 since commit has not happened yet');
        is($commit_item->copyfrom_url(),undef,
           'copyfrom_url is undef since file is not a copy');
        is($commit_item->state_flags(),$SVN::Client::COMMIT_ITEM_ADD |
                                       $SVN::Client::COMMIT_ITEM_TEXT_MODS,
           'state_flags are ADD and TEXT_MODS');
        my $wcprop_changes = $commit_item->wcprop_changes();
        isa_ok($wcprop_changes,'ARRAY','wcprop_changes returns an ARRAY');
        is(scalar(@$wcprop_changes),0,
           'No elements in the wcprop_changes array because '. 
           ' we did not make any');
        $$log_msg = 'Add new';
        return 0;
    } );


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

# get rid of log_msg callback
is($ctx->log_msg(undef),undef,
   'Clearing the log_msg callback works');

# test info() on WC
is($ctx->info("$wcpath/dir1/new", undef, 'WORKING',
              sub
              {
                 my($infopath,$svn_info_t,$pool) = @_;
                 is($infopath,"new",'path passed to receiver is same as WC');
                 isa_ok($svn_info_t,'_p_svn_info_t');
                 isa_ok($pool,'_p_apr_pool_t',
                        'pool param is _p_apr_pool_t');
              }, 0),
   undef,
   'info should return undef');

isa_ok($ctx->info("$wcpath/dir1/newxyz", undef, 'WORKING', sub {}, 0),
       '_p_svn_error_t',
       'info should return _p_svn_error_t for a nonexistent file');

# test getting the log
is($ctx->log("$reposurl/dir1/new",$current_rev,$current_rev,1,0,
             sub 
             {
                 my ($changed_paths,$revision,
                     $author,$date,$message,$pool) = @_;
                 isa_ok($changed_paths,'HASH',
                        'changed_paths param is a HASH');
                 isa_ok($changed_paths->{'/dir1/new'},
                        '_p_svn_log_changed_path_t',
                        'Hash value is a _p_svn_log_changed_path_t');
                 is($changed_paths->{'/dir1/new'}->action(),'A',
                    'action returns A for add');
                 is($changed_paths->{'/dir1/new'}->copyfrom_path(),undef,
                    'copyfrom_path returns undef as it is not a copy');
                 is($changed_paths->{'/dir1/new'}->copyfrom_rev(),
                    $SVN::Core::INVALID_REVNUM,
                    'copyfrom_rev is set to INVALID as it is not a copy');
                 is($revision,$current_rev,
                    'revision param matches current rev');
                 is($author,$username,
                    'author param matches expected username');
                 ok($date,'date param is defined');
                 is($message,'Add new',
                    'message param is the expected value');
                 isa_ok($pool,'_p_apr_pool_t',
                        'pool param is _p_apr_pool_t');
             }),
   undef,
   'log returns undef');

is($ctx->update($wcpath,'HEAD',1),$current_rev,
   'Return from update is the current rev');

# no return so we should get undef as the result
# we will get a _p_svn_error_t if there is an error. 
is($ctx->propset('perl-test','test-val',"$wcpath/dir1",0),undef,
   'propset on a working copy path returns undef');

my ($ph) = $ctx->propget('perl-test',"$wcpath/dir1",undef,0);
isa_ok($ph,'HASH','propget returns a hash');
is($ph->{"$wcpath/dir1"},'test-val','perl-test property has the correct value');