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<Be advised:> 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<You have been warned.>

=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<actions> )

Set the array of actions to be executed. I<actions> 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__

=head1 AUTHOR

Peter Karman, C<< <karman at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-net-ldap-batch at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-LDAP-Batch>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Net::LDAP::Batch

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Net-LDAP-Batch>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Net-LDAP-Batch>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-LDAP-Batch>

=item * Search CPAN

L<http://search.cpan.org/dist/Net-LDAP-Batch>

=back

=head1 ACKNOWLEDGEMENTS

The Minnesota Supercomputing Institute C<< http://www.msi.umn.edu/ >>
sponsored the development of this software.

=head1 COPYRIGHT

Copyright 2008 by the Regents of the University of Minnesota.
All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

Net::LDAP

=cut