File Coverage

blib/lib/Net/LDAP/Batch/Action/Delete.pm

Criterion	Covered	Total	%
statement	31	46	67.3
branch	6	20	30.0
condition	1	3	33.3
subroutine	6	7	85.7
pod	3	3	100.0
total	47	79	59.4

package Net::LDAP::Batch::Action::Delete;
use strict;
use warnings;
use Carp;
use base qw( Net::LDAP::Batch::Action );

our $VERSION = '0.02';

__PACKAGE__->mk_accessors(qw( search ));

=head1 NAME

Net::LDAP::Batch::Action::Delete - delete entry from LDAP server

=head1 SYNOPSIS

 use Net::LDAP::Batch::Action::Delete;
 my $action = Net::LDAP::Batch::Action::Delete->new(
            {
                ldap => $net_ldap_object,
                search => [
                        base    => 'name=foo,dc=company,dc=com'
                        scope   => 'base'
                        ],
            });
 $action->execute or $action->rollback;


=head1 DESCRIPTION

Deletes an entry from a LDAP server, restoring it on failure of any kind.

=head1 METHODS

=head2 init

Override base method to check that search() param is set to an array ref.

=cut

sub init {
    my $self = shift;
    $self->SUPER::init(@_);
    if ( $self->search
        and ref( $self->search ) ne 'ARRAY' )
    {
        croak "search must be an ARRAY ref";
    }
    return $self;
}

=head2 execute

Perform the action. Will croak() if search() fails to match.

=cut

sub execute {
    my $self = shift;
    my $entry;
    if ( $self->entry ) {
        $entry = $self->entry;
    }
    else {

        my $search = $self->search or croak "search required";
        my $where = Data::Dump::dump($search);

        carp "deleting $where" if $self->debug;

        my $msg = $self->ldap->search(@$search);
        if ( $msg->count > 0 ) {
            $entry = $msg->entry(0);
        }
        else {

            # no match for search.
            # in SQL, this would just be a no-op, since WHERE failed.
            # but here we assume that caller expects the object to exist.
            croak "delete search failed to match $where:\n"
                . $self->get_ldap_err($msg);
        }

    }
    $self->entry( $entry->clone );
    $entry->delete;
    my $msg = $entry->update( $self->ldap );
    if ( $msg->code ) {
        croak "failed to delete entry: " . $self->get_ldap_err($msg);
    }

    $self->complete(1);
    return 1;
}

=head2 rollback

Revert the deletion by calling ldap->add for the original Net::LDAP::Entry
object.

=cut

sub rollback {
    my $self = shift;
    return 0 unless $self->complete;

    if ( !$self->entry ) {
        croak "cannot rollback deleted entry - no entry cached";
    }

    carp "rolling back delete" if $self->debug;

    my $entry = $self->entry;
    my $msg   = $self->ldap->add($entry);
    if ( $msg->code ) {
        croak "failed to rollback deletion of entry: "
            . $self->get_ldap_err($msg);
    }

    $self->complete(0);
    return 1;
}

1;

__END__