"Fossies" - the Fresh Open Source Software Archive

Member "HTTP-DAV-0.49/lib/HTTP/DAV.pm" (28 Nov 2018, 66604 Bytes) of package /linux/www/HTTP-DAV-0.49.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "DAV.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 0.48_vs_0.49.

    1 # Perl WebDAV client library
    2 
    3 package HTTP::DAV;
    4 
    5 use strict;
    6 use vars qw($VERSION $VERSION_DATE $DEBUG);
    7 
    8 # Globals
    9 $VERSION = '0.49';
   10 $VERSION_DATE = '2018/11/28';
   11 
   12 # Set this up to 3
   13 $DEBUG = 0;
   14 
   15 #use Carp (cluck);
   16 use Cwd ();  # Can't import all of it, cwd clashes with our namespace.
   17 use LWP;
   18 use XML::DOM;
   19 use Time::Local;
   20 use HTTP::DAV::Lock;
   21 use HTTP::DAV::ResourceList;
   22 use HTTP::DAV::Resource;
   23 use HTTP::DAV::Comms;
   24 use URI::file;
   25 use URI::Escape;
   26 use FileHandle;
   27 use File::Glob;
   28 use File::Temp ();
   29 
   30 sub new {
   31     my $class = shift;
   32     my $self = bless {}, ref($class) || $class;
   33     $self->_init(@_);
   34     return $self;
   35 }
   36 
   37 ###########################################################################
   38 sub clone {
   39     my ($self)= @_;
   40     my $class = ref($self);
   41     my %clone = %{$self};
   42     bless {%clone}, $class;
   43 }
   44 
   45 ###########################################################################
   46 {
   47 
   48     sub _init {
   49         my ( $self, @p ) = @_;
   50         my ( $uri, $headers, $useragent )
   51             = HTTP::DAV::Utils::rearrange( [ 'URI', 'HEADERS', 'USERAGENT' ],
   52             @p );
   53 
   54         $self->{_lockedresourcelist} = HTTP::DAV::ResourceList->new();
   55         $self->{_comms} = HTTP::DAV::Comms->new(
   56             -useragent => $useragent,
   57             -headers => $headers
   58         );
   59         if ($uri) {
   60             $self->set_workingresource( $self->new_resource( -uri => $uri ) );
   61         }
   62 
   63         return $self;
   64     }
   65 }
   66 
   67 sub DebugLevel {
   68     shift if ref( $_[0] ) =~ /HTTP/;
   69     my $level = shift;
   70     $level = 256 if !defined $level || $level eq "";
   71 
   72     $DEBUG = $level;
   73 }
   74 
   75 sub _tempfile {
   76     my ($prefix, $tempdir) = @_;
   77 
   78     $prefix ||= 'dav';
   79     $tempdir ||= '/tmp';
   80 
   81     my $template = $prefix . 'XXXXXXXXXXXXX';
   82 
   83     my $old_umask = umask 0077;
   84     my ($fh, $filename) = File::Temp::tempfile($template,
   85         DIR => $tempdir,
   86         SUFFIX => '.tmp'
   87     );
   88     umask $old_umask;
   89 
   90     return wantarray
   91         ? ($fh, $filename)
   92         : $filename;
   93 }
   94 
   95 ######################################################################
   96 # new_resource acts as a resource factory.
   97 # It will create a new one for you each time you ask.
   98 # Sometimes, if it holds state information about this
   99 # URL, it may return an old populated object.
  100 sub new_resource {
  101     my ($self) = shift;
  102 
  103     ####
  104     # This is the order of the arguments unless used as
  105     # named parameters
  106     my ($uri) = HTTP::DAV::Utils::rearrange( ['URI'], @_ );
  107     $uri = HTTP::DAV::Utils::make_uri($uri);
  108 
  109     #cluck "new_resource: now $uri\n";
  110 
  111     my $resource = $self->{_lockedresourcelist}->get_member($uri);
  112     if ($resource) {
  113         print
  114             "new_resource: For $uri, returning existing resource $resource\n"
  115             if $HTTP::DAV::DEBUG > 2;
  116 
  117         # Just reset the url to honour trailing slash status.
  118         $resource->set_uri($uri);
  119         return $resource;
  120     }
  121     else {
  122         print "new_resource: For $uri, creating new resource\n"
  123             if $HTTP::DAV::DEBUG > 2;
  124         return HTTP::DAV::Resource->new(
  125             -Comms              => $self->{_comms},
  126             -LockedResourceList => $self->{_lockedresourcelist},
  127             -uri                => $uri,
  128             -Client             => $self
  129         );
  130     }
  131 }
  132 
  133 ###########################################################################
  134 # ACCESSOR METHODS
  135 
  136 # GET
  137 sub get_user_agent      { $_[0]->{_comms}->get_user_agent(); }
  138 sub get_last_request    { $_[0]->{_comms}->get_last_request(); }
  139 sub get_last_response   { $_[0]->{_comms}->get_last_response(); }
  140 sub get_workingresource { $_[0]->{_workingresource} }
  141 
  142 sub get_workingurl {
  143     $_[0]->{_workingresource}->get_uri()
  144         if defined $_[0]->{_workingresource};
  145 }
  146 sub get_lockedresourcelist { $_[0]->{_lockedresourcelist} }
  147 
  148 # SET
  149 sub set_workingresource { $_[0]->{_workingresource} = $_[1]; }
  150 sub credentials { shift->{_comms}->credentials(@_); }
  151 
  152 ######################################################################
  153 # Error handling
  154 
  155 ## Error conditions
  156 my %err = (
  157     'ERR_WRONG_ARGS'    => 'Wrong number of arguments supplied.',
  158     'ERR_UNAUTHORIZED'  => 'Unauthorized. ',
  159     'ERR_NULL_RESOURCE' => 'Not connected. Do an open first. ',
  160     'ERR_RESP_FAIL'     => 'Server response: ',
  161     'ERR_501'           => 'Server response: ',
  162     'ERR_405'           => 'Server response: ',
  163     'ERR_GENERIC'       => '',
  164 );
  165 
  166 sub err {
  167     my ( $self, $error, $mesg, $url ) = @_;
  168 
  169     my $err_msg;
  170     $err_msg = "";
  171     $err_msg .= $err{$error} if defined $err{$error};
  172     $err_msg .= $mesg if defined $mesg;
  173     $err_msg .= "ERROR" unless defined $err_msg;
  174 
  175     $self->{_message} = $err_msg;
  176     my $callback = $self->{_callback};
  177     &$callback( 0, $err_msg, $url ) if $callback;
  178 
  179     if ( $self->{_multi_op} ) {
  180         push( @{ $self->{_errors} }, $err_msg );
  181     }
  182     $self->{_status} = 0;
  183 
  184     return 0;
  185 }
  186 
  187 sub ok {
  188     my ($self, $mesg, $url, $so_far, $length) = @_;
  189 
  190     $self->{_message} = $mesg;
  191 
  192     my $callback = $self->{_callback};
  193     &$callback(1, $mesg, $url, $so_far, $length) if $callback;
  194 
  195     if ($self->{_multi_op}) {
  196         $self->{_status} = 1 unless $self->{_status} == 0;
  197     }
  198     else {
  199         $self->{_status} = 1;
  200     }
  201     return 1;
  202 }
  203 
  204 sub _start_multi_op {
  205     my ($self, $mesg, $callback) = @_;
  206     $self->{_multi_mesg} = $mesg || "";
  207     $self->{_status} = 1;
  208     $self->{_errors} = [];
  209     $self->{_multi_op} = 1;
  210     $self->{_callback} = $callback if defined $callback;
  211 }
  212 
  213 sub _end_multi_op {
  214     my ($self) = @_;
  215     $self->{_multi_op} = 0;
  216     $self->{_callback} = undef;
  217     my $message = $self->{_multi_mesg} . " ";
  218     $message .= ( $self->{_status} ) ? "succeeded" : "failed";
  219     $self->{_message}    = $message;
  220     $self->{_multi_mesg} = undef;
  221 }
  222 
  223 sub message {
  224     my ($self) = @_;
  225     return $self->{_message} || "";
  226 }
  227 
  228 sub errors {
  229     my ($self) = @_;
  230     my $err_ref = $self->{_errors} || [];
  231     return @{ $err_ref };
  232 }
  233 
  234 sub is_success {
  235     my ($self) = @_;
  236     return $self->{_status};
  237 }
  238 
  239 ######################################################################
  240 # Operations
  241 
  242 # CWD
  243 sub cwd {
  244     my ( $self, @p ) = @_;
  245     my ($url) = HTTP::DAV::Utils::rearrange( ['URL'], @p );
  246 
  247     return $self->err('ERR_WRONG_ARGS') if ( !defined $url || $url eq "" );
  248     return $self->err('ERR_NULL_RESOURCE')
  249         unless $self->get_workingresource();
  250 
  251     $url = HTTP::DAV::Utils::make_trail_slash($url);
  252     my $new_uri = $self->get_absolute_uri($url);
  253     ($new_uri) = $self->get_globs($new_uri);
  254 
  255     return 0 unless ($new_uri);
  256 
  257     print "cwd: Changing to $new_uri\n" if $DEBUG;
  258     return $self->open($new_uri);
  259 }
  260 
  261 # DELETE
  262 sub delete {
  263     my ( $self, @p ) = @_;
  264     my ( $url, $callback )
  265         = HTTP::DAV::Utils::rearrange( [ 'URL', 'CALLBACK' ], @p );
  266 
  267     return $self->err('ERR_WRONG_ARGS') if ( !defined $url || $url eq "" );
  268     return $self->err('ERR_NULL_RESOURCE')
  269         unless $self->get_workingresource();
  270 
  271     my $new_url = $self->get_absolute_uri($url);
  272     my @urls    = $self->get_globs($new_url);
  273 
  274     $self->_start_multi_op( "delete $url", $callback ) if @urls > 1;
  275 
  276     foreach my $u (@urls) {
  277         my $resource = $self->new_resource( -uri => $u );
  278 
  279         my $resp = $resource->delete();
  280 
  281         if ( $resp->is_success ) {
  282             $self->ok( "deleted $u successfully", $u );
  283         }
  284         else {
  285             $self->err( 'ERR_RESP_FAIL', $resp->message(), $u );
  286         }
  287     }
  288 
  289     $self->_end_multi_op() if @urls > 1;
  290 
  291     return $self->is_success;
  292 }
  293 
  294 # GET
  295 # Handles globs by doing multiple recursive gets
  296 # GET dir* produces
  297 #   _get dir1, to_local
  298 #   _get dir2, to_local
  299 #   _get dir3, to_local
  300 sub get {
  301     my ( $self, @p ) = @_;
  302     my ( $url, $to, $callback, $chunk )
  303         = HTTP::DAV::Utils::rearrange( [ 'URL', 'TO', 'CALLBACK', 'CHUNK' ],
  304         @p );
  305 
  306     return $self->err('ERR_WRONG_ARGS') if ( !defined $url || $url eq "" );
  307     return $self->err('ERR_NULL_RESOURCE')
  308         unless $self->get_workingresource();
  309 
  310     $self->_start_multi_op( "get $url", $callback );
  311 
  312     my $new_url = $self->get_absolute_uri($url);
  313     my (@urls) = $self->get_globs($new_url);
  314 
  315     return 0 unless ( $#urls > -1 );
  316 
  317     ############
  318     # HANDLE -TO
  319     #
  320     $to ||= '';
  321     if ( $to eq '.' ) {
  322         $to = Cwd::getcwd();
  323     }
  324 
  325     # If the TO argument is a file handle or a scalar
  326     # then check that we only got one glob. If we got multiple
  327     # globs, then we can't keep going because we can't write multiple files
  328     # to one FileHandle.
  329     if ( $#urls > 0 ) {
  330         if ( ref($to) =~ /SCALAR/ ) {
  331             return $self->err( 'ERR_WRONG_ARGS',
  332                 "Can't retrieve multiple files to a single scalar\n" );
  333         }
  334         elsif ( ref($to) =~ /GLOB/ ) {
  335             return $self->err( 'ERR_WRONG_ARGS',
  336                 "Can't retrieve multiple files to a single filehandle\n" );
  337         }
  338     }
  339 
  340     # If it's a dir, remove last '/' from destination.
  341     # Later we need to concatenate the destination filename.
  342     if ( defined $to && $to ne '' && -d $to ) {
  343         $to =~ s{/$}{};
  344     }
  345 
  346     # Foreach file... do the get.
  347     foreach my $u (@urls) {
  348         my ( $left, $leafname ) = HTTP::DAV::Utils::split_leaf($u);
  349 
  350         # Handle SCALARREF and GLOB cases
  351         my $dest_file = $to;
  352 
  353         # Directories
  354         if ( -d $to ) {
  355             $dest_file = "$to/$leafname";
  356 
  357             # Multiple targets
  358         }
  359         elsif ( !defined $to || $to eq "" ) {
  360             $dest_file = $leafname;
  361         }
  362 
  363         warn "get: $u -> $dest_file\n" if $DEBUG;
  364 
  365         # Setup the resource based on the passed url and do a propfind.
  366         my $resource = $self->new_resource( -uri => $u );
  367         my $resp = $resource->propfind( -depth => 1 );
  368 
  369         if ( $resp->is_error ) {
  370             return $self->err( 'ERR_RESP_FAIL', $resp->message(), $u );
  371         }
  372 
  373         $self->_get( $resource, $dest_file, $callback, $chunk );
  374     }
  375 
  376     $self->_end_multi_op();
  377     return $self->is_success;
  378 }
  379 
  380 # Note: is is expected that $resource has had
  381 # a propfind depth 1 performed on it.
  382 #
  383 sub _get {
  384     my ( $self, @p ) = @_;
  385     my ( $resource, $local_name, $callback, $chunk )
  386         = HTTP::DAV::Utils::rearrange(
  387         [ 'RESOURCE', 'TO', 'CALLBACK', 'CHUNK' ], @p );
  388 
  389     my $url = $resource->get_uri();
  390 
  391     # GET A DIRECTORY
  392     if ( $resource->is_collection ) {
  393 
  394         # If the TO argument is a file handle, a scalar or empty
  395         # then we
  396         # can't keep going because we can't write multiple files
  397         # to one FileHandle, scalar, etc.
  398         if ( ref($local_name) =~ /SCALAR/ ) {
  399             return $self->err( 'ERR_WRONG_ARGS',
  400                 "Can't retrieve a collection to a scalar\n", $url );
  401         }
  402         elsif ( ref($local_name) =~ /GLOB/ ) {
  403             return $self->err( 'ERR_WRONG_ARGS',
  404                 "Can't retrieve a collection to a filehandle\n", $url );
  405         }
  406         elsif ( $local_name eq "" ) {
  407             return $self->err(
  408                 'ERR_GENERIC',
  409                 "Can't retrieve a collection without a target directory (-to).",
  410                 $url
  411             );
  412         }
  413 
  414         # Try and make the directory locally
  415         print "MKDIR $local_name (before escape)\n" if $DEBUG > 2;
  416 
  417         $local_name = URI::Escape::uri_unescape($local_name);
  418         if ( !mkdir $local_name ) {
  419             return $self->err( 'ERR_GENERIC',
  420                 "mkdir local:$local_name failed: $!" );
  421         }
  422 
  423         $self->ok("mkdir $local_name");
  424 
  425         # This is the degenerate case for an empty dir.
  426         print "Made directory $local_name\n" if $DEBUG > 2;
  427 
  428         my $resource_list = $resource->get_resourcelist();
  429         if ($resource_list) {
  430 
  431             # FOREACH FILE IN COLLECTION, GET IT.
  432             foreach my $progeny_r ( $resource_list->get_resources() ) {
  433 
  434                 my $progeny_url = $progeny_r->get_uri();
  435                 print "Found progeny:$progeny_url\n" if $DEBUG > 2;
  436                 my $progeny_local_filename
  437                     = HTTP::DAV::Utils::get_leafname($progeny_url);
  438                 $progeny_local_filename
  439                     = URI::Escape::uri_unescape($progeny_local_filename);
  440 
  441                 $progeny_local_filename
  442                     = URI::file->new($progeny_local_filename)
  443                     ->abs("$local_name/");
  444 
  445                 if ( $progeny_r->is_collection() ) {
  446                     $progeny_r->propfind( -depth => 1 );
  447                 }
  448                 $self->_get( $progeny_r, $progeny_local_filename, $callback,
  449                     $chunk );
  450 
  451                # } else {
  452                #    $self->_do_get_tofile($progeny_r,$progeny_local_filename);
  453                # }
  454             }
  455         }
  456     }
  457 
  458     # GET A FILE
  459     else {
  460         my $response;
  461         my $name_ref = ref $local_name;
  462 
  463         if ( $callback || $name_ref =~ /SCALAR/ || $name_ref =~ /GLOB/ ) {
  464             $self->{_so_far} = 0;
  465 
  466             my $fh;
  467             my $put_to_scalar = 0;
  468 
  469             if ( $name_ref =~ /GLOB/ ) {
  470                 $fh = $local_name;
  471             }
  472 
  473             elsif ( $name_ref =~ /SCALAR/ ) {
  474                 $put_to_scalar = 1;
  475                 $$local_name   = "";
  476             }
  477 
  478             else {
  479                 $fh         = FileHandle->new;
  480                 $local_name = URI::Escape::uri_unescape($local_name);
  481                 if (! $fh->open(">$local_name") ) {
  482                     return $self->err(
  483                         'ERR_GENERIC',
  484                         "open \">$local_name\" failed: $!",
  485                         $url
  486                     );
  487                 }
  488 
  489                 # RT #29788, avoid file corruptions on Win32
  490                 binmode $fh;
  491             }
  492 
  493             $self->{_fh} = $fh;
  494 
  495             $response = $resource->get(
  496                 -chunk => $chunk,
  497                 -progress_callback =>
  498 
  499                     sub {
  500                     my ( $data, $response, $protocol ) = @_;
  501 
  502                     $self->{_so_far} += length($data);
  503 
  504                     my $fh = $self->{_fh};
  505                     print $fh $data if defined $fh;
  506 
  507                     $$local_name .= $data if ($put_to_scalar);
  508 
  509                     my $user_callback = $self->{_callback};
  510                     &$user_callback( -1, "transfer in progress",
  511                         $url, $self->{_so_far}, $response->content_length(),
  512                         $data )
  513                         if defined $user_callback;
  514 
  515                     }
  516 
  517             );    # end get( ... );
  518 
  519             # Close the filehandle if it was set.
  520             if ( defined $self->{_fh} ) {
  521                 $self->{_fh}->close();
  522                 delete $self->{_fh};
  523             }
  524         }
  525         else {
  526             $local_name = URI::Escape::uri_unescape($local_name);
  527             $response = $resource->get( -save_to => $local_name );
  528         }
  529 
  530         # Handle response
  531         if ( $response->is_error ) {
  532             return $self->err( 'ERR_GENERIC',
  533                 "get $url failed: " . $response->message, $url );
  534         }
  535         else {
  536             return $self->ok( "get $url", $url, $self->{_so_far},
  537                 $response->content_length() );
  538         }
  539 
  540     }
  541 
  542     return 1;
  543 }
  544 
  545 # LOCK
  546 sub lock {
  547     my ( $self, @p ) = @_;
  548     my ( $url, $owner, $depth, $timeout, $scope, $type, @other )
  549         = HTTP::DAV::Utils::rearrange(
  550         [ 'URL', 'OWNER', 'DEPTH', 'TIMEOUT', 'SCOPE', 'TYPE' ], @p );
  551 
  552     return $self->err('ERR_NULL_RESOURCE')
  553         unless $self->get_workingresource();
  554 
  555     my $resource;
  556     if ($url) {
  557         $url = $self->get_absolute_uri($url);
  558         $resource = $self->new_resource( -uri => $url );
  559     }
  560     else {
  561         $resource = $self->get_workingresource();
  562         $url      = $resource->get_uri;
  563     }
  564 
  565     # Make the lock
  566     my $resp = $resource->lock(
  567         -owner   => $owner,
  568         -depth   => $depth,
  569         -timeout => $timeout,
  570         -scope   => $scope,
  571         -type    => $type
  572     );
  573 
  574     if ( $resp->is_success() ) {
  575         return $self->ok( "lock $url succeeded", $url );
  576     }
  577     else {
  578         return $self->err( 'ERR_RESP_FAIL', $resp->message, $url );
  579     }
  580 }
  581 
  582 # UNLOCK
  583 sub unlock {
  584     my ( $self, @p ) = @_;
  585     my ($url) = HTTP::DAV::Utils::rearrange( ['URL'], @p );
  586 
  587     return $self->err('ERR_NULL_RESOURCE')
  588         unless $self->get_workingresource();
  589 
  590     my $resource;
  591     if ($url) {
  592         $url = $self->get_absolute_uri($url);
  593         $resource = $self->new_resource( -uri => $url );
  594     }
  595     else {
  596         $resource = $self->get_workingresource();
  597         $url      = $resource->get_uri;
  598     }
  599 
  600     # Make the lock
  601     my $resp = $resource->unlock();
  602     if ( $resp->is_success ) {
  603         return $self->ok( "unlock $url succeeded", $url );
  604     }
  605     else {
  606 
  607         # The Resource.pm::lock routine has a hack
  608         # where if it doesn't know the locktoken, it will
  609         # just return an empty response with message "Client Error".
  610         # Make a custom message for this case.
  611         my $msg = $resp->message;
  612         if ( $msg =~ /Client error/i ) {
  613             $msg = "No locks found. Try steal";
  614             return $self->err( 'ERR_GENERIC', $msg, $url );
  615         }
  616         else {
  617             return $self->err( 'ERR_RESP_FAIL', $msg, $url );
  618         }
  619     }
  620 }
  621 
  622 sub steal {
  623     my ( $self, @p ) = @_;
  624     my ($url) = HTTP::DAV::Utils::rearrange( ['URL'], @p );
  625 
  626     return $self->err('ERR_NULL_RESOURCE')
  627         unless $self->get_workingresource();
  628 
  629     my $resource;
  630     if ($url) {
  631         $url = $self->get_absolute_uri($url);
  632         $resource = $self->new_resource( -uri => $url );
  633     }
  634     else {
  635         $resource = $self->get_workingresource();
  636     }
  637 
  638     # Go the steal
  639     my $resp = $resource->forcefully_unlock_all();
  640     if ( $resp->is_success() ) {
  641         return $self->ok( "steal succeeded", $url );
  642     }
  643     else {
  644         return $self->err( 'ERR_RESP_FAIL', $resp->message(), $url );
  645     }
  646 }
  647 
  648 # MKCOL
  649 sub mkcol {
  650     my ( $self, @p ) = @_;
  651     my ($url) = HTTP::DAV::Utils::rearrange( ['URL'], @p );
  652 
  653     return $self->err('ERR_WRONG_ARGS') if ( !defined $url || $url eq "" );
  654     return $self->err('ERR_NULL_RESOURCE')
  655         unless $self->get_workingresource();
  656 
  657     $url = HTTP::DAV::Utils::make_trail_slash($url);
  658     my $new_url = $self->get_absolute_uri($url);
  659     my $resource = $self->new_resource( -uri => $new_url );
  660 
  661     # Make the lock
  662     my $resp = $resource->mkcol();
  663     if ( $resp->is_success() ) {
  664         return $self->ok( "mkcol $new_url", $new_url );
  665     }
  666     else {
  667         return $self->err( 'ERR_RESP_FAIL', $resp->message(), $new_url );
  668     }
  669 }
  670 
  671 # OPTIONS
  672 sub options {
  673     my ( $self, @p ) = @_;
  674     my ($url) = HTTP::DAV::Utils::rearrange( ['URL'], @p );
  675 
  676     #return $self->err('ERR_WRONG_ARGS') if (!defined $url || $url eq "");
  677     return $self->err('ERR_NULL_RESOURCE')
  678         unless $self->get_workingresource();
  679 
  680     my $resource;
  681     if ($url) {
  682         $url = $self->get_absolute_uri($url);
  683         $resource = $self->new_resource( -uri => $url );
  684     }
  685     else {
  686         $resource = $self->get_workingresource();
  687         $url      = $resource->get_uri;
  688     }
  689 
  690     # Make the call
  691     my $resp = $resource->options();
  692     if ( $resp->is_success() ) {
  693         $self->ok( "options $url succeeded", $url );
  694         return $resource->get_options();
  695     }
  696     else {
  697         $self->err( 'ERR_RESP_FAIL', $resp->message(), $url );
  698         return undef;
  699     }
  700 }
  701 
  702 # MOVE
  703 sub move { return shift->_move_copy( "move", @_ ); }
  704 sub copy { return shift->_move_copy( "copy", @_ ); }
  705 
  706 sub _move_copy {
  707     my ( $self, $method, @p ) = @_;
  708     my ( $url, $dest_url, $overwrite, $depth, $text, @other )
  709         = HTTP::DAV::Utils::rearrange(
  710         [ 'URL', 'DEST', 'OVERWRITE', 'DEPTH', 'TEXT' ], @p );
  711 
  712     return $self->err('ERR_NULL_RESOURCE')
  713         unless $self->get_workingresource();
  714 
  715     if (!(  defined $url && $url ne "" && defined $dest_url && $dest_url ne ""
  716         )
  717         )
  718     {
  719         return $self->err( 'ERR_WRONG_ARGS',
  720             "Must supply a source and destination url" );
  721     }
  722 
  723     $url      = $self->get_absolute_uri($url);
  724     $dest_url = $self->get_absolute_uri($dest_url);
  725     my $resource      = $self->new_resource( -uri => $url );
  726     my $dest_resource = $self->new_resource( -uri => $dest_url );
  727 
  728     my $resp = $dest_resource->propfind( -depth => 1 );
  729     if ( $resp->is_success && $dest_resource->is_collection ) {
  730         my $leafname = HTTP::DAV::Utils::get_leafname($url);
  731         $dest_url = "$dest_url/$leafname";
  732         $dest_resource = $self->new_resource( -uri => $dest_url );
  733     }
  734 
  735     # Make the lock
  736     $resp = $resource->$method(
  737         -dest      => $dest_resource,
  738         -overwrite => $overwrite,
  739         -depth     => $depth,
  740         -text      => $text,
  741     );
  742 
  743     if ( $resp->is_success() ) {
  744         return $self->ok( "$method $url to $dest_url succeeded", $url );
  745     }
  746     else {
  747         return $self->err( 'ERR_RESP_FAIL', $resp->message, $url );
  748     }
  749 }
  750 
  751 # OPEN
  752 # Must be a collection resource
  753 # $dav->open( -url => http://localhost/test/ );
  754 # $dav->open( localhost/test/ );
  755 # $dav->open( -url => localhost:81 );
  756 # $dav->open( localhost );
  757 sub open {
  758     my ( $self, @p ) = @_;
  759     my ($url) = HTTP::DAV::Utils::rearrange( ['URL'], @p );
  760 
  761     my $resource;
  762     if ( defined $url && $url ne "" ) {
  763         $url = HTTP::DAV::Utils::make_trail_slash($url);
  764         $resource = $self->new_resource( -uri => $url );
  765     }
  766     else {
  767         $resource = $self->get_workingresource();
  768         $url = $resource->get_uri() if ($resource);
  769         return $self->err('ERR_WRONG_ARGS')
  770             if ( !defined $url || $url eq "" );
  771     }
  772 
  773     my $response = $resource->propfind( -depth => 0 );
  774 
  775     #print $response->as_string;
  776     #print $resource->as_string;
  777 
  778     my $result = $self->what_happened($url, $resource, $response);
  779     if ($result->{success} == 0) {
  780         return $self->err($result->{error_type}, $result->{error_msg}, $url);
  781     }
  782 
  783     # If it is a collection but the URI doesn't end in a trailing slash.
  784     # Then we need to reopen with the /
  785     elsif ($resource->is_collection
  786         && $url !~ m#/\s*$# )
  787     {
  788         my $newurl = $url . "/";
  789         print "Redirecting to $newurl\n" if $DEBUG > 1;
  790         return $self->open($newurl);
  791     }
  792 
  793     # If it is not a collection then we
  794     # can't open it.
  795     elsif ( !$resource->is_collection ) {
  796         return $self->err( 'ERR_GENERIC',
  797             "Operation failed. You can only open a collection (directory)",
  798             $url );
  799     }
  800     else {
  801         $self->set_workingresource($resource);
  802         return $self->ok( "Connected to $url", $url );
  803     }
  804 
  805     return $self->err( 'ERR_GENERIC', $url );
  806 }
  807 
  808 # Performs a propfind and then returns the populated
  809 # resource. The resource will have a resourcelist if
  810 # it is a collection.
  811 sub propfind {
  812     my ( $self, @p ) = @_;
  813     my ( $url, $depth ) = HTTP::DAV::Utils::rearrange( [ 'URL', 'DEPTH' ], @p );
  814 
  815     # depth = 1 is the default
  816     if (! defined $depth) {
  817         $depth = 1;
  818     }
  819 
  820     return $self->err('ERR_NULL_RESOURCE')
  821         unless $self->get_workingresource();
  822 
  823     my $resource;
  824     if ($url) {
  825         $url = $self->get_absolute_uri($url);
  826         $resource = $self->new_resource( -uri => $url );
  827     }
  828     else {
  829         $resource = $self->get_workingresource();
  830     }
  831 
  832     # Make the call
  833     my $resp = $resource->propfind( -depth => $depth );
  834     if ($resp->is_success() || $resp->code == 207) {
  835         $resource->build_ls($resource);
  836         $self->ok( "propfind " . $resource->get_uri() . " succeeded", $url );
  837         return $resource;
  838     }
  839     else {
  840         return $self->err( 'ERR_RESP_FAIL', $resp->message(), $url );
  841     }
  842 }
  843 
  844 # Set a property on the resource
  845 sub set_prop {
  846     my ( $self, @p ) = @_;
  847     my ( $url, $namespace, $propname, $propvalue, $nsabbr )
  848         = HTTP::DAV::Utils::rearrange(
  849         [ 'URL', 'NAMESPACE', 'PROPNAME', 'PROPVALUE', 'NSABBR' ], @p );
  850     $self->proppatch(
  851         -url       => $url,
  852         -namespace => $namespace,
  853         -propname  => $propname,
  854         -propvalue => $propvalue,
  855         -action    => "set",
  856         -nsabbr    => $nsabbr,
  857     );
  858 }
  859 
  860 # Unsets a property on the resource
  861 sub unset_prop {
  862     my ( $self, @p ) = @_;
  863     my ( $url, $namespace, $propname, $nsabbr )
  864         = HTTP::DAV::Utils::rearrange(
  865         [ 'URL', 'NAMESPACE', 'PROPNAME', 'NSABBR' ], @p );
  866     $self->proppatch(
  867         -url       => $url,
  868         -namespace => $namespace,
  869         -propname  => $propname,
  870         -action    => "remove",
  871         -nsabbr    => $nsabbr,
  872     );
  873 }
  874 
  875 # Performs a proppatch on the resource
  876 sub proppatch {
  877     my ( $self, @p ) = @_;
  878     my ( $url, $namespace, $propname, $propvalue, $action, $nsabbr )
  879         = HTTP::DAV::Utils::rearrange(
  880         [ 'URL', 'NAMESPACE', 'PROPNAME', 'PROPVALUE', 'ACTION', 'NSABBR' ],
  881         @p );
  882 
  883     return $self->err('ERR_NULL_RESOURCE')
  884         unless $self->get_workingresource();
  885 
  886     my $resource;
  887     if ($url) {
  888         $url = $self->get_absolute_uri($url);
  889         $resource = $self->new_resource( -uri => $url );
  890     }
  891     else {
  892         $resource = $self->get_workingresource();
  893     }
  894 
  895     # Make the call
  896     my $resp = $resource->proppatch(
  897         -namespace => $namespace,
  898         -propname  => $propname,
  899         -propvalue => $propvalue,
  900         -action    => $action,
  901         -nsabbr    => $nsabbr
  902     );
  903 
  904     if ( $resp->is_success() ) {
  905         $resource->build_ls($resource);
  906         $self->ok( "proppatch " . $resource->get_uri() . " succeeded", $url );
  907         return $resource;
  908     }
  909     else {
  910         return $self->err( 'ERR_RESP_FAIL', $resp->message(), $url );
  911     }
  912 }
  913 
  914 ######################################################################
  915 sub put {
  916     my ( $self, @p ) = @_;
  917     my ( $local, $url, $callback, $custom_headers )
  918         = HTTP::DAV::Utils::rearrange( [ 'LOCAL', 'URL', 'CALLBACK', 'HEADERS' ], @p );
  919 
  920     if ( ref($local) eq "SCALAR" ) {
  921         $self->_start_multi_op( 'put ' . ${$local}, $callback );
  922         $self->_put(@p);
  923     }
  924     else {
  925         $self->_start_multi_op( 'put ' . $local, $callback );
  926         $local =~ s/\ /\\ /g;
  927         my @globs = glob("$local");
  928 
  929         #my @globs=glob("\"$local\"");
  930         foreach my $file (@globs) {
  931             print "Starting put of $file\n" if $HTTP::DAV::DEBUG > 1;
  932             $self->_put(
  933                 -local    => $file,
  934                 -url      => $url,
  935                 -callback => $callback,
  936                 -headers  => $custom_headers,
  937             );
  938         }
  939     }
  940     $self->_end_multi_op();
  941     return $self->is_success;
  942 }
  943 
  944 sub _put {
  945     my ( $self, @p ) = @_;
  946     my ( $local, $url, $custom_headers )
  947         = HTTP::DAV::Utils::rearrange( [ 'LOCAL', 'URL', 'HEADERS' ], @p );
  948 
  949     return $self->err('ERR_WRONG_ARGS')
  950         if ( !defined $local || $local eq "" );
  951     return $self->err('ERR_NULL_RESOURCE')
  952         unless $self->get_workingresource();
  953 
  954     # Check if they passed a reference to content rather than a filename.
  955     my $content_ptr = ( ref($local) eq "SCALAR" ) ? 1 : 0;
  956 
  957     # Setup the resource based on the passed url
  958     # Check if the remote resource exists and is a collection.
  959     $url = $self->get_absolute_uri($url);
  960     my $resource = $self->new_resource($url);
  961     my $response = $resource->propfind( -depth => 0 );
  962     my $leaf_name;
  963     if ( $response->is_success && $resource->is_collection && !$content_ptr )
  964     {
  965 
  966         # Add one / to the end of the collection
  967         $url =~ s/\/*$//g;    #Strip em
  968         $url .= "/";          #Add one
  969         $leaf_name = HTTP::DAV::Utils::get_leafname($local);
  970     }
  971     else {
  972         $leaf_name = HTTP::DAV::Utils::get_leafname($url);
  973     }
  974 
  975     my $target = $self->get_absolute_uri( $leaf_name, $url );
  976 
  977     #print "$local => $target ($url, $leaf_name)\n";
  978 
  979     # PUT A DIRECTORY
  980     if ( !$content_ptr && -d $local ) {
  981 
  982         # mkcol
  983         # Return 0 if fail because the error will have already
  984         # been set by the mkcol routine
  985         if ( $self->mkcol($target, -headers => $custom_headers) ) {
  986             if ( !opendir( DIR, $local ) ) {
  987                 $self->err( 'ERR_GENERIC', "chdir to \"$local\" failed: $!" );
  988             }
  989             else {
  990                 my @files = readdir(DIR);
  991                 close DIR;
  992                 foreach my $file (@files) {
  993                     next if $file eq ".";
  994                     next if $file eq "..";
  995                     my $progeny = "$local/$file";
  996                     $progeny =~ s#//#/#g;    # Fold down double slashes
  997                     $self->_put(
  998                         -local => $progeny,
  999                         -url   => "$target/$file",
 1000                     );
 1001                 }
 1002             }
 1003         }
 1004 
 1005     # PUT A FILE
 1006     }
 1007     else {
 1008         my $content = "";
 1009         my $fail    = 0;
 1010         if ($content_ptr) {
 1011             $content = $$local;
 1012         }
 1013         else {
 1014             if ( !CORE::open( F, $local ) ) {
 1015                 $self->err( 'ERR_GENERIC',
 1016                     "Couldn't open local file $local: $!" );
 1017                 $fail = 1;
 1018             }
 1019             else {
 1020                 binmode F;
 1021                 while (my $line = <F>) { $content .= $line; }
 1022                 close F;
 1023             }
 1024         }
 1025 
 1026         if ( !$fail ) {
 1027             my $resource = $self->new_resource( -uri => $target );
 1028             my $response = $resource->put($content,$custom_headers);
 1029             if ( $response->is_success ) {
 1030                 $self->ok( "put $target (" . length($content) . " bytes)",
 1031                     $target );
 1032             }
 1033             else {
 1034                 $self->err( 'ERR_RESP_FAIL',
 1035                     "put failed " . $response->message(), $target );
 1036             }
 1037         }
 1038     }
 1039 }
 1040 
 1041 ######################################################################
 1042 # UTILITY FUNCTION
 1043 # get_absolute_uri:
 1044 # Synopsis: $new_url = get_absolute_uri("/foo/bar")
 1045 # Takes a URI (or string)
 1046 # and returns the absolute URI based
 1047 # on the remote current working directory
 1048 sub get_absolute_uri {
 1049     my ( $self, @p ) = @_;
 1050     my ( $rel_uri, $base_uri )
 1051         = HTTP::DAV::Utils::rearrange( [ 'REL_URI', 'BASE_URI' ], @p );
 1052 
 1053     local $URI::URL::ABS_REMOTE_LEADING_DOTS = 1;
 1054     if ( !defined $base_uri ) {
 1055         $base_uri = $self->get_workingresource()->get_uri();
 1056     }
 1057 
 1058     if ($base_uri) {
 1059         my $new_url = URI->new_abs( $rel_uri, $base_uri );
 1060         return $new_url;
 1061     }
 1062     else {
 1063         $rel_uri;
 1064     }
 1065 }
 1066 
 1067 ## Takes a $dav->get_globs(URI)
 1068 # Where URI may contain wildcards at the leaf level:
 1069 # URI:
 1070 #   http://www.host.org/perldav/test*.html
 1071 #   /perldav/test?.html
 1072 #   test[12].html
 1073 #
 1074 # Performs a propfind to determine the url's that match
 1075 #
 1076 sub get_globs {
 1077     my ( $self, $url ) = @_;
 1078     my @urls = ();
 1079     my ( $left, $leafname ) = HTTP::DAV::Utils::split_leaf($url);
 1080 
 1081     # We need to unescape it because it may have been encoded.
 1082     $leafname = URI::Escape::uri_unescape($leafname);
 1083 
 1084     if ( $leafname =~ /[\*\?\[]/ ) {
 1085         my $resource = $self->new_resource( -uri => $left );
 1086         my $resp = $resource->propfind( -depth => 1 );
 1087         if ( $resp->is_error ) {
 1088             $self->err( 'ERR_RESP_FAIL', $resp->message(), $left );
 1089             return ();
 1090         }
 1091 
 1092         $leafname = HTTP::DAV::Utils::glob2regex($leafname);
 1093         my $rl = $resource->get_resourcelist();
 1094         if ($rl) {
 1095             my $match = 0;
 1096 
 1097             # We eval this because a bogus leafname could bomb the regex.
 1098             eval {
 1099                 foreach my $progeny ( $rl->get_resources() )
 1100                 {
 1101                     my $progeny_url = $progeny->get_uri;
 1102                     my $progeny_leaf
 1103                         = HTTP::DAV::Utils::get_leafname($progeny_url);
 1104                     if ( $progeny_leaf =~ /^$leafname$/ ) {
 1105                         print "Matched $progeny_url\n"
 1106                             if $HTTP::DAV::DEBUG > 1;
 1107                         $match++;
 1108                         push( @urls, $progeny_url );
 1109                     }
 1110                     else {
 1111                         print "Skipped $progeny_url\n"
 1112                             if $HTTP::DAV::DEBUG > 1;
 1113                     }
 1114                 }
 1115             };
 1116             $self->err( 'ERR_GENERIC', "No match found" ) unless ($match);
 1117         }
 1118     }
 1119     else {
 1120         push( @urls, $url );
 1121     }
 1122 
 1123     return @urls;
 1124 }
 1125 
 1126 sub what_happened {
 1127     my ($self, $url, $resource, $response) = @_;
 1128 
 1129     if (! $response->is_error()) {
 1130         return { success => 1 }
 1131     }
 1132 
 1133     my $error_type;
 1134     my $error_msg;
 1135 
 1136     # Method not allowed
 1137     if ($response->status_line =~ m{405}) {
 1138         $error_type = 'ERR_405';
 1139         $error_msg = $response->status_line;
 1140     }
 1141     # 501 most probably means your LWP doesn't support SSL
 1142     elsif ($response->status_line =~ m{501}) {
 1143         $error_type = 'ERR_501';
 1144         $error_msg = $response->status_line;
 1145     }
 1146     elsif ($response->www_authenticate) {
 1147         $error_type = 'ERR_UNAUTHORIZED';
 1148         $error_msg  = $response->www_authenticate;
 1149     }
 1150     elsif ( !$resource->is_dav_compliant ) {
 1151         $error_type = 'ERR_GENERIC';
 1152         $error_msg = qq{The URL "$url" is not DAV enabled or not accessible.};
 1153     }
 1154     else {
 1155         $error_type = 'ERR_RESP_FAIL';
 1156         my $message = $response->message();
 1157         $error_msg = qq{Could not access $url: $message};
 1158     }
 1159 
 1160     return {
 1161         success => 0,
 1162         error_type => $error_type,
 1163         error_msg => $error_msg,
 1164     }
 1165 
 1166 }
 1167 
 1168 1;
 1169 
 1170 __END__
 1171 
 1172 
 1173 =head1 NAME
 1174 
 1175 HTTP::DAV - A WebDAV client library for Perl5
 1176 
 1177 =head1 SYNOPSIS
 1178 
 1179    # DAV script that connects to a webserver, safely makes 
 1180    # a new directory and uploads all html files in 
 1181    # the /tmp directory.
 1182 
 1183    use HTTP::DAV;
 1184   
 1185    $d = HTTP::DAV->new();
 1186    $url = "http://host.org:8080/dav/";
 1187  
 1188    $d->credentials(
 1189       -user  => "pcollins",
 1190       -pass  => "mypass", 
 1191       -url   => $url,
 1192       -realm => "DAV Realm"
 1193    );
 1194  
 1195    $d->open( -url => $url )
 1196       or die("Couldn't open $url: " .$d->message . "\n");
 1197  
 1198    # Make a null lock on newdir
 1199    $d->lock( -url => "$url/newdir", -timeout => "10m" ) 
 1200       or die "Won't put unless I can lock for 10 minutes\n";
 1201 
 1202    # Make a new directory
 1203    $d->mkcol( -url => "$url/newdir" )
 1204       or die "Couldn't make newdir at $url\n";
 1205   
 1206    # Upload multiple files to newdir.
 1207    if ( $d->put( -local => "/tmp/*.html", -url => $url ) ) {
 1208       print "successfully uploaded multiple files to $url\n";
 1209    } else {
 1210       print "put failed: " . $d->message . "\n";
 1211    }
 1212   
 1213    $d->unlock( -url => $url );
 1214 
 1215 =head1 DESCRIPTION
 1216 
 1217 HTTP::DAV is a Perl API for interacting with and modifying content on webservers using the WebDAV protocol. Now you can LOCK, DELETE and PUT files and much more on a DAV-enabled webserver.
 1218 
 1219 HTTP::DAV is part of the PerlDAV project hosted at http://www.webdav.org/perldav/ and has the following features:
 1220 
 1221 =over 4
 1222 
 1223 =item *
 1224 
 1225 Full RFC2518 method support. OPTIONS, TRACE, GET, HEAD, DELETE, PUT, COPY, MOVE, PROPFIND, PROPPATCH, LOCK, UNLOCK.
 1226 
 1227 =item *
 1228 
 1229 A fully object-oriented API.
 1230 
 1231 =item *
 1232 
 1233 Recursive GET and PUT for site backups and other scripted transfers.
 1234 
 1235 =item *
 1236 
 1237 Transparent lock handling when performing LOCK/COPY/UNLOCK sequences.
 1238 
 1239 =item *
 1240 
 1241 http and https support (https requires the Crypt::SSLeay library). See INSTALLATION.
 1242 
 1243 =item *
 1244 
 1245 Basic AND Digest authentication support (Digest auth requires the MD5 library). See INSTALLATION.
 1246 
 1247 =item *
 1248 
 1249 C<dave>, a fully-functional ftp-style interface written on top of the HTTP::DAV API and bundled by default with the HTTP::DAV library. (If you've already installed HTTP::DAV, then dave will also have been installed (probably into /usr/local/bin). You can see it's man page by typing "perldoc dave" or going to http://www.webdav.org/perldav/dave/.
 1250 
 1251 =item *
 1252 
 1253 It is built on top of the popular LWP (Library for WWW access in Perl). This means that HTTP::DAV inherits proxy support, redirect handling, basic (and digest) authorization and many other HTTP operations. See C<LWP> for more information.
 1254 
 1255 =item *
 1256 
 1257 Popular server support. HTTP::DAV has been tested against the following servers: mod_dav, IIS5, Xythos webfile server and mydocsonline. The library is growing an impressive interoperability suite which also serves as useful "sample scripts". See "make test" and t/*.
 1258 
 1259 =back
 1260 
 1261 C<HTTP::DAV> essentially has two API's, one which is accessed through this module directly (HTTP::DAV) and is a simple abstraction to the rest of the HTTP::DAV::* Classes. The other interface consists of the HTTP::DAV::* classes which if required allow you to get "down and dirty" with your DAV and HTTP interactions.
 1262 
 1263 The methods provided in C<HTTP::DAV> should do most of what you want. If, however, you need more control over the client's operations or need more info about the server's responses then you will need to understand the rest of the HTTP::DAV::* interfaces. A good place to start is with the C<HTTP::DAV::Resource> and C<HTTP::DAV::Response> documentation.
 1264 
 1265 =head1 METHODS
 1266 
 1267 =head2 METHOD CALLING: Named vs Unnamed parameters
 1268 
 1269 You can pass parameters to C<HTTP::DAV> methods in one of two ways: named or unnamed.
 1270 
 1271 Named parameters provides for a simpler/easier to use interface. A named interface affords more readability and allows the developer to ignore a specific order on the parameters. (named parameters are also case insensitive) 
 1272 
 1273 Each argument name is preceded by a dash.  Neither case nor order matters in the argument list.  -url, -Url, and -URL are all acceptable.  In fact, only the first argument needs to begin with a dash.  If a dash is present in the first argument, C<HTTP::DAV> assumes dashes for the subsequent ones.
 1274 
 1275 Each method can also be called with unnamed parameters which often makes sense for methods with only one parameter. But the developer will need to ensure that the parameters are passed in the correct order (as listed in the docs).
 1276 
 1277  Doc:     method( -url=>$url, [-depth=>$depth] )
 1278  Named:   $d->method( -url=>$url, -depth=>$d ); # VALID
 1279  Named:   $d->method( -Depth=>$d, -Url=>$url ); # VALID
 1280  Named:   $d->method( Depth=>$d,  Url=>$url );  # INVALID (needs -)
 1281  Named:   $d->method( -Arg2=>$val2 ); # INVALID, ARG1 is not optional
 1282  Unnamed: $d->method( $val1 );        # VALID
 1283  Unnamed: $d->method( $val2,$val1 );  # INVALID, ARG1 must come first.
 1284 
 1285 IMPORTANT POINT!!!! If you specify a named parameter first but then forget for the second and third parameters, you WILL get weird things happen. E.g. this is bad:
 1286 
 1287  $d->method( -url=>$url, $arg2, $arg3 ); # BAD BAD BAD
 1288 
 1289 =head2 THINGS YOU NEED TO KNOW
 1290 
 1291 In all of the methods specified in L<PUBLIC METHODS> there are some common concepts you'll need to understand:
 1292 
 1293 =over 4
 1294 
 1295 =item * URLs represent an absolute or relative URI. 
 1296 
 1297   -url=>"host.org/dav_dir/"  # Absolute
 1298   -url=>"/dav_dir/"          # Relative
 1299   -url=>"file.txt"           # Relative
 1300 
 1301 You can only use a relative URL if you have already "open"ed an absolute URL.
 1302 
 1303 The HTTP::DAV module now consistently uses the named parameter: URL. The lower-level HTTP::DAV::Resource interface inconsistently interchanges URL and URI. I'm working to resolve this, in the meantime, you'll just need to remember to use the right one by checking the documentation if you need to mix up your use of both interfaces.
 1304 
 1305 =item * GLOBS
 1306 
 1307 Some methods accept wildcards in the URL. A wildcard can be used to indicate that the command should perform the command on all Resources that match the wildcard. These wildcards are called GLOBS.
 1308 
 1309 The glob may contain the characters "*", "?" and the set operator "[...]" where ... contains multiple characters ([1t2]) or a range such ([1-5]). For the curious, the glob is converted to a regex and then matched: "*" to ".*", "?" to ".", and the [] is left untouched.
 1310 
 1311 It is important to note that globs only operate at the leaf-level. For instance "/my_dir/*/file.txt" is not a valid glob.
 1312 
 1313 If a glob matches no URL's the command will fail (which normally means returns 0).
 1314 
 1315 Globs are useful in conjunction with L<CALLBACKS> to provide feedback as each operation completes.
 1316 
 1317 See the documentation for each method to determine whether it supports globbing.
 1318 
 1319 Globs are useful for interactive style applications (see the source code for C<dave> as an example).
 1320 
 1321 Example globs:
 1322 
 1323    $dav1->delete(-url=>"/my_dir/file[1-3]");     # Matches file1, file2, file3
 1324    $dav1->delete(-url=>"/my_dir/file[1-3]*.txt");# Matches file1*.txt,file2*.txt,file3*.txt
 1325    $dav1->delete(-url=>"/my_dir/*/file.txt");    # Invalid. Can only match at leaf-level
 1326 
 1327 =item * CALLBACKS
 1328 
 1329 Callbacks are used by some methods (primarily get and put) to give the caller some insight as to how the operation is progressing. A callback allows you to define a subroutine as defined below and pass a reference (\&ref) to the method.
 1330 
 1331 The rationale behind the callback is that a recursive get/put or an operation against many files (using a C<glob>) can actually take a long time to complete.
 1332 
 1333 Example callback:
 1334 
 1335    $d->get( -url=>$url, -to=>$to, -callback=>\&mycallback );
 1336 
 1337 Your callback function MUST accept arguments as follows:
 1338    sub cat_callback {
 1339       my($status,$mesg,$url,$so_far,$length,$data) = @_;
 1340       ...
 1341    }
 1342 
 1343 The C<status> argument specifies whether the operation has succeeded (1), failed (0), or is in progress (-1).
 1344 
 1345 The C<mesg> argument is a status message. The status message could contain any string and often contains useful error messages or success messages. 
 1346 
 1347 The C<url> the remote URL.
 1348 
 1349 The C<so_far>, C<length> - these parameters indicate how many bytes have been downloaded and how many we should expect. This is useful for doing "56% to go" style-gauges. 
 1350 
 1351 The C<data> parameter - is the actual data transferred. The C<cat> command uses this to print the data to the screen. This value will be empty for C<put>.
 1352 
 1353 See the source code of C<dave> for a useful sample of how to setup a callback.
 1354 
 1355 Note that these arguments are NOT named parameters.
 1356 
 1357 All error messages set during a "multi-operation" request (for instance a recursive get/put) are also retrievable via the C<errors()> function once the operation has completed. See C<ERROR HANDLING> for more information.
 1358 
 1359 =back
 1360 
 1361 =head2 PUBLIC METHODS
 1362 
 1363 =over 4
 1364 
 1365 =item B<new(USERAGENT)>
 1366 
 1367 =item B<new(USERAGENT, HEADERS)>
 1368 
 1369 Creates a new C<HTTP::DAV> client
 1370 
 1371  $d = HTTP::DAV->new();
 1372 
 1373 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 and password.
 1374 
 1375 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:
 1376 
 1377   { "X-My-Header" => "value", ... }
 1378 
 1379 or a L<HTTP::Headers> object.
 1380 
 1381 =item B<credentials(USER,PASS,[URL],[REALM])>
 1382 
 1383 sets authorization credentials for a C<URL> and/or C<REALM>.
 1384 
 1385 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.
 1386 
 1387 Either C<URL> or C<REALM> must be provided.
 1388 
 1389 returns no value
 1390 
 1391 Example:
 1392 
 1393  $d->credentials( -url=>'myhost.org:8080/test/',
 1394                   -user=>'pcollins',
 1395                   -pass=>'mypass');
 1396 
 1397 =item B<DebugLevel($val)>
 1398 
 1399 sets the debug level to C<$val>. 0=off 3=noisy.
 1400 
 1401 C<$val> default is 0. 
 1402 
 1403 returns no value.
 1404 
 1405 When the value is greater than 1, the C<HTTP::DAV::Comms> module will log all of the client<=>server interactions into /tmp/perldav_debug.txt.
 1406 
 1407 =back
 1408 
 1409 =head2 DAV OPERATIONS
 1410 
 1411 For all of the following operations, URL can be absolute (http://host.org/dav/) or relative (../dir2/). The only operation that requires an absolute URL is open.
 1412 
 1413 =over 4 
 1414 
 1415 =item B<copy(URL,DEST,[OVERWRITE],[DEPTH])>
 1416 
 1417 copies one remote resource to another
 1418 
 1419 =over 4 
 1420 
 1421 =item C<-url> 
 1422 
 1423 is the remote resource you'd like to copy. Mandatory
 1424 
 1425 =item C<-dest> 
 1426 
 1427 is the remote target for the copy command. Mandatory
 1428 
 1429 =item C<-overwrite> 
 1430 
 1431 optionally indicates whether the server should fail if the target exists. Valid values are "T" and "F" (1 and 0 are synonymous). Default is T.
 1432 
 1433 =item C<-depth> 
 1434 
 1435 optionally indicates whether the server should do a recursive copy or not. Valid values are 0 and (1 or "infinity"). Default is "infinity" (1).
 1436 
 1437 =back
 1438 
 1439 The return value is always 1 or 0 indicating success or failure.
 1440 
 1441 Requires a working resource to be set before being called. See C<open>.
 1442 
 1443 Note: if either C<'URL'> or C<'DEST'> are locked by this dav client, then the lock headers will be taken care of automatically. If the either of the two URL's are locked by someone else, the server should reject the request.
 1444 
 1445 B<copy examples:>
 1446 
 1447   $d->open(-url=>"host.org/dav_dir/");
 1448 
 1449 Recursively copy dir1/ to dir2/
 1450 
 1451   $d->copy(-url=>"dir1/", -dest=>"dir2/");
 1452 
 1453 Non-recursively and non-forcefully copy dir1/ to dir2/
 1454 
 1455   $d->copy(-url=>"dir1/", -dest=>"dir2/",-overwrite=>0,-depth=>0);
 1456 
 1457 Create a copy of dir1/file.txt as dir2/file.txt
 1458 
 1459   $d->cwd(-url=>"dir1/");
 1460   $d->copy("file.txt","../dir2");
 1461 
 1462 Create a copy of file.txt as dir2/new_file.txt
 1463 
 1464   $d->copy("file.txt","/dav_dir/dir2/new_file.txt")
 1465 
 1466 =item B<cwd(URL)>
 1467 
 1468 changes the remote working directory. 
 1469 
 1470 This is synonymous to open except that the URL can be relative and may contain a C<glob> (the first match in a glob will be used).
 1471 
 1472   $d->open("host.org/dav_dir/dir1/");
 1473   $d->cwd("../dir2");
 1474   $d->cwd(-url=>"../dir1");
 1475 
 1476 The return value is always 1 or 0 indicating success or failure. 
 1477 
 1478 Requires a working resource to be set before being called. See C<open>.
 1479 
 1480 You can not cwd to files, only collections (directories).
 1481 
 1482 =item B<delete(URL)>
 1483 
 1484 deletes a remote resource.
 1485 
 1486   $d->open("host.org/dav_dir/");
 1487   $d->delete("index.html");
 1488   $d->delete("./dir1");
 1489   $d->delete(-url=>"/dav_dir/dir2/file*",-callback=>\&mycallback);
 1490 
 1491 =item C<-url>
 1492 
 1493 is the remote resource(s) you'd like to delete. It can be a file, directory or C<glob>. 
 1494 
 1495 =item C<-callback>                                                                                                                                                                    is a reference to a callback function which will be called everytime a file is deleted. This is mainly useful when used in conjunction with L<GLOBS> deletes. See L<callbacks>
 1496 
 1497 The return value is always 1 or 0 indicating success or failure. 
 1498 
 1499 Requires a working resource to be set before being called. See C<open>.
 1500 
 1501 This command will recursively delete directories. BE CAREFUL of uninitialised file variables in situation like this: $d->delete("$dir/$file"). This will trash your $dir if $file is not set.
 1502 
 1503 =item B<get(URL,[TO],[CALLBACK])>
 1504 
 1505 downloads the file or directory at C<URL> to the local location indicated by C<TO>.
 1506 
 1507 =over 4 
 1508 
 1509 =item C<-url> 
 1510 
 1511 is the remote resource you'd like to get. It can be a file or directory or a "glob".
 1512 
 1513 =item C<-to> 
 1514 
 1515 is where you'd like to put the remote resource. The -to parameter can be:
 1516 
 1517  - a B<filename> indicating where to save the contents.
 1518 
 1519  - a B<FileHandle reference>.
 1520 
 1521  - a reference to a B<scalar object> into which the contents will be saved.
 1522 
 1523 If the C<-url> matches multiple files (via a glob or a directory download), then the C<get> routine will return an error if you try to use a FileHandle reference or a scalar reference.
 1524 
 1525 =item C<-callback>
 1526 
 1527 is a reference to a callback function which will be called everytime a file is completed downloading. The idea of the callback function is that some recursive get's can take a very long time and the user may require some visual feedback. See L<CALLBACKS> for an examples and how to use a callback.
 1528 
 1529 =back
 1530 
 1531 The return value of get is always 1 or 0 indicating whether the entire get sequence was a success or if there was ANY failures. For instance, in a recursive get, if the server couldn't open 1 of the 10 remote files, for whatever reason, then the return value will be 0. This is so that you can have your script call the C<errors()> routine to handle error conditions.
 1532 
 1533 Previous versions of HTTP::DAV allowed the return value to be the file contents if no -to attribute was supplied. This functionality is deprecated.
 1534 
 1535 Requires a working resource to be set before being called. See C<open>.
 1536 
 1537 B<get examples:>
 1538 
 1539   $d->open("host.org/dav_dir/");
 1540 
 1541 Recursively get remote my_dir/ to .
 1542 
 1543   $d->get("my_dir/",".");
 1544 
 1545 Recursively get remote my_dir/ to /tmp/my_dir/ calling &mycallback($success,$mesg) everytime a file operation is completed.
 1546 
 1547   $d->get("my_dir","/tmp",\&mycallback);
 1548 
 1549 Get remote my_dir/index.html to /tmp/index.html
 1550 
 1551   $d->get(-url=>"/dav_dir/my_dir/index.html",-to=>"/tmp");
 1552 
 1553 Get remote index.html to /tmp/index1.html
 1554 
 1555   $d->get("index.html","/tmp/index1.html");
 1556 
 1557 Get remote index.html to a filehandle
 1558 
 1559   my $fh = new FileHandle;
 1560   $fh->open(">/tmp/index1.html");
 1561   $d->get("index.html",\$fh);
 1562 
 1563 Get remote index.html as a scalar (into the string $file_contents):
 1564 
 1565   my $file_contents;
 1566   $d->get("index.html",\$file_contents);
 1567 
 1568 Get all of the files matching the globs file1* and file2*:
 1569 
 1570   $d->get("file[12]*","/tmp");
 1571 
 1572 Get all of the files matching the glob file?.html:
 1573 
 1574   $d->get("file?.html","/tmp"); # downloads file1.html and file2.html but not file3.html or file1.txt
 1575 
 1576 Invalid glob:
 1577 
 1578   $d->get("/dav_dir/*/index.html","/tmp"); # Can not glob like this.
 1579 
 1580 =item B<lock([URL],[OWNER],[DEPTH],[TIMEOUT],[SCOPE],[TYPE])>
 1581 
 1582 locks a resource. If URL is not specified, it will lock the current working resource (opened resource).
 1583 
 1584    $d->lock( -url     => "index.html",
 1585              -owner   => "Patrick Collins",
 1586              -depth   => "infinity",
 1587              -scope   => "exclusive",
 1588              -type    => "write",
 1589              -timeout => "10h" )
 1590 
 1591 See C<HTTP::DAV::Resource> lock() for details of the above parameters.
 1592 
 1593 The return value is always 1 or 0 indicating success or failure. 
 1594 
 1595 Requires a working resource to be set before being called. See C<open>.
 1596 
 1597 When you lock a resource, the lock is held against the current HTTP::DAV object. In fact, the locks are held in a C<HTTP::DAV::ResourceList> object. You can operate against all of the locks that you have created as follows:
 1598 
 1599   ## Print and unlock all locks that we own.
 1600   my $rl_obj = $d->get_lockedresourcelist();
 1601   foreach $resource ( $rl_obj->get_resources() ) {
 1602       @locks = $resource->get_locks(-owned=>1);
 1603       foreach $lock ( @locks ) { 
 1604         print $resource->get_uri . "\n";
 1605         print $lock->as_string . "\n";
 1606       }
 1607       ## Unlock them?
 1608       $resource->unlock;
 1609   }
 1610 
 1611 Typically, a simple $d->unlock($uri) will suffice.
 1612 
 1613 B<lock example>
 1614 
 1615   $d->lock($uri, -timeout=>"1d");
 1616   ...
 1617   $d->put("/tmp/index.html",$uri);
 1618   $d->unlock($uri);
 1619 
 1620 =item B<mkcol(URL)>
 1621 
 1622 make a remote collection (directory)
 1623 
 1624 The return value is always 1 or 0 indicating success or failure. 
 1625 
 1626 Requires a working resource to be set before being called. See C<open>.
 1627 
 1628   $d->open("host.org/dav_dir/");
 1629   $d->mkcol("new_dir");                  # Should succeed
 1630   $d->mkcol("/dav_dir/new_dir");         # Should succeed
 1631   $d->mkcol("/dav_dir/new_dir/xxx/yyy"); # Should fail
 1632 
 1633 =item B<move(URL,DEST,[OVERWRITE],[DEPTH])>
 1634 
 1635 moves one remote resource to another
 1636 
 1637 =over 4 
 1638 
 1639 =item C<-url> 
 1640 
 1641 is the remote resource you'd like to move. Mandatory
 1642 
 1643 =item C<-dest> 
 1644 
 1645 is the remote target for the move command. Mandatory
 1646 
 1647 =item C<-overwrite> 
 1648 
 1649 optionally indicates whether the server should fail if the target exists. Valid values are "T" and "F" (1 and 0 are synonymous). Default is T.
 1650 
 1651 =back
 1652 
 1653 Requires a working resource to be set before being called. See C<open>.
 1654 
 1655 The return value is always 1 or 0 indicating success or failure.
 1656 
 1657 Note: if either C<'URL'> or C<'DEST'> are locked by this dav client, then the lock headers will be taken care of automatically. If either of the two URL's are locked by someone else, the server should reject the request.
 1658 
 1659 B<move examples:>
 1660 
 1661   $d->open(-url=>"host.org/dav_dir/");
 1662 
 1663 move dir1/ to dir2/
 1664 
 1665   $d->move(-url=>"dir1/", -dest=>"dir2/");
 1666 
 1667 non-forcefully move dir1/ to dir2/
 1668 
 1669   $d->move(-url=>"dir1/", -dest=>"dir2/",-overwrite=>0);
 1670 
 1671 Move dir1/file.txt to dir2/file.txt
 1672 
 1673   $d->cwd(-url=>"dir1/");
 1674   $d->move("file.txt","../dir2");
 1675 
 1676 move file.txt to dir2/new_file.txt
 1677 
 1678   $d->move("file.txt","/dav_dir/dir2/new_file.txt")
 1679 
 1680 =item B<open(URL)>
 1681 
 1682 opens the directory (collection resource) at URL.
 1683 
 1684 open will perform a propfind against URL. If the server does not understand the request then the open will fail. 
 1685 
 1686 Similarly, if the server indicates that the resource at URL is NOT a collection, the open command will fail.
 1687 
 1688 =item B<options([URL])>
 1689 
 1690 Performs an OPTIONS request against the URL or the working resource if URL is not supplied.
 1691 
 1692 Requires a working resource to be set before being called. See C<open>.
 1693 
 1694 The return value is a string of comma separated OPTIONS that the server states are legal for URL or undef otherwise.
 1695 
 1696 A fully compliant DAV server may offer as many methods as: OPTIONS, TRACE, GET, HEAD, DELETE, PUT, COPY, MOVE, PROPFIND, PROPPATCH, LOCK, UNLOCK
 1697 
 1698 Note: IIS5 does not support PROPPATCH or LOCK on collections.
 1699 
 1700 Example:
 1701 
 1702  $options = $d->options($url);
 1703  print $options . "\n";
 1704  if ($options=~ /\bPROPPATCH\b/) {
 1705     print "OK to proppatch\n";
 1706  }
 1707 
 1708 Or, put more simply:
 1709 
 1710  if ( $d->options($url) =~ /\bPROPPATCH\b/ ) {
 1711     print "OK to proppatch\n";
 1712  }
 1713 
 1714 =item B<propfind([URL],[DEPTH])>
 1715 
 1716 Perform a propfind against URL at DEPTH depth.
 1717 
 1718 C<-depth> can be used to specify how deep the propfind goes. "0" is collection only. "1" is collection and it's immediate members (This is the default value). "infinity" is the entire directory tree. Note that most DAV compliant servers deny "infinity" depth propfinds for security reasons.
 1719 
 1720 Requires a working resource to be set before being called. See C<open>.
 1721 
 1722 The return value is an C<HTTP::DAV::Resource> object on success or 0 on failure.
 1723 
 1724 The Resource object can be used for interrogating properties or performing other operations.
 1725 
 1726  ## Print collection or content length
 1727  if ( $r=$d->propfind( -url=>"/my_dir", -depth=>1) ) {
 1728     if ( $r->is_collection ) {
 1729        print "Collection\n" 
 1730        print $r->get_resourcelist->as_string . "\n"
 1731     } else {
 1732        print $r->get_property("getcontentlength") ."\n";
 1733     }
 1734  }
 1735 
 1736 Please note that although you may set a different namespace for a property of a resource during a set_prop, HTTP::DAV currently ignores all XML namespaces so you will get clashes if two properties have the same name but in different namespaces. Currently this is unavoidable but I'm working on the solution.
 1737 
 1738 =item B<proppatch([URL],[NAMESPACE],PROPNAME,PROPVALUE,ACTION,[NSABBR])>
 1739 
 1740 If C<-action> equals "set" then we set a property named C<-propname> to C<-propvalue> in the namespace C<-namespace> for C<-url>. 
 1741 
 1742 If C<-action> equals "remove" then we unset a property named C<-propname> in the namespace C<-namespace> for C<-url>. 
 1743 
 1744 If no action is supplied then the default action is "set".
 1745 
 1746 The return value is an C<HTTP::DAV::Resource> object on success or 0 on failure.
 1747 
 1748 The Resource object can be used for interrogating properties or performing other operations.
 1749 
 1750 To explicitly set a namespace in which to set the propname then you can use the C<-namespace> and C<-nsabbr> (namespace abbreviation) parameters. But you're welcome to play around with DAV namespaces.
 1751 
 1752 Requires a working resource to be set before being called. See C<open>.
 1753 
 1754 It is recommended that you use C<set_prop> and C<unset_prop> instead of proppatch for readability. 
 1755 
 1756 C<set_prop> simply calls C<proppatch(-action=>set)> and C<unset_prop> calls C<proppatch(-action=>"remove")>
 1757 
 1758 See C<set_prop> and C<unset_prop> for examples.
 1759 
 1760 =item B<put(LOCAL,[URL],[CALLBACK],[HEADERS])>
 1761 
 1762 uploads the files or directories at C<-local> to the remote destination at C<-url>.
 1763 
 1764 C<-local> points to a file, directory or series of files or directories (indicated by a glob).
 1765 
 1766 If the filename contains any of the characters `*',  `?' or  `['  it is a candidate for filename substitution, also  known  as  ``globbing''.   This word  is  then regarded as a pattern (``glob-pattern''), and replaced with an alphabetically sorted list  of  file  names which match the pattern.  
 1767 
 1768 One can upload/put a string by passing a reference to a scalar in the -local parameter. See example below.
 1769 
 1770 put requires a working resource to be set before being called. See C<open>.
 1771 
 1772 The return value is always 1 or 0 indicating success or failure.
 1773 
 1774 See L<get()> for a description of what the optional callback parameter does.
 1775 
 1776 You can also pass a C<-headers> argument. That allows one to specify custom HTTP headers. It can be either a hashref with header names and values, or a L<HTTP::Headers> object.
 1777 
 1778 B<put examples:>
 1779 
 1780 Put a string to the server:
 1781 
 1782   my $myfile = "This is the contents of a file to be uploaded\n";
 1783   $d->put(-local=>\$myfile,-url=>"http://www.host.org/dav_dir/file.txt");
 1784 
 1785 Put a local file to the server:
 1786 
 1787   $d->put(-local=>"/tmp/index.html",-url=>"http://www.host.org/dav_dir/");
 1788 
 1789 Put a series of local files to the server:
 1790 
 1791   In these examples, /tmp contains file1.html, file1, file2.html, 
 1792   file2.txt, file3.html, file2/
 1793 
 1794   $d->put(-local=>"/tmp/file[12]*",-url=>"http://www.host.org/dav_dir/");
 1795   
 1796   uploads file1.html, file1, file2.html, file2.txt and the directory file2/ to dav_dir/.
 1797 
 1798 =item B<set_prop([URL],[NAMESPACE],PROPNAME,PROPVALUE)>
 1799 
 1800 Sets a property named C<-propname> to C<-propvalue> in the namespace C<-namespace> for C<-url>. 
 1801 
 1802 Requires a working resource to be set before being called. See C<open>.
 1803 
 1804 The return value is an C<HTTP::DAV::Resource> object on success or 0 on failure.
 1805 
 1806 The Resource object can be used for interrogating properties or performing other operations.
 1807 
 1808 Example:
 1809 
 1810  if ( $r = $d->set_prop(-url=>$url,
 1811               -namespace=>"dave",
 1812               -propname=>"author",
 1813               -propvalue=>"Patrick Collins"
 1814              ) ) {
 1815     print "Author property set\n";
 1816  } else {
 1817     print "set_prop failed:" . $d->message . "\n";
 1818  }
 1819 
 1820 See the note in propfind about namespace support in HTTP::DAV. They're settable, but not readable.
 1821 
 1822 
 1823 
 1824 =item B<steal([URL])>
 1825 
 1826 forcefully steals any locks held against URL.
 1827 
 1828 steal will perform a propfind against URL and then, any locks that are found will be unlocked one by one regardless of whether we own them or not.
 1829 
 1830 Requires a working resource to be set before being called. See C<open>.
 1831 
 1832 The return value is always 1 or 0 indicating success or failure. If multiple locks are found and unlocking one of them fails then the operation will be aborted.
 1833 
 1834  if ($d->steal()) {
 1835     print "Steal succeeded\n";
 1836  } else {
 1837     print "Steal failed: ". $d->message() . "\n";
 1838  }
 1839 
 1840 =item B<unlock([URL])>
 1841 
 1842 unlocks any of our locks on URL.
 1843 
 1844 Requires a working resource to be set before being called. See C<open>.
 1845 
 1846 The return value is always 1 or 0 indicating success or failure.
 1847 
 1848  if ($d->unlock()) {
 1849     print "Unlock succeeded\n";
 1850  } else {
 1851     print "Unlock failed: ". $d->message() . "\n";
 1852  }
 1853 
 1854 =item B<unset_prop([URL],[NAMESPACE],PROPNAME)>
 1855 
 1856 Unsets a property named C<-propname> in the namespace C<-namespace> for C<-url>. 
 1857 Requires a working resource to be set before being called. See C<open>.
 1858 
 1859 The return value is an C<HTTP::DAV::Resource> object on success or 0 on failure.
 1860 
 1861 The Resource object can be used for interrogating properties or performing other operations.
 1862 
 1863 Example:
 1864 
 1865  if ( $r = $d->unset_prop(-url=>$url,
 1866               -namespace=>"dave",
 1867               -propname=>"author",
 1868              ) ) {
 1869     print "Author property was unset\n";
 1870  } else {
 1871     print "set_prop failed:" . $d->message . "\n";
 1872  }
 1873 
 1874 See the note in propfind about namespace support in HTTP::DAV. They're settable, but not readable.
 1875 
 1876 =back
 1877 
 1878 =head2 ACCESSOR METHODS
 1879 
 1880 =over 4 
 1881 
 1882 =item B<get_user_agent>
 1883 
 1884 Returns the clients' working C<HTTP::DAV::UserAgent> object. 
 1885 
 1886 You may want to interact with the C<HTTP::DAV::UserAgent> object 
 1887 to modify request headers or provide advanced authentication 
 1888 procedures. See dave for an advanced authentication procedure.
 1889 
 1890 =item B<get_last_request>
 1891 
 1892 Takes no arguments and returns the clients' last outgoing C<HTTP::Request> object. 
 1893 
 1894 You would only use this to inspect a request that has already occurred.
 1895 
 1896 If you would like to modify the C<HTTP::Request> BEFORE the HTTP request takes place (for instance to add another header), you will need to get the C<HTTP::DAV::UserAgent> using C<get_user_agent> and interact with that.
 1897 
 1898 =item B<get_workingresource>
 1899 
 1900 Returns the currently "opened" or "working" resource (C<HTTP::DAV::Resource>).
 1901 
 1902 The working resource is changed whenever you open a url or use the cwd command.
 1903 
 1904 e.g. 
 1905   $r = $d->get_workingresource
 1906   print "pwd: " . $r->get_uri . "\n";
 1907 
 1908 =item B<get_workingurl>
 1909 
 1910 Returns the currently "opened" or "working" C<URL>.
 1911 
 1912 The working resource is changed whenever you open a url or use the cwd command.
 1913 
 1914   print "pwd: " . $d->get_workingurl . "\n";
 1915 
 1916 =item B<get_lockedresourcelist>
 1917 
 1918 Returns an C<HTTP::DAV::ResourceList> object that represents all of the locks we've created using THIS dav client.
 1919 
 1920   print "pwd: " . $d->get_workingurl . "\n";
 1921 
 1922 =item B<get_absolute_uri(REL_URI,[BASE_URI])>
 1923 
 1924 This is a useful utility function which joins C<BASE_URI> and C<REL_URI> and returns a new URI.
 1925 
 1926 If C<BASE_URI> is not supplied then the current working resource (as indicated by get_workingurl) is used. If C<BASE_URI> is not set and there is no current working resource the C<REL_URI> will be returned.
 1927 
 1928 For instance:
 1929  $d->open("http://host.org/webdav/dir1/");
 1930 
 1931  # Returns "http://host.org/webdav/dir2/"
 1932  $d->get_absolute_uri(-rel_uri=>"../dir2");
 1933 
 1934  # Returns "http://x.org/dav/dir2/file.txt"
 1935  $d->get_absolute_uri(-rel_uri  =>"dir2/file.txt",
 1936                       ->base_uri=>"http://x.org/dav/");
 1937 
 1938 Note that it subtly takes care of trailing slashes.
 1939 
 1940 =back
 1941 
 1942 =head2 ERROR HANDLING METHODS
 1943 
 1944 =over 4
 1945 
 1946 =item B<message>
 1947 
 1948 C<message> gets the last success or error message.
 1949 
 1950 The return value is always a scalar (string) and will change everytime a dav operation is invoked (lock, cwd, put, etc).
 1951 
 1952 See also C<errors> for operations which contain multiple error messages.
 1953 
 1954 =item B<errors>
 1955 
 1956 Returns an @array of error messages that had been set during a multi-request operation.
 1957 
 1958 Some of C<HTTP::DAV>'s operations perform multiple request to the server. At the time of writing only put and get are considered multi-request since they can operate recursively requiring many HTTP requests. 
 1959 
 1960 In these situations you should check the errors array if to determine if any of the requests failed.
 1961 
 1962 The C<errors> function is used for multi-request operations and not to be confused with a multi-status server response. A multi-status server response is when the server responds with multiple error messages for a SINGLE request. To deal with multi-status responses, see C<HTTP::DAV::Response>.
 1963 
 1964  # Recursive put
 1965  if (!$d->put( "/tmp/my_dir", $url ) ) {
 1966     # Get the overall message
 1967     print $d->message;
 1968     # Get the individual messages
 1969     foreach $err ( $d->errors ) { print "  Error:$err\n" }
 1970  }
 1971 
 1972 =item B<is_success>
 1973 
 1974 Returns the status of the last DAV operation performed through the HTTP::DAV interface.
 1975 
 1976 This value will always be the same as the value returned from an HTTP::DAV::method. For instance:
 1977 
 1978   # This will always evaluate to true
 1979   ($d->lock($url) eq $d->is_success) ?
 1980 
 1981 You may want to use the is_success method if you didn't capture the return value immediately. But in most circumstances you're better off just evaluating as follows:
 1982   if($d->lock($url)) { ... }
 1983 
 1984 =item B<get_last_response>
 1985 
 1986 Takes no arguments and returns the last seen C<HTTP::DAV::Response> object. 
 1987 
 1988 You may want to use this if you have just called a propfind and need the individual error messages returned in a MultiStatus.
 1989 
 1990 If you find that you're using get_last_response() method a lot, you may be better off using the more advanced C<HTTP::DAV> interface and interacting with the HTTP::DAV::* interfaces directly as discussed in the intro. For instance, if you find that you're always wanting a detailed understanding of the server's response headers or messages, then you're probably better off using the C<HTTP::DAV::Resource> methods and interpreting the C<HTTP::DAV::Response> directly.
 1991 
 1992 To perform detailed analysis of the server's response (if for instance you got back a multistatus response) you can call C<get_last_response()> which will return to you the most recent response object (always the result of the last operation, PUT, PROPFIND, etc). With the returned HTTP::DAV::Response object you can handle multi-status responses.
 1993 
 1994 For example:
 1995 
 1996    # Print all of the messages in a multistatus response
 1997    if (! $d->unlock($url) ) {
 1998       $response = $d->get_last_response();
 1999       if ($response->is_multistatus() ) {
 2000         foreach $num ( 0 .. $response->response_count() ) {
 2001            ($err_code,$mesg,$url,$desc) =
 2002               $response->response_bynum($num);
 2003            print "$mesg ($err_code) for $url\n";
 2004         }
 2005       }
 2006    }
 2007 
 2008 =back
 2009 
 2010 =head2 ADVANCED METHODS
 2011 
 2012 =over 4
 2013 
 2014 =item B<new_resource>
 2015 
 2016 Creates a new resource object with which to play.
 2017 This is the preferred way of creating an C<HTTP::DAV::Resource> object if required.
 2018 Why? Because each Resource object needs to sit within a global HTTP::DAV client. 
 2019 Also, because the new_resource routine checks the C<HTTP::DAV> locked resource
 2020 list before creating a new object.
 2021 
 2022     $dav->new_resource( -uri => "http://..." );
 2023 
 2024 =item B<set_workingresource(URL)>
 2025 
 2026 Sets the current working resource to URL.
 2027 
 2028 You shouldn't need this method. Call open or cwd to set the working resource.
 2029 
 2030 You CAN call C<set_workingresource()> but you will need to perform a
 2031 C<propfind> immediately following it to ensure that the working
 2032 resource is valid.
 2033 
 2034 =back
 2035 
 2036 =head1 INSTALLATION, TODO, MAILING LISTS and REVISION HISTORY
 2037 
 2038 [OUTDATED]
 2039 
 2040 Please see the primary HTTP::DAV webpage at
 2041 (http://www.webdav.org/perldav/http-dav/)
 2042 or the README file in this library.
 2043 
 2044 =head1 SEE ALSO
 2045 
 2046 You'll want to also read:
 2047 
 2048 =over
 2049 
 2050 =item C<HTTP::DAV::Response>
 2051 
 2052 =item C<HTTP::DAV::Resource>
 2053 
 2054 =item C<dave>
 2055 
 2056 =back
 2057 
 2058 and maybe if you're more inquisitive:
 2059 
 2060 =over
 2061 
 2062 =item C<LWP::UserAgent>
 2063 
 2064 =item C<HTTP::Request>
 2065 
 2066 =item C<HTTP::DAV::Comms>
 2067 
 2068 =item C<HTTP::DAV::Lock>
 2069 
 2070 =item C<HTTP::DAV::ResourceList>
 2071 
 2072 =item C<HTTP::DAV::Utils>
 2073 
 2074 =back
 2075 
 2076 =head1 AUTHOR AND COPYRIGHT
 2077 
 2078 This module is Copyright (C) 2001-2008 by
 2079 
 2080     Patrick Collins
 2081     G03 Gloucester Place, Kensington
 2082     Sydney, Australia
 2083 
 2084     Email: pcollins@cpan.org
 2085     Phone: +61 2 9663 4916
 2086 
 2087 All rights reserved.
 2088 
 2089 Current co-maintainer of the module is Cosimo Streppone
 2090 for Opera Software ASA, L<opera@cpan.org>.
 2091 
 2092 You may distribute this module under the terms of either the
 2093 GNU General Public License or the Artistic License,
 2094 as specified in the Perl README file.
 2095 
 2096 =cut