File Coverage

blib/lib/Net/LDAP/Batch.pm

Criterion	Covered	Total	%
statement	69	96	71.8
branch	11	28	39.2
condition	3	12	25.0
subroutine	14	16	87.5
pod	6	6	100.0
total	103	158	65.1

package Net::LDAP::Batch;
use strict;
use warnings;
use Carp;
use Data::Dump qw( dump );
use base qw( Class::Accessor::Fast );
__PACKAGE__->mk_accessors(qw( ldap debug ));
__PACKAGE__->mk_ro_accessors(qw( actions error ));
use Net::LDAP::Batch::Action::Add;
use Net::LDAP::Batch::Action::Update;
use Net::LDAP::Batch::Action::Delete;
use Scalar::Util qw( blessed );

our $VERSION = '0.02';

=head1 NAME

Net::LDAP::Batch - perform a batch of LDAP actions

=head1 SYNOPSIS

 use Net::LDAP::Batch;

 my $BaseDN = 'ou=People,dc=MyDomain';
 my $ldap   = make_and_bind_Net_LDAP_object();  # you write this

 my $batch = Net::LDAP::Batch->new( ldap => $ldap );
 $batch->add_actions(
    add => [
        {
            dn      => "cn=MyGroup,ou=Group,$BaseDN",
            attr    => [
                objectClass => [ 'top', 'posixGroup' ],
                cn          => 'MyGroup',
                gidNumber   => '1234'
            ]
        }
    ],
    delete => [
        {
            search  => [
                base    => "ou=Group,$BaseDN",
                scope   => 'sub',
                filter  => "(cn=MyOldGroup)"
            ]
        }
    ],
    update => [
        {
            search  => [
                base    => "ou=Group,$BaseDN",
                scope   => 'sub',
                filter  => "(cn=OtherGroup)"
            ],
            replace => { gidNumber => '5678' },
            delete  => { foo => [ 'bar' ] },
        }
    ]
 );

 $batch->do or die $batch->error;

=head1 DESCRIPTION

Net::LDAP::Batch performs a series of actions against a LDAP
server. If any of the actions fails, then all the actions in the batch
are reverted.

B This is not a true ACID-compliant transaction feature,
since no locking is performed. Instead it is simply a way to execute
a series of actions without having to worry about checking return values, or
error codes, or un-doing the changes should any of them fail. Of course,
since no ACID compliance is claimed, anything could (and likely will)
happen if there is more than one client attempting to make changes
on the same server at the same time. B

=head1 METHODS

=head2 new

Create a batch instance.

You must pass in a valid Net::LDAP object that has
already been bound to the server with whatever credentials are necessary
to complete the actions you will specify.

You may optionally pass in an array ref of actions. See also the add_actions()
method.

=cut

sub new {
    my $class = shift;
    my $opts  = ref( $_[0] ) ? $_[0] : {@_};
    my $self  = $class->SUPER::new($opts);
    $self->_setup;
    return $self;
}

sub _setup {
    my $self = shift;
    if ( $self->{actions} ) {
        my $actions = $self->clear_actions;
        $self->add_actions($actions);
    }
    $self->debug( $ENV{PERL_DEBUG} ) unless defined $self->debug;
}

=head2 actions

Get the array ref of Net::LDAP::Batch::Action objects in the batch.
To set the array, use add_actions().

=head2 add_actions( I )

Set the array of actions to be executed. I may be either
an array or array ref, and may either be key/value pairs as in
the SYNOPSIS or Net::LDAP::Batch::Action objects. You may not mix
the two types of values.

Returns the total number of actions in batch.

=cut

my %action_classes = (
    'add'    => 'Net::LDAP::Batch::Action::Add',
    'update' => 'Net::LDAP::Batch::Action::Update',
    'delete' => 'Net::LDAP::Batch::Action::Delete',
);

sub add_actions {
    my $self = shift;
    my @arg;
    if ( @_ == 1 && ref( $_[0] ) eq 'ARRAY' ) {
        @arg = @{ $_[0] };
    }
    else {
        @arg = @_;
    }

    if ( blessed( $arg[0] ) && $arg[0]->isa('Net::LDAP::Batch::Action') ) {
        push( @{ $self->{actions} }, @arg );
    }
    else {
        if ( @arg % 2 ) {
            croak "uneven number of action key/value pairs";
        }
        while ( scalar(@arg) ) {
            my $what = shift(@arg);
            my $todo = shift(@arg);
            if ( !exists $action_classes{$what} ) {
                croak "unsupported action: $what";
            }
            my $class = $action_classes{$what};
            my @todo;
            if ( ref($todo) eq 'ARRAY' ) {
                @todo = @$todo;
            }
            else {
                @todo = ($todo);
            }
            for my $params (@todo) {
                $params->{ldap}  = $self->ldap;
                $params->{debug} = $self->debug;
                push( @{ $self->{actions} }, $class->new($params) );
            }
        }
    }
    return scalar( @{ $self->{actions} } );
}

=head2 clear_actions

Sets the number of actions to zero. Returns the former contents
of actions().

=cut

sub clear_actions {
    my $self    = shift;
    my $actions = $self->{actions};
    $self->{actions} = [];
    return $actions;
}

=head2 do

Perform the actions and rollback() if any are fatal. Same thing as calling:

 eval { $batch->execute };
 if ($@) {
     warn "batch failed: $@";
     $batch->rollback;  # could be fatal
 }

The code above is nearly verbatim what do() actually does.

=cut

sub do {
    my $self = shift;
    eval { $self->execute };
    if ($@) {
        $self->{error} = $@;
        $self->rollback;
        return 0;
    }
    return 1;
}

=head2 execute

Calls execute() method on each action.

=cut

sub execute {
    my $self = shift;
    if ( !$self->actions or !scalar( @{ $self->actions } ) ) {
        croak "no actions to execute";
    }
    for my $action ( @{ $self->actions } ) {
        warn "executing $action\n" if $self->debug;
        $action->execute;
    }
    return 1;
}

=head2 rollback

Calls rollback() method on each action.

=cut

sub rollback {
    my $self = shift;
    if ( !$self->actions or !scalar( @{ $self->actions } ) ) {
        croak "no actions to rollback";
    }
    for my $action ( reverse @{ $self->actions } ) {
        next unless $action->complete;
        warn "rolling back $action\n" if $self->debug;
        $action->rollback;
    }
    return 1;
}

1;

__END__