package Fripost::Schema::Pending;

=head1 NAME

Pending.pm - Manage pending entries

=head1 DESCRIPTION

This module abstracts the LDAP schema definition and provides methods to
unlock, list or delete pending entries.

=cut

use 5.010_000;
use strict;
use warnings;
use utf8;

use parent 'Fripost::Schema::Auth';
use Fripost::Schema::Util qw/ldap_error dn2mail ldap_and_filter/;
use POSIX 'strftime';


=head1 METHODS

=over 4

=item B<unlock> (I<name>, I<token>, I<OPTIONS>)

Unlock the pending I<name>, locked with I<token>. I<Token> may be left
undefined if I<name> is marked as pending, but is not locked.

=over 4

=item B<-dry-run> => 0|1

Merely simulate the unlock. I<token> is still checked to be a valid code
when defined.

=back

Errors can be caught with options B<-die> and B<-error>; See
B<Fripost::Schema::Util> for details.

=cut


sub unlock {
    my $self = shift;
    my $name = shift;
    my $token = shift;
    my %options = @_;

    # Nothing to do after an error.
    return if $options{'-error'} && ${$options{'-error'}};

    my $dn = $self->mail2dn( $name );
    my %delete = (objectClass => 'FripostPendingEntry');
    if ($token) {
        my $mesg = $self->ldap->compare( $dn
                                       , attr => 'fripostPendingToken'
                                       , value => $token );
        my $catch = { Net::LDAP::Constant::LDAP_COMPARE_TRUE => 0
                    , Net::LDAP::Constant::LDAP_COMPARE_FALSE =>
                        "Wrong unlock code for ‘".$name."’"
                    };
        ldap_error($mesg, %options, -die => $catch) // return;
        return 1 if $options{'-dry-run'};
        $delete{fripostPendingToken} = [];
    }

    my $mesg = $self->ldap->modify( $dn, delete => \%delete );
    ldap_error($mesg, %options);
}


=item B<find> (I<OPTIONS>)

List all pending entries.

=over 4

=item B<-delete> => 0|1

When set, delete all found entries.

=item B<-quiet> => 0|1

When set, do not print the list of found entries.

=item B<-max-age>

When set, limit found entries to those that were created before the
given date, in second since epoch.

=back

Errors can be caught with options B<-die> and B<-error>; See
B<Fripost::Schema::Util> for details.

=cut


sub find {
    my $self = shift;
    my %options = @_;

    # Nothing to do after an error.
    return if $options{'-error'} && ${$options{'-error'}};

    my @filter = 'objectClass=FripostPendingEntry';
    if ($options{'-max-age'}) {
        my $now = int(strftime "%s", gmtime);
        my $maxdate = Net::LDAP::Util::escape_filter_value(
                          strftime ("%Y%m%d%H%M%SZ",
                                    localtime($now - $options{'-max-age'}))
                      );
        push @filter, "createTimestamp<=$maxdate"
    }

    my $base = Fripost::Schema::Util::canonical_dn(@{$self->suffix});
    my $found = $self->ldap->search (
                    base => $base,
                    scope => 'subtree',
                    deref => 'never',
                    filter => ldap_and_filter (@filter),
                    attrs => [ '1.1' ],
                    (!$options{'-delete'} && $options{'-quiet'} ? () :
                      callback =>
                      sub {
                          my ($mesg, $obj) = @_;
                          if (defined $obj and $obj->isa('Net::LDAP::Entry')) {
                              print STDERR "Deleting DN ".$obj->dn."\n"
                                  unless $options{'-quiet'};
                              if ($options{'-delete'}) {
                                  $obj->delete;
                                  my $mesg = $obj->update($self->ldap);
                                  ldap_error($mesg, %options) // return;
                              }
                              $mesg->pop_entry;
                          }
                      })
                );
    ldap_error($found, %options);
}

=back

=head1 AUTHOR

Guilhem Moulin C<< <guilhem at fripost.org> >>

=head1 COPYRIGHT

Copyright 2012,2013 Guilhem Moulin.

=head1 LICENSE

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

=cut

1;

__END__