use Net::LDAP::LDIF;

$ldif = Net::LDAP::LDIF->new( \*STDOUT, 'w', change => $delete )
        or die $! if $ldif_to_standard_output;
$ldif = Net::LDAP::LDIF->new( $outfile_name, 'w', change => $delete )
        or die $! if $outfile_name;

sub finduid{
        my $minuid = 1000;
        my $maxuid = 60000;
        my $maxid = 1999;


        while (my ($name, $uid, $gid, $home) = (getpwent)[0,2,3,7]) {
                next unless $uid >= $minuid && $uid <= $maxuid;
                # Grab the uid
                my $tmpnum = $uid;

                $maxid = $tmpnum if $tmpnum > $maxid;
        }
        return $maxid + 1;
}

use constant STARTING_UID => 1999;

# $base is ou=People,ou=my_student_number,o=ICT
# Assume have bound with read access
sub get_next_uid($$) {
    my ( $ldap, $base ) = @_;
    my $entry;
    my $maxid = STARTING_UID;
    # Search all accounts
    my $mesg = $ldap->search( base => $base,
                               filter => '(objectclass=posixAccount)',
                               scope => 'one',
                               attrs => [ 'uidNumber' ],
                            );
    $mesg->code && die $mesg->error;
    foreach $entry ($mesg->entries) {
        my $tmpnum = $entry->get_value('uidnumber');
        if ($tmpnum > $maxid) {$maxid = $tmpnum;}
    }
    return $maxid + 1;
}

sub add_entry($$) {
    my ( $ldap, $entry ) = @_;
    my $mesg = $entry->update( $ldap );
    die "cannot add entry: ", $mesg->error if $mesg->code;
}

use Net::LDAP qw( LDAP_ALREADY_EXISTS );
sub add_entry($$) {
    my ( $ldap, $entry ) = @_;
    my $mesg = $entry->update( $ldap );
    if ( $mesg->code == LDAP_ALREADY_EXISTS ) {
        warn "The entry ", $entry->dn, " already is in the directory\n";
        return;
    } elsif ( $mesg->code ) {
        die "cannot add entry: ", $mesg->error;
    }
    return 1;
}

use warnings;
use strict;
use Crypt::PasswdMD5;

our $clear_passwd = shift || 'a123456';

our $hashed_password = unix_md5_crypt $clear_passwd;
print "{crypt}$hashed_password\n";

use Term::ReadKey;
# See Recipe 15.10 in Perl Cookbook, 1st edition, page 529
sub read_password() {
    print STDERR "Password: ";
    ReadMode 'noecho';
    my $passwd = ReadLine 0;
    ReadMode 'restore';
    print STDERR "\n";
    chomp $passwd;
    return $passwd;
}

use constant MAXUID => 65000;
use constant MIN_UID => 2000;

# Search one level down from $base for $attribute
# with biggest value less than MAXUID
# Return this value plus 1 if found
# Return 0 if none found.
sub search_for_next_available($$$$) {
    my ( $ldap, $base, $filter, $attribute ) = @_;
    my $search = $ldap->search( 
                               base => $base,
                               scope => 'one',
                               filter => $filter,
                               attrs => [ $attribute ],
                              );
    die_on_error $search;
    my $max = -1;
    foreach my $e ( $search->entries ) {
        $max = $e->get_value( $attribute )
            if $e->get_value( $attribute ) > $max and
               $e->get_value( $attribute ) < MAXUID;
    }
    return $max + 1;
}

# Search for the next available uidNumber (!!!)
# $suffix will be the value 'ou=your_student_ID,o=ICT' in this assignment.
# Assumes you have already bound with permission to read the uidNumbers
sub search_for_next_available_uidNumber($$) {
    my ( $ldap, $suffix ) = @_;
    my $uid = search_for_next_available $ldap, "ou=People,$suffix",
        '(objectClass=posixAccount)', 'uidNumber';
    return $uid if $uid > MIN_UID;
    return MIN_UID;
}

sub search_for($$$$$$\@\@) {
    my ( $ldap, $filter, $base, $scope, $template,
         $subject, $attrs, $attachments ) = @_;
    my $mesg = $ldap->search(
                             base   => $base,
                             filter => $filter,
                             scope  => $scope,
                             attrs  => $attrs,
                            );

    if ( $mesg->code ) {
        warn $mesg->error;
        return;
    }

    foreach my $entry ( $mesg->entries ) {
        my %attr;
        foreach my $attr ( $entry->attributes ) {
            $attr{lc $attr} = $entry->get_value( $attr );
            # Want to truncate given names like Kim-man, Albert to Albert:
            if ( lc $attr eq 'givenname'
                 and index( $attr{lc $attr}, ',' ) > -1 ) {
                $attr{lc $attr} =~ s/.*,\s+([^,]+$)/$1/;
            }
        }
        while ( my ( $a, $v ) = each %attr ) {
            print "key=$a, value=$v.\n" if $debug;
        }
        send_email_to %attr, $template, $subject, @$attachments;
    }
}

