view release on metacpan or  search on metacpan

src/subversion/subversion/bindings/swig/perl/native/t/3client.t  view on Meta::CPAN

# TEST
ok(open(CAT, "+>$testpath/cattest"),'open file for cat output');
# TEST
is($ctx->cat(\*CAT, "$reposurl/foo", 'HEAD'),undef,
   'cat returns undef');
# TEST
ok(seek(CAT,0,0),
   'seek the beginning of the cat file');
# TEST
is(readline(*CAT),'foobar',
   'read the first line of the cat file');
# TEST
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);
# TEST
isa_ok($dirents, 'HASH','ls returns a HASH');
# TEST
isa_ok($dirents->{'dir1'},'_p_svn_dirent_t',
       'dirents hash value');
# TEST
is($dirents->{'dir1'}->kind(),$SVN::Core::node_dir,
   'kind() returns a dir node');
# TEST
is($dirents->{'dir1'}->size(),0,
   'size() returns 0 for a directory');
# TEST
is($dirents->{'dir1'}->has_props(),1,
   'has_props() returns true');
# TEST
is($dirents->{'dir1'}->created_rev(),$dir1_rev,
   'created_rev() returns expected rev');
# TEST
ok($dirents->{'dir1'}->time(),
   'time is defined');
#diag(scalar(localtime($dirents->{'dir1'}->time() / 1000000)));
# TEST
is($dirents->{'dir1'}->last_author(),$username,
   'last_auth() returns expected username');

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

my ($ph2) = $ctx->propget('perl-test', "$wcpath/dir1", 'WORKING', 0);
# TEST
isa_ok($ph2,'HASH','propget returns HASH');
# TEST
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();

    # TEST
    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);
    # TEST
    isa_ok($dirents,'HASH','ls returns a HASH');

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

# Keep track of the ok-ness ourselves, since we need to know the exact
# number of tests at the start of this file. The 'subtest' feature of
# Test::More would be perfect for this, but it's only available in very
# recent perl versions, it seems.
my $ok = 1;
# Get a list of platform specific providers, using the default
# configuration and pool.
my @providers = @{SVN::Core::auth_get_platform_specific_client_providers(undef, undef)};
foreach my $p (@providers) {
    $ok &= defined($p) && $p->isa('_p_svn_auth_provider_object_t');
}
# TEST
ok($ok, 'svn_auth_get_platform_specific_client_providers returns _p_svn_auth_provider_object_t\'s');

SKIP: {
  skip 'Gnome-Keyring support not compiled in', 1
      unless defined &SVN::Core::auth_set_gnome_keyring_unlock_prompt_func;

  # Test setting gnome_keyring prompt function. This just sets the proper
  # attributes in the auth baton and checks the return value (which should
  # be a reference to the passed function reference). This does not
  # actually try the prompt, since that would require setting up a
  # gnome-keyring-daemon...
  sub gnome_keyring_unlock_prompt {
      my $keyring_name = shift;
      my $pool = shift;

      'test';
  }

  my $callback = \&gnome_keyring_unlock_prompt;
  my $result = SVN::Core::auth_set_gnome_keyring_unlock_prompt_func(