view release on metacpan or  search on metacpan

t/6_dav_open_put_get.t  view on Meta::CPAN

use strict;
use HTTP::DAV;
use Test;
use lib 't';
use TestDetails qw($test_user $test_pass $test_url $test_cwd do_test fail_tests test_callback);


# Sends out a propfind request to the server 
# specified in "PROPFIND" in the TestDetails 
# module.

my $TESTS;
$TESTS=39;
plan tests => $TESTS;

my $user = $test_user;
my $pass = $test_pass;
my $url = $test_url;
my $cwd = $test_cwd;

fail_tests($TESTS) unless $test_url =~ /http/;

HTTP::DAV::DebugLevel(2);
my $dav;

# Test get_workingurl on empty client
$dav = HTTP::DAV->new( );
do_test $dav, $dav->get_workingurl(), "", "Empty get_workingurl";

# Test an empty open. Should fail.
do_test $dav, $dav->open(), 0, "OPEN nothing";

$dav = HTTP::DAV->new();
# Set some creds and then open the URL
$dav->credentials( $user, $pass, $url );

do_test $dav, $dav->open( $url ), 1, "OPEN $url";

do_test $dav, $dav->open( -url => $url ), 1, "OPEN $url";

# Try opening a non-collection. It should fail.
#do_test $dav, $dav->open( -url => $geturl ), 0, "OPEN $geturl";

# Test various ways of getting the working url
my $working_url1 = $dav->get_workingresource()->get_uri();
my $working_url2 = $dav->get_workingurl();
my $test_url = $url;
ok($working_url1 eq $test_url);
ok($working_url2 eq $test_url);
ok($working_url1 eq $working_url2);

print "AM STARTING THE OPERATIONS!!\n";

# Make a directory with our process id after it 
# so that it is somewhat random
my $newdir = "perldav_test$$";
do_test $dav, $dav->mkcol($newdir), 1, "MKCOL $newdir";

# Try it again. This time it should fail.
do_test $dav, $dav->mkcol($newdir), 0, "MKCOL $newdir";

# Try changing to it. It should work
do_test $dav, $dav->cwd($newdir), 1, "CWD to $newdir";

# Make another in newdir.
do_test $dav, $dav->mkcol("subdir"),1, 'MKCOL "subdir"';

# Go back again. cwd .. It should work.
do_test $dav, $dav->cwd(".."), 1, "CWD to '..'";

######################################################################
# PUT some files
print "Doing PUT\n";
my $localdir = "/tmp/perldav";

# Test put with absolute paths

do_test $dav, $dav->put("t/test_data","$newdir",\&test_callback), 1, "put t";
print scalar $dav->message() . "\n";

# Try putting the directory to a bogus location
do_test $dav, $dav->put("t/test_data","/foobar/$newdir/",\&test_callback), 0, "put t";

if (!open(F,">/tmp/tmpfile.txt") ) {
   print "Couldn't open /tmp/tmpfile.txt";
}
print F "I am content that came from a local file \n";
close F;

my $some_content="I am content that came from a scalar\n";

do_test $dav, $dav->put("/tmp/tmpfile.txt","$newdir/file.txt"), 1, "put $newdir/file.txt";
print scalar $dav->message() . "\n";
do_test $dav, $dav->put(\$some_content,"$newdir/scalar_to_file.txt"), 1, 'put \$some_content';
print scalar $dav->message() . "\n";