#!/usr/bin/perl

use 5.010_000;
use strict;
use warnings;

our $VERSION = '0.01';

=head1 NAME

deleteExpiredEntries.pl - Clean the LDAP directory out of expired entries.

=head1 SYNOPSIS

B<deleteExpiredEntries.pl> [maximum age in seconds]

=cut


#######################################################################
#

use Pod::Usage;
use Config::Auto;
use lib 'lib';
use Fripost::Schema::Auth;
use POSIX 'strftime';

# TODO: put that in a config file
my $config = { ldap_bind_dn => [ 'cn=DeletePendingEntries','ou=services','o=mailHosting','dc=fripost,dc=dev' ]
             , ldap_uri => 'ldap://127.0.0.1:389/'
             , ldap_suffix => [ 'ou=virtual','o=mailHosting','dc=fripost,dc=dev' ]
             };

my $fp = Fripost::Schema::Auth->auth( undef, 'deletependingentries', %$config );


my $maxage = $ARGV[0] // 86400; # 24h by default
my $now = int(strftime "%s", gmtime);

my $maxdate = Net::LDAP::Util::escape_filter_value(
                  strftime ("%Y%m%d%H%M%SZ", localtime($now - $maxage))
              );
my $entries = $fp->ldap->search (
                  base => Fripost::Schema::Util::canonical_dn(@{$fp->suffix}),
                  scope => 'subtree',
                  deref => 'never',
                  filter => "(&(objectClass=FripostPendingEntry)
                               (createTimestamp<=$maxdate))",
                  attrs => [ '1.1' ],
                  callback => \&delete_entry
              );
die $entries->error."\n" if $entries->code;
$fp->done;

sub delete_entry {
    my ($mesg, $obj) = @_;
    if (defined $obj and $obj->isa('Net::LDAP::Entry')) {
        print STDERR "Deleting DN ".$obj->dn."\n";
        $obj->delete;
        my $mesg = $obj->update($fp->ldap);
        die $mesg->error."\n" if $mesg->code;
    }
    $mesg->pop_entry;
}


#######################################################################
#

=head1 AUTHOR

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

=head1 COPYRIGHT

Copyright 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