credentials results from the CPAN

HTTP-DAV

    return wantarray
        ? ($fh, $filename)
        : $filename;
}

######################################################################
# new_resource acts as a resource factory.
# It will create a new one for you each time you ask.
# Sometimes, if it holds state information about this
# URL, it may return an old populated object.
sub new_resource {
    my ($self) = shift;

    ####
    # This is the order of the arguments unless used as
    # named parameters
    my ($uri) = HTTP::DAV::Utils::rearrange( ['URI'], @_ );
    $uri = HTTP::DAV::Utils::make_uri($uri);

    #cluck "new_resource: now $uri\n";

    my $resource = $self->{_lockedresourcelist}->get_member($uri);
    if ($resource) {
        print
            "new_resource: For $uri, returning existing resource $resource\n"
            if $HTTP::DAV::DEBUG > 2;

        # Just reset the url to honour trailing slash status.
        $resource->set_uri($uri);
        return $resource;
    }
    else {
        print "new_resource: For $uri, creating new resource\n"
            if $HTTP::DAV::DEBUG > 2;
        return HTTP::DAV::Resource->new(
            -Comms              => $self->{_comms},
            -LockedResourceList => $self->{_lockedresourcelist},
            -uri                => $uri,
            -Client             => $self
        );
    }
}

###########################################################################
# ACCESSOR METHODS

# GET
sub get_user_agent      { $_[0]->{_comms}->get_user_agent(); }
sub get_last_request    { $_[0]->{_comms}->get_last_request(); }
sub get_last_response   { $_[0]->{_comms}->get_last_response(); }
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: ',
    'ERR_501'           => 'Server response: ',
    'ERR_405'           => 'Server response: ',
    'ERR_GENERIC'       => '',
);

sub err {
    my ( $self, $error, $mesg, $url ) = @_;

    my $err_msg;
    $err_msg = "";
    $err_msg .= $err{$error} if defined $err{$error};
    $err_msg .= $mesg if defined $mesg;
    $err_msg .= "ERROR" unless defined $err_msg;

    $self->{_message} = $err_msg;
    my $callback = $self->{_callback};
    &$callback( 0, $err_msg, $url ) if $callback;

    if ( $self->{_multi_op} ) {
        push( @{ $self->{_errors} }, $err_msg );
    }
    $self->{_status} = 0;

    return 0;
}

sub ok {
    my ($self, $mesg, $url, $so_far, $length) = @_;

    $self->{_message} = $mesg;

    my $callback = $self->{_callback};
    &$callback(1, $mesg, $url, $so_far, $length) if $callback;

    if ($self->{_multi_op}) {
        $self->{_status} = 1 unless $self->{_status} == 0;
    }
    else {
        $self->{_status} = 1;
    }
    return 1;
}

sub _start_multi_op {
    my ($self, $mesg, $callback) = @_;
    $self->{_multi_mesg} = $mesg || "";
    $self->{_status} = 1;
    $self->{_errors} = [];
    $self->{_multi_op} = 1;
    $self->{_callback} = $callback if defined $callback;

lib/HTTP/DAV.pm view on Meta::CPAN


    if (! $response->is_error()) {
        return { success => 1 }
    }

    my $error_type;
    my $error_msg;

    # Method not allowed
    if ($response->status_line =~ m{405}) {
        $error_type = 'ERR_405';
        $error_msg = $response->status_line;
    }
    # 501 most probably means your LWP doesn't support SSL
    elsif ($response->status_line =~ m{501}) {
        $error_type = 'ERR_501';
        $error_msg = $response->status_line;
    }
    elsif ($response->www_authenticate) {
        $error_type = 'ERR_UNAUTHORIZED';
        $error_msg  = $response->www_authenticate;
    }
    elsif ( !$resource->is_dav_compliant ) {
        $error_type = 'ERR_GENERIC';
        $error_msg = qq{The URL "$url" is not DAV enabled or not accessible.};
    }
    else {
        $error_type = 'ERR_RESP_FAIL';
        my $message = $response->message();
        $error_msg = qq{Could not access $url: $message};
    }

    return {
        success => 0,
        error_type => $error_type,
        error_msg => $error_msg,
    }

}

