HTTP-DAV
view release on metacpan or search on metacpan
* bug fixes
- Fixed RT #59674 (http://rt.cpan.org/Public/Bug/Display.html?id=59674),
When SSL support is needed but not installed, a more specific
error messages is now displayed, instead of "not DAV enabled or not accessible".
v0.40 (released 2010/01/27):
* bug fixes
- Fixed RT #47500 (http://rt.cpan.org/Public/Bug/Display.html?id=47500),
HTTP::DAV::Comms->credentials() method erroneously autovivified
basic authentication internal values, causing wrong or undefined
credentials to be sent out, or credentials to be "forgot" by HTTP::DAV.
v0.39 (released 2009/12/12):
* bug fixes
- Fixed RT #52665 (http://rt.cpan.org/Public/Bug/Display.html?id=52665),
Using dave or propfind() on URLs containing escaped chars (%xx) could fail,
due to upper/lower case differences. Thanks to cebjyre for the patch
and the test case.
v0.38 (released 2009/06/09):
in the "SCALAR(0x12345678)" being logged instead of the real scalar.
v0.36 (released 2009/02/25):
* bug fixes
- Fixed RT #19616 (http://rt.cpan.org/Public/Bug/Display.html?id=19616),
LWP::UserAgent::redirect_ok() is not changed anymore. We're subclassing
it from HTTP::DAV::UserAgent and overriding redirect_ok() there.
- Fixed RT #42877 (http://rt.cpan.org/Public/Bug/Display.html?id=42877),
HTTP::DAV::UserAgent::credentials() has been modified to behave like
LWP::UserAgent::credentials(), otherwise basic authentication breakages
can occur.
- Fixed a problem with C<-depth> argument to C<HTTP::DAV::propfind()> that
could lead to massive performance degradation, especially when running
C<propfind()> against large folders.
C<-depth> was set to 1 even when passed as zero.
v0.35 (released 2008/11/03):
* bug fixes
pod2usage( -message => "$0: You must only specify one URL.\n")
}
print $OUT <<END;
dave -- DAV Explorer (v$VERSION)
Try "help", or "open http://host.com/dav_enabled_dir/"
END
# Put the credentials into HTTP::DAV for $url
my $url=shift @ARGV;
if ($user && $url) {
$gdc->credentials( -user=>$user, -pass=>$pass, -url=>$url );
}
&command_open($url) if ($url );
######################################################################
# WHILE dave> command
my $line;
while ( defined ($line = $term->readline($prompt)) ) {
# Hack. Put a space between the ! shellout command and the next arg
$line =~ s/^([!])/$1 /g;
return $self;
}
sub request {
my($self) = shift;
my $resp = $self->SUPER::request(@_);
# Only if we did not get a 401 back from the server
# do we go and
# commit the user's details to memory.
$self->_commit_credentials() if ($resp->code() != 401);
return $resp;
}
sub _set_credentials {shift->{_temp_credentials} = \@_; }
sub _commit_credentials {
my ($self)=@_;
if (defined $self->{_temp_credentials} ) {
$self->credentials(@{$self->{_temp_credentials}});
$self->{_temp_credentials} = undef;
}
}
sub get_basic_credentials {
my($self, $realm, $url) = @_;
my $userpass;
# First, try to get the details from our memory.
my @mem_userpass = $self->SUPER::get_basic_credentials($realm,$url);
return @mem_userpass if @mem_userpass;
if (-t) {
my $netloc = $url->host_port;
if ($self->{_failed_logins}->{$realm . $netloc}++ > 3) {
return (undef,undef)
}
print "\nEnter username for $realm at $netloc: ";
my $user = <STDIN>;
chomp($user);
return (undef, undef) unless length $user;
print "Password: ";
system("stty -echo");
my $password = <STDIN>;
system("stty echo");
print "\n"; # because we disabled echo
chomp($password);
$self->_set_credentials($netloc, $realm,$user,$password);
#print "Returning $user, $password\n";
return ($user, $password);
} else {
return (undef, undef)
}
}
}
######################################################################
# Setup our help system with this nifty Pod::Parser from the
doc/html/Changes.html view on Meta::CPAN
</li>
</ul>
<h2 id="v0.40-released-2010-01-27">v0.40 (released 2010/01/27):</h2>
<ul>
<li><p><b>bug fixes</b></p>
<pre><code>- Fixed RT #47500 (http://rt.cpan.org/Public/Bug/Display.html?id=47500),
HTTP::DAV::Comms->credentials() method erroneously autovivified
basic authentication internal values, causing wrong or undefined
credentials to be sent out, or credentials to be "forgot" by HTTP::DAV.</code></pre>
</li>
</ul>
<h2 id="v0.39-released-2009-12-12">v0.39 (released 2009/12/12):</h2>
<ul>
<li><p><b>bug fixes</b></p>
doc/html/Changes.html view on Meta::CPAN
<ul>
<li><p><b>bug fixes</b></p>
<pre><code>- Fixed RT #19616 (http://rt.cpan.org/Public/Bug/Display.html?id=19616),
LWP::UserAgent::redirect_ok() is not changed anymore. We're subclassing
it from HTTP::DAV::UserAgent and overriding redirect_ok() there.
- Fixed RT #42877 (http://rt.cpan.org/Public/Bug/Display.html?id=42877),
HTTP::DAV::UserAgent::credentials() has been modified to behave like
LWP::UserAgent::credentials(), otherwise basic authentication breakages
can occur.
- Fixed a problem with C<-depth> argument to C<HTTP::DAV::propfind()> that
could lead to massive performance degradation, especially when running
C<propfind()> against large folders.
C<-depth> was set to 1 even when passed as zero.</code></pre>
</li>
</ul>
doc/html/HTTP-DAV.html view on Meta::CPAN
<pre><code> # DAV script that connects to a webserver, safely makes
# a new directory and uploads all html files in
# the /tmp directory.
use HTTP::DAV;
$d = HTTP::DAV->new();
$url = "http://host.org:8080/dav/";
$d->credentials(
-user => "pcollins",
-pass => "mypass",
-url => $url,
-realm => "DAV Realm"
);
$d->open( -url => $url )
or die("Couldn't open $url: " .$d->message . "\n");
# Make a null lock on newdir
doc/html/HTTP-DAV.html view on Meta::CPAN
<p>The <code>-useragent</code> parameter allows you to pass your own <b>user agent object</b> and expects an <code>HTTP::DAV::UserAgent</code> object. See the <code>dave</code> program for an advanced example of a custom UserAgent that interactively ...
<p>The <code>-headers</code> parameter allows you to specify a list of headers to be sent along with all requests. This can be either a hashref like:</p>
<pre><code>{ "X-My-Header" => "value", ... }</code></pre>
<p>or a <a>HTTP::Headers</a> object.</p>
</dd>
<dt id="credentials-USER-PASS-URL-REALM"><b>credentials(USER,PASS,[URL],[REALM])</b></dt>
<dd>
<p>sets authorization credentials for a <code>URL</code> and/or <code>REALM</code>.</p>
<p>When the client hits a protected resource it will check these credentials to see if either the <code>URL</code> or <code>REALM</code> match the authorization response.</p>
<p>Either <code>URL</code> or <code>REALM</code> must be provided.</p>
<p>returns no value</p>
<p>Example:</p>
<pre><code>$d->credentials( -url=>'myhost.org:8080/test/',
-user=>'pcollins',
-pass=>'mypass');</code></pre>
</dd>
<dt id="DebugLevel-val"><b>DebugLevel($val)</b></dt>
<dd>
<p>sets the debug level to <code>$val</code>. 0=off 3=noisy.</p>
<p><code>$val</code> default is 0.</p>
lib/HTTP/DAV.pm view on Meta::CPAN
sub get_workingresource { $_[0]->{_workingresource} }
sub get_workingurl {
$_[0]->{_workingresource}->get_uri()
if defined $_[0]->{_workingresource};
}
sub get_lockedresourcelist { $_[0]->{_lockedresourcelist} }
# SET
sub set_workingresource { $_[0]->{_workingresource} = $_[1]; }
sub credentials { shift->{_comms}->credentials(@_); }
######################################################################
# Error handling
## Error conditions
my %err = (
'ERR_WRONG_ARGS' => 'Wrong number of arguments supplied.',
'ERR_UNAUTHORIZED' => 'Unauthorized. ',
'ERR_NULL_RESOURCE' => 'Not connected. Do an open first. ',
'ERR_RESP_FAIL' => 'Server response: ',
lib/HTTP/DAV.pm view on Meta::CPAN
# DAV script that connects to a webserver, safely makes
# a new directory and uploads all html files in
# the /tmp directory.
use HTTP::DAV;
$d = HTTP::DAV->new();
$url = "http://host.org:8080/dav/";
$d->credentials(
-user => "pcollins",
-pass => "mypass",
-url => $url,
-realm => "DAV Realm"
);
$d->open( -url => $url )
or die("Couldn't open $url: " .$d->message . "\n");
# Make a null lock on newdir
lib/HTTP/DAV.pm view on Meta::CPAN
$d = HTTP::DAV->new();
The C<-useragent> parameter allows you to pass your own B<user agent object> and expects an C<HTTP::DAV::UserAgent> object. See the C<dave> program for an advanced example of a custom UserAgent that interactively prompts the user for their username a...
The C<-headers> parameter allows you to specify a list of headers to be sent along with all requests. This can be either a hashref like:
{ "X-My-Header" => "value", ... }
or a L<HTTP::Headers> object.
=item B<credentials(USER,PASS,[URL],[REALM])>
sets authorization credentials for a C<URL> and/or C<REALM>.
When the client hits a protected resource it will check these credentials to see if either the C<URL> or C<REALM> match the authorization response.
Either C<URL> or C<REALM> must be provided.
returns no value
Example:
$d->credentials( -url=>'myhost.org:8080/test/',
-user=>'pcollins',
-pass=>'mypass');
=item B<DebugLevel($val)>
sets the debug level to C<$val>. 0=off 3=noisy.
C<$val> default is 0.
returns no value.
lib/HTTP/DAV/Changes.pod view on Meta::CPAN
=back
=head2 v0.40 (released 2010/01/27):
=over 4
=item * B<bug fixes>
- Fixed RT #47500 (http://rt.cpan.org/Public/Bug/Display.html?id=47500),
HTTP::DAV::Comms->credentials() method erroneously autovivified
basic authentication internal values, causing wrong or undefined
credentials to be sent out, or credentials to be "forgot" by HTTP::DAV.
=back
=head2 v0.39 (released 2009/12/12):
=over 4
=item * B<bug fixes>
- Fixed RT #52665 (http://rt.cpan.org/Public/Bug/Display.html?id=52665),
lib/HTTP/DAV/Changes.pod view on Meta::CPAN
=over 4
=item * B<bug fixes>
- Fixed RT #19616 (http://rt.cpan.org/Public/Bug/Display.html?id=19616),
LWP::UserAgent::redirect_ok() is not changed anymore. We're subclassing
it from HTTP::DAV::UserAgent and overriding redirect_ok() there.
- Fixed RT #42877 (http://rt.cpan.org/Public/Bug/Display.html?id=42877),
HTTP::DAV::UserAgent::credentials() has been modified to behave like
LWP::UserAgent::credentials(), otherwise basic authentication breakages
can occur.
- Fixed a problem with C<-depth> argument to C<HTTP::DAV::propfind()> that
could lead to massive performance degradation, especially when running
C<propfind()> against large folders.
C<-depth> was set to 1 even when passed as zero.
=back
=head2 v0.35 (released 2008/11/03):
lib/HTTP/DAV/Comms.pm view on Meta::CPAN
# URL management
my $url_obj;
$url_obj = ( ref($url) =~ /URI/ ) ? $url : URI->new($url);
die "Comms: Bad HTTP Url: \"$url_obj\"\n"
if ( $url_obj->scheme !~ /^http/ );
# If you see user:pass detail embedded in the URL. Then get it out.
if ( $url_obj->userinfo ) {
$self->{_user_agent}
->credentials( $url, undef, split( ':', $url_obj->userinfo ) );
}
# Header management
if ( $newheaders && ref($newheaders) !~ /Headers/ ) {
die "Bad headers object: "
. Data::Dumper->Dump( [$newheaders], ['$newheaders'] );
}
my $headers = HTTP::DAV::Headers->new();
$headers->add_headers( $self->{_headers} );
lib/HTTP/DAV/Comms.pm view on Meta::CPAN
my $length = ($content) ? length($content) : 0;
$headers->header( "Content-Length", $length );
#print "HTTP HEADERS\n" . $self->get_headers->as_string . "\n\n";
# It would be good if, at this stage, we could prefill the
# username and password values to prevent the client having
# to submit 2 requests, submit->401, submit->200
# This is the same kind of username, password remembering
# functionality that a browser performs.
#@userpass = $self->{_user_agent}->get_basic_credentials(undef, $url);
# Add a Content-type of text/xml if the body has <?xml in it
if ( $content && $content =~ /<\?xml/i ) {
$headers->header( "Content-Type", "text/xml" );
}
####
# Do the HTTP call
my $req
= HTTP::Request->new( $method, $url_obj, $headers->to_http_headers,
lib/HTTP/DAV/Comms.pm view on Meta::CPAN
# Save the req and resp objects as the "last used"
$self->_set_last_request($req);
$self->_set_last_response($dav_resp);
$self->_set_server_type( $url_obj->host_port,
$dav_resp->headers->header("Server") );
return $dav_resp;
}
sub credentials {
my ( $self, @p ) = @_;
my ( $user, $pass, $url, $realm )
= HTTP::DAV::Utils::rearrange( [ 'USER', 'PASS', 'URL', 'REALM' ],
@p );
$self->{_user_agent}->credentials( $url, $realm, $user, $pass );
}
###########################################################################
# We make our own specialization of LWP::UserAgent
# called HTTP::DAV::UserAgent.
# The variations allow us to have various levels of protection.
# Where the user hasn't specified what Realm to use we pass the
# userpass combo to all realms of that host
# Also this UserAgent remembers a user on the next request.
# The standard UserAgent doesn't.
lib/HTTP/DAV/Comms.pm view on Meta::CPAN
@ISA = qw(LWP::UserAgent);
#require LWP::UserAgent;
sub new {
my $self = LWP::UserAgent::new(@_);
$self->agent("lwp-request/$HTTP::DAV::VERSION");
$self;
}
sub credentials {
my ( $self, $netloc, $realm, $user, $pass ) = @_;
$realm = 'default' unless $realm;
if ($netloc) {
$netloc = "http://$netloc" unless $netloc =~ m{^http};
my $uri = URI->new($netloc);
$netloc = $uri->host_port;
}
else {
lib/HTTP/DAV/Comms.pm view on Meta::CPAN
my $cred;
if (
exists $self->{basic_authentication}->{$netloc} &&
exists $self->{basic_authentication}->{$netloc}->{$realm}) {
$cred = $self->{basic_authentication}->{$netloc}->{$realm};
}
else {
$cred = [];
}
# Replace with new credentials (if any)
if (defined $user) {
$self->{basic_authentication}->{$netloc}->{$realm}->[0] = $user;
$self->{basic_authentication}->{$netloc}->{$realm}->[1] = $pass;
$cred = $self->{basic_authentication}->{$netloc}->{$realm};
}
# Return current values
if (! @{$cred}) {
return wantarray ? () : undef;
}
# User/password pair
if (wantarray) { return @{$cred} }
# As string: 'user:password'
return join( ':', @{$cred} );
}
sub get_basic_credentials {
my ( $self, $realm, $uri ) = @_;
$uri = HTTP::DAV::Utils::make_uri($uri);
my $netloc = $uri->host_port;
my $userpass;
{
no warnings; # SHUTUP with your silly warnings.
$userpass
= $self->{'basic_authentication'}{$netloc}{$realm}
lib/HTTP/DAV/Resource.pm view on Meta::CPAN
}
sub get_options { $_[0]->{_options}; }
sub get_content { $_[0]->{_content}; }
sub get_content_ref { \$_[0]->{_content}; }
sub get_username {
my ($self) = @_;
my $ra = $self->{_comms}->get_user_agent();
my @userpass = $ra->get_basic_credentials(undef, $self->get_uri());
return $userpass[0];
}
#sub get_lockpolicy { $_[0]->{_lockpolicy}; }
sub get_client { $_[0]->{_dav_client}; }
sub get_resourcelist { $_[0]->{_resource_list}; }
sub get_lockedresourcelist { $_[0]->{_lockedresourcelist}; }
sub get_comms { $_[0]->{_comms}; }
sub get_property { $_[0]->{_properties}{ $_[1] } || ""; }
sub get_uri { $_[0]->{_uri}; }
t/2_options.t view on Meta::CPAN
use TestDetails qw($test_user $test_pass $test_url do_test fail_tests test_callback);
my $TESTS;
$TESTS = 6;
plan tests => $TESTS;
fail_tests($TESTS) unless $test_url =~ /http/;
my $dav = HTTP::DAV->new;
$dav->DebugLevel(3);
$dav->credentials( $test_user, $test_pass, $test_url );
my $resource = $dav->new_resource( -uri => $test_url );
my $response = $resource->options();
if ( ! ok($response->is_success) ) {
print $response->message() ."\n";
}
print "DAV compliancy: ". $resource->is_dav_compliant(). "\n";
ok($resource->is_dav_compliant());
t/3_put_get_delete.t view on Meta::CPAN
my $TESTS;
$TESTS = 6;
plan tests => $TESTS;
fail_tests($TESTS) unless $test_url =~ /http/;
my $dav = HTTP::DAV->new;
HTTP::DAV::DebugLevel(3);
$dav->credentials( $test_user,$test_pass,$test_url );
my $collection = $test_url;
$collection=~ s#/$##g; # Remove trailing slash. We'll put it on.
my $new_file = "$collection/dav_test_file.txt";
print "File: $new_file\n";
my $resource = $dav->new_resource( -uri => $new_file );
my $response;
$response = $resource->put("DAV.pm test content ");
t/5_propfind.t view on Meta::CPAN
# module.
my $TESTS;
$TESTS=9;
plan tests => $TESTS;
fail_tests($TESTS) unless $test_url =~ /http/;
my $dav = HTTP::DAV->new;
HTTP::DAV::DebugLevel(3);
$dav->credentials( $test_user,$test_pass,$test_url );
my $response;
my $resource = $dav->new_resource( -uri => $test_url );
######################################################################
# RUN THE TESTS
ok($resource->set_property('testing','123'));
ok($resource->get_property('testing'),'123');
ok($resource->is_collection(),0);
t/5_proppatch.t view on Meta::CPAN
Test 3. Then lock perldav_test and do a proppatch. No namespace
3a. LOCK perldav_test
3a. PROPPATCH perldav_test (set test_prop=test_val)
3b. PROPPATCH perldav_test (remove DAV:test_prop)
3b. UNLOCK perldav_test
=cut
# Setup
my $dav1 = HTTP::DAV->new();
$dav1->credentials( $user, $pass, $url );
do_test $dav1, $dav1->open ( $url ), 1,"OPEN $url";
# Determine server's willingness to proppatching and locking
# IIS5 currently does not support pp on files or colls.
my $options =$dav1->options();
my $coll_proppatch=( $options=~/\bPROPPATCH\b/)?1:0;
my $coll_lock= ( $options=~/\bLOCK\b/ )?1:0;
my $cps = ($coll_proppatch)?"supports":"does not support";
my $cls = ($coll_lock )?"supports":"does not support";
print "$options\n";
t/6_dav_copy_move.t view on Meta::CPAN
my $sourceuri = "perldav_test" .$$ . "_".time;
my $sourceurl = "$url/$sourceuri";
my $targeturi = ${sourceuri} . "_copy";
my $targeturl = "$url/$targeturi";
print "sourceuri: $sourceuri\n";
print "sourceurl: $sourceurl\n";
print "targeturi: $targeturi\n";
print "targeturl: $targeturl\n";
my $dav1 = HTTP::DAV->new();
$dav1->credentials( $user, $pass, $url );
do_test $dav1, $dav1->open ($url), 1,"OPEN $url";
do_test $dav1, $dav1->mkcol($sourceuri), 1,"MKCOL $sourceuri";
do_test $dav1, $dav1->mkcol("$sourceuri/subdir"), 1,"MKCOL $sourceuri/subdir";
do_test $dav1, $dav1->cwd ($sourceuri), 1,"CWD $sourceuri";
print "COPY\n" . "----\n";
my $resource1 = $dav1->get_workingresource();
my $resource2 = $dav1->new_resource( -uri => $targeturl );
my $resource3 = $dav1->new_resource( -uri =>"$targeturl/subdir" );
t/6_dav_get_callback.t view on Meta::CPAN
my $user = $test_user;
my $pass = $test_pass;
my $url = $test_url;
my $cwd = $test_cwd;
HTTP::DAV::DebugLevel(0);
my $dav;
# Test get_workingurl on empty client
$dav = HTTP::DAV->new( );
$dav->credentials( $user, $pass, $url );
do_test $dav, $dav->open( $url ), 1, "OPEN $url";
# 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";
do_test $dav, $dav->cwd($newdir), 1, "CWD to $newdir";
# Make a big temporary file
print "CREATING temporary 1Mb file\n";
t/6_dav_globs.t view on Meta::CPAN
my $targeturi = "perldav_test" .$$ . "_".time;
my $shorturi = "perldav_test" .$$;
my $targeturl = URI->new_abs($targeturi,$test_url);
my $localdir = "/tmp/$targeturi";
print "targeturi: $targeturi\n";
print "targeturl: $targeturl\n";
my $dav1 = HTTP::DAV->new();
$dav1->credentials( $test_user, $test_pass, $test_url );
# SETUP
# make URL/perldav_12341234/test_data/*
do_test $dav1, $dav1->open ($test_url), 1,"OPEN $test_url";
do_test $dav1, $dav1->mkcol($targeturl), 1,"MKCOL $targeturl";
do_test $dav1, mkdir($localdir), 1, "system mkdir $localdir";
# TEST 1
# Test that working directory =~ /$shorturi/
do_test $dav1, $dav1->cwd("$shorturi*"), 1,"CWD $shorturi*";
t/6_dav_lock.t view on Meta::CPAN
Test 6. Then a delete/unlock sequence (should fail resource was delete)
Client 1: UNLOCK perldav_test (should fail in client as no locks held after the delete).
=cut
# Setup
my $dav1 = HTTP::DAV->new();
my $dav2 = HTTP::DAV->new();
$dav1->credentials( $user, $pass, $url );
$dav2->credentials( $user, $pass, $url );
do_test $dav1, $dav1->open( $url ), 1, "dav1->OPEN $url";
do_test $dav2, $dav2->open( $url ), 1, "dav2->OPEN $url";
do_test $dav1, $dav1->mkcol ($newdir), 1,"dav1->MKCOL $newdir";
do_test $dav1, $dav1->mkcol ("$newdir/subdir"), 1,"dav1->MKCOL $newdir/subdir";
# Test 1
do_test $dav1, $dav1->lock ($newdir), 1,"dav1->LOCK $newdir";
do_test $dav1, $dav1->unlock($newdir), 1,"dav1->UNLOCK $newdir";
# Test 2
t/6_dav_lock2.t view on Meta::CPAN
Client 1: UNLOCK perldav_test with timeout=10m
Test 1. Test 2 shared locks
Client 1: LOCK perldav_test with scope=shared
Client 2: LOCK perldav_test with scope=shared
=cut
# Setup
my $dav1 = HTTP::DAV->new();
my $dav2 = HTTP::DAV->new();
$dav1->credentials( $user, $pass, $url );
$dav2->credentials( $user, $pass, $url );
do_test $dav1, $dav1->open( $url ), 1, "dav1->OPEN $url";
do_test $dav2, $dav2->open( $url ), 1, "dav2->OPEN $url";
do_test $dav1, $dav1->mkcol ($newdir), 1,"dav1->MKCOL $newdir";
do_test $dav1, $dav1->mkcol ("$newdir/subdir"), 1,"dav1->MKCOL $newdir/subdir";
# Test 1
do_test $dav1, $dav1->lock(-url=>$newdir,-timeout=>"10m"), 1,"dav1->LOCK $newdir timeout=10mins";
my $u = $url; $u =~ s/\/$//g;
my $r1 = $dav1->new_resource("$u/$newdir");
my $r2 = $dav2->new_resource("$u/$newdir");
t/6_dav_open_put_get.t view on Meta::CPAN
# 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();
t/6_dav_options.t view on Meta::CPAN
=cut
# Setup
# Make a directory with our process id after it
# so that it is somewhat random
my $perldav_test_uri = "perldav_test" .$$;
my $perldav_test_url = "$url/$perldav_test_uri/";
my $dav = HTTP::DAV->new();
$dav->credentials( $user, $pass, $url );
do_test $dav, $dav->open ($url), 1,"OPEN $url";
do_test $dav, $dav->mkcol($perldav_test_uri), 1,"MKCOL $perldav_test_uri";
print "OPTIONS\n" . "----\n";
do_test $dav, $dav->options( "$url" ), '/PROPFIND/', "OPTIONS $url (looking for PROPFIND)";
do_test $dav, $dav->options( "$perldav_test_uri" ), '/PROPFIND/', "OPTIONS $perldav_test_uri (looking for PROPFIND)";
do_test $dav, $dav->options( "$perldav_test_url" ), '/PROPFIND/', "OPTIONS $perldav_test_url (looking for PROPFIND)";
# Cleanup
do_test $dav, $dav->delete("$perldav_test_url"),1,"DELETE $perldav_test_url";
t/9_RT_42877.t view on Meta::CPAN
$HTTP::DAV::DEBUG =
$HTTP::DAV::DEBUG = 3;
my $netloc = 'mylocation';
my $realm = 'myrealm';
my $user = 'randomuser';
my $pass = '12345';
my $ua = HTTP::DAV::UserAgent->new();
my $existing_credentials = $ua->credentials($netloc, $realm);
is ($existing_credentials, undef, 'No credentials defined at start');
$ua->credentials($netloc, $realm, $user, $pass);
$existing_credentials = $ua->credentials($netloc, $realm);
is ($existing_credentials, "$user:$pass", 'credentials() called in scalar context');
my @cred = $ua->credentials($netloc, $realm);
is(scalar @cred, 2, 'credentials() called in list context');
is($cred[0], $user, 'credentials() called in list context');
is($cred[1], $pass, 'credentials() called in list context');
t/9_RT_47500.t view on Meta::CPAN
#$HTTP::DAV::DEBUG = 0;
# Normalize netloc with port (:80)
# or we might miss the hash key
my $netloc = 'mylocation:80';
my $realm = 'myrealm';
my $user = 'randomuser';
my $pass = '12345';
my $ua = HTTP::DAV::UserAgent->new();
my $existing_credentials = $ua->credentials($netloc, $realm);
ok (
! exists $ua->{basic_authentication}->{$netloc}->{$realm},
"Shouldn't autovivify the $netloc/$realm hash key when accessing it"
);
$ua->credentials($netloc, $realm, $user, $pass);
is_deeply (
$ua->{basic_authentication}->{$netloc}->{$realm},
[ $user, $pass ],
'Credentials are correctly set',
);
my @cred = $ua->credentials($netloc, $realm);
is(scalar @cred, 2, 'credentials() has 2 elements');
is($cred[0], $user, 'credentials() stored correctly');
is($cred[1], $pass, 'credentials() stored correctly');
t/9_RT_60457.t view on Meta::CPAN
# if ($test_url !~ m{http}) {
# skip("no test server", 4);
# }
use_ok('HTTP::DAV');
use_ok('HTTP::DAV::Comms');
my $dav = HTTP::DAV->new();
HTTP::DAV::DebugLevel(3);
$dav->credentials($test_user,$test_pass,$test_url);
my $collection = $test_url;
$collection =~ s{/$}{}g;
my $new_file = "$collection/dav_test_file.txt";
diag("File: $new_file");
my $resource = $dav->new_resource( -uri => $new_file );
my $response = $resource->put("DAV.pm test content ", {"X-DAV-Test" => "12345"});
if (! ok($response->is_success)) {
t/TestDetails.pm view on Meta::CPAN
use Test;
use Exporter;
use Cwd;
use vars qw(@EXPORT @EXPORT_OK $VERSION @ISA);
@ISA=qw(Exporter);
@EXPORT=qw(do_test fail_tests test_callback $test_user $test_pass $test_url $test_cwd);
# This package is designed to simplify testing.
# It allows you to enter multiple URL's (and
# credentials) for the different tests.
# You need to manually edit the %details hash below.
# A test script may tell us that it is about to do a propfind.
# It would do this by calling TestDetails::method('PROPFIND');
# Then when the test script calls TestDetails::url() you will
# get the URL specificed in the PROPFIND hash below.
# But, if you haven't specified any details in the hash below
# specific for PROPFIND it will use the DEFAULT entries instead.
( run in 1.247 second using v1.01-cache-2.11-cpan-4d50c553e7e )