our $filter        = DEFAULT_FILTER;
our $server        = ICT_LDAP_SERVER;
our $base          = ICT_DIR_BASE;
our $template_file = "email.templ";
our $scope         = DEFAULT_SCOPE;
our $read_uids     = 0;
our @attachments;

sub usage() {
    my $program = $0;
    $program =~ s!.*/(.*)!$1!;
    print <<USAGE;
usage: $program OPTIONS
OPTIONS:
   OPTION           DEFAULT
   --ldapserver=s   $server
   --base=s         $base
   --filter=s       $filter
   --limit=i        $limit
   --print!         $print
   --mail!          $send_email
   --verbose|debug! $debug
   --template=s     $template_file
   --scope=s        $scope
   --read-uids!     $read_uids
   --sender=s       $sender
   --bcc=s          $bcc
   --cc=s           $cc
   --sign!          $sign (Attach signature from $ENV{HOME}/.signature)
   --attach=s       @attachments

Some useful filters to copy and paste/edit:
(&(course=41300)(year=2)(|(classCode=X)(classCode=W)))
(&(course=41300)(year=3))
(&(course=41300)(year=3)(registrationDate=*-03))
(&(course=41300)(year=3)(registrationDate=*-03)(classCode=W))
(&(course=41300)(year=3)(registrationDate=*-03)(|(classCode=X)(classCode=W)))
(acType=STF*)

Format of the email template:
File is the text of an email, but tokens are replaced
if they occur, such as:
#CN#             => cn
#CLASSCODE#      => classcode
#GIVENNAME#      => givenname
#SN#             => sn
#INSTITUTEEMAIL# => instituteEmail
#YEAR#           => year
#COURSE#         => course
Can use any LDAP attribute in upper case between a pair of hashes.
THE FIRST LINE IS THE SUBJECT.
USAGE
    exit 1;
}

GetOptions(
           'ldapserver=s'   => \$server,
           'base=s'         => \$base,
           'filter=s'       => \$filter,
           'limit=i'        => \$limit,
           'print!'         => \$print,
           'mail!'          => \$send_email,
           'verbose|debug!' => \$debug,
           'template=s'     => \$template_file,
           'scope=s'        => \$scope,
           'read-uids!'     => \$read_uids,
           'sender=s'       => \$sender,
           'bcc=s'          => \$bcc,
           'cc=s'           => \$cc,
           'sign!'          => \$sign,
           'attach=s'       => \@attachments,
           'help'           => \&usage,
          ) or usage;

our ( $subject, $template ) = read_template $template_file;
our @attrs = get_attributes $template;

our $ldap = Net::LDAP->new( $server ) or die "$@";
my $r = $ldap->bind;

if ( $read_uids ) {
    while ( <> ) {
        chomp;
        # remove comments, allow them anywhere:
        s/\s*#.*//;
        next unless length > 1;
        #my $thefilter = "(&$filter(uid=$_))";
        my $thefilter = "(uid=$_)";
        search_for $ldap, $thefilter, $base, $scope, $template, $subject,
            @attrs, @attachments;
    }
} else {
    search_for $ldap, $filter, $base, $scope, $template, $subject, @attrs,
        @attachments;
}

$ldap->unbind;

sub display_entry {
    my $entry = shift;
    my @attrs = $entry->attributes;

    foreach my $attr ( @attrs ) {
        my @value = $entry->get_value( $attr );

        foreach my $value ( @value ) {
            print "$attr: $value\n";
        }
    }
}

my $r = $ldap->add( $dn,
    attrs => [
        cn => 'HP5000-A204e',
        objectClass => [ qw/device ieee802Device/ ],
        description => 'Printer in A204e',
    ],
);

my $dn = 'ou=devices,dc=tyict,dc=vtc,dc=edu,dc=hk';
my $entry = Net::LDAP::Entry->new;
$entry->dn( $dn );
$entry->add( cn => 'HP5000-A204e' );
$entry->add(
    objectClass => 'device',
    description => 'Printer in A204e',
);
$mesg = $entry->update( $ldap );