1;

__END__


=head1 NAME

HTTP::DAV - A WebDAV client library for Perl5

=head1 SYNOPSIS

   # 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
   $d->lock( -url => "$url/newdir", -timeout => "10m" ) 
      or die "Won't put unless I can lock for 10 minutes\n";

   # Make a new directory
   $d->mkcol( -url => "$url/newdir" )
      or die "Couldn't make newdir at $url\n";
  
   # Upload multiple files to newdir.
   if ( $d->put( -local => "/tmp/*.html", -url => $url ) ) {
      print "successfully uploaded multiple files to $url\n";
   } else {
      print "put failed: " . $d->message . "\n";
   }
  
   $d->unlock( -url => $url );

=head1 DESCRIPTION

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.

HTTP::DAV is part of the PerlDAV project hosted at http://www.webdav.org/perldav/ and has the following features:

=over 4

=item *

Full RFC2518 method support. OPTIONS, TRACE, GET, HEAD, DELETE, PUT, COPY, MOVE, PROPFIND, PROPPATCH, LOCK, UNLOCK.

=item *

A fully object-oriented API.

=item *

Recursive GET and PUT for site backups and other scripted transfers.

=item *

Transparent lock handling when performing LOCK/COPY/UNLOCK sequences.

=item *

http and https support (https requires the Crypt::SSLeay library). See INSTALLATION.

=item *

Basic AND Digest authentication support (Digest auth requires the MD5 library). See INSTALLATION.

=item *

lib/HTTP/DAV.pm view on Meta::CPAN

Example globs:

   $dav1->delete(-url=>"/my_dir/file[1-3]");     # Matches file1, file2, file3
   $dav1->delete(-url=>"/my_dir/file[1-3]*.txt");# Matches file1*.txt,file2*.txt,file3*.txt
   $dav1->delete(-url=>"/my_dir/*/file.txt");    # Invalid. Can only match at leaf-level

=item * CALLBACKS

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.

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.

Example callback:

   $d->get( -url=>$url, -to=>$to, -callback=>\&mycallback );

Your callback function MUST accept arguments as follows:
   sub cat_callback {
      my($status,$mesg,$url,$so_far,$length,$data) = @_;
      ...
   }

The C<status> argument specifies whether the operation has succeeded (1), failed (0), or is in progress (-1).

The C<mesg> argument is a status message. The status message could contain any string and often contains useful error messages or success messages. 

The C<url> the remote URL.

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. 

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>.

See the source code of C<dave> for a useful sample of how to setup a callback.

Note that these arguments are NOT named parameters.

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.

=back

=head2 PUBLIC METHODS

=over 4

=item B<new(USERAGENT)>

=item B<new(USERAGENT, HEADERS)>

Creates a new C<HTTP::DAV> client

 $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.

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.

=back

=head2 DAV OPERATIONS

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.

=over 4 

=item B<copy(URL,DEST,[OVERWRITE],[DEPTH])>

copies one remote resource to another

=over 4 

=item C<-url> 

is the remote resource you'd like to copy. Mandatory

=item C<-dest> 

is the remote target for the copy command. Mandatory

=item C<-overwrite> 

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.

=item C<-depth> 

optionally indicates whether the server should do a recursive copy or not. Valid values are 0 and (1 or "infinity"). Default is "infinity" (1).

=back

The return value is always 1 or 0 indicating success or failure.

Requires a working resource to be set before being called. See C<open>.

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.

B<copy examples:>

  $d->open(-url=>"host.org/dav_dir/");

Recursively copy dir1/ to dir2/

  $d->copy(-url=>"dir1/", -dest=>"dir2/");

Non-recursively and non-forcefully copy dir1/ to dir2/

( run in 1.048 second using v1.01-cache-2.11-cpan-39bf76dae61 )