view release on metacpan or  search on metacpan

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

}

sub set_property { $_[0]->{_properties}{ $_[1] } = $_[2]; }

sub set_uri { $_[0]->{_uri} = HTTP::DAV::Utils::make_uri($_[1]); }

# PRIVATE SUBROUTINES
sub _set_content    { $_[0]->{_content}    = $_[1]; }
sub _set_options    { $_[0]->{_options}    = $_[1]; }
sub _set_compliance { $_[0]->{_compliance} = $_[1]; }

sub set_locks {
    my ($self, @locks) = @_;

    # Unset any existing locks because we're about to reset them
    # But keep their name temporarily because some of them
    # may be ours.
    my @old_lock_tokens = keys %{ $self->{_locks} } || ();

    #if (@locks && defined $self->{_locks}) {
    if (defined $self->{_locks}) {
        delete $self->{_locks};
    }

    foreach my $lock (@locks) {
        my $token = $lock->get_locktoken();

        #print "Adding $token\n";

        # If it exists, we'll set it to owned and reapply
        # it (it may have changed since we saw it last.
        # Like it might have timed out?
        if (grep($token, @old_lock_tokens)) {
            $lock->set_owned(1);
        }
        $self->{_locks}{$token} = $lock;
    }

    #print "Locks: " . join(' ',keys %{$self->{_locks}} )."\n";
}

sub is_option {
    my ($self, $option) = @_;
    $self->options if (!defined $self->{_options});
    return ($self->{_options} =~ /\b$option\b/i) ? 1 : 0;
}

sub is_dav_compliant {
    my $resp = $_[0]->options if (!defined $_[0]->{_options});
    $_[0]->{_compliance};
}

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}; }
sub get_uristring           { $_[0]->{_uri}->as_string; }
sub get_parent_resourcelist { $_[0]->{_parent_resourcelist}; }

# $self->get_locks( -owned => [0|1] );
#  '1'  = return any locks owned be me
#  '0'   = return any locks NOT owned be me
#  no value = return all locks
#
sub get_locks {
    my ($self, @p) = @_;
    my ($owned) = HTTP::DAV::Utils::rearrange(['OWNED'], @p);
    $owned = "" unless defined $owned;

    #print "owned=$owned,\@p=\"@p\"\n";

    my @return_locks = ();

    foreach my $token (sort keys %{ $self->{_locks} }) {
        my $lock = $self->{_locks}{$token};
        if ($owned eq "1" && $lock->is_owned) {
            push(@return_locks, $lock);
        }
        elsif ($owned eq "0" && !$lock->is_owned) {
            push(@return_locks, $lock);
        }
        elsif ($owned eq "") {
            push(@return_locks, $lock);
        }
    }

    return @return_locks;
}

sub get_lock {
    my ($self, $token) = @_;
    return $self->{_locks}{$token} if ($token);
}

# Just pass through to get_locks all of our parameters.
# Then count how many we get back. >1 lock returns 1.
sub is_locked {
    my ($self, @p) = @_;
    return scalar $self->get_locks(@p);
}

sub is_collection {
    my $type = $_[0]->get_property("resourcetype");
    return (defined $type && $type =~ /collection/) ? 1 : 0;
}