Example code from Perl for System Administration by David N. Blank-Edelman
O'Reilly and Associates, 1st Edition, ISBN 1-56592-609-9

Chapter Six
===========

#*
#* querying a finger server using Net::Telnet
#*
use Net::Telnet;

($username,$host) = split(/\@/,$ARGV[0]);
$host = $host ? $host : 'localhost';

# create a new connection
$cn = new Net::Telnet(Host => $host,
                      Port => 'finger');

# send the username down this connection
unless ($cn->print("$username")){ # could be "/W $username"
    $cn->close;              
    die "Unable to send finger string: ".$cn->errmg."\n";
}

# grab all of the data we receive, stopping when the 
# connection is dropped
while (defined $ret = $cn->get) {
    $data .= $ret;
}

# close the connection
$cn->close;                  

# display the data we collected
print $data;
-------
#*
#* querying a daytime server using Net::Telnet
#*

use Net::Telnet;

$host = $ARGV[0] ? $ARGV[0] : 'localhost';

$cn = new Net::Telnet(Host => $host, 
                       Port => 'daytime');

while (defined $ret = $cn->get) {
    $data .= $ret;
}
$cn->close;                  

print $data;
-------
#*
#* querying a finger server using Net::Finger
#*

use Net::Finger;

# finger() takes a user@host string and returns the data received
print finger($ARGV[0]); 
-------
#*
#* querying a finger server by calling the finger executable
#*

($username,$host) = split('@',$ARGV[0]);
$host = $host ? $host : 'localhost';

# location of finger executable, Mac OS users can't use this method
$fingerex = ($^O eq "MSWin32") ? $ENV{'SYSTEMROOT'}."\\System32\\finger" :
  		  "/usr/ucb/finger";  # (could also be /usr/bin/finger)

print `$fingerex ${username}\@${host}`;
-------
#*
#* querying the InterNIC WHOIS server
#*

use Net::Whois;

# query server, returning an object with results
my $w = new Net::Whois::Domain $ARGV[0] or 
   die "Can't connect to Whois server\n";
die "No domain information found for $ARGV[0]\n" unless ($w->ok);

# print out parts of that object
print "Domain: ", $w->domain, "\n";
print "Name: ", $w->name, "\n";
print "Tag: ", $w->tag, "\n";
print "Address:\n", map { "    $_\n" } $w->address;
print "Country: ", $w->country, "\n";
print "Record created: ".$w->record_created."\n";
print "Record updated: ".$w->record_updated."\n";

# print out name servers ($w->servers returns a list of lists)
print "Name Servers:\n", map { "    $$_[0] ($$_[1])\n" } @{$w->servers};

# print out contact list ($w->contacts returns a hash of lists)
my($c,$t);
if ($c = $w->contacts) {
    print "Contacts:\n";
    for $t (sort keys %$c) {
        print "    $t:\n";
        print map { "\t$_\n" } @{$$c{$t}};
    }
}
-------
#*
#* two ways to set up the initial connection to an LDAP server
#*

use Mozilla::LDAP::Conn;
# use empty $binddn and $passwd for anonymous bind
$c = new Mozilla::LDAP::Conn($server, $port, $binddn, $passwd); 
die "Unable to connect to $server" unless $c;
# ...
$c->close();

### OR ####

use Net::LDAP;
$c = Net::LDAP->new($server, port => $port) or 
    die "Unable to connect to $server: $@\n";
# use no parameters to bind() for anonymous bind
$c->bind($binddn, password => $passwd) or die "Unable to bind: $@\n"; 
# ...
$c->unbind();
-------
#*
#* two ways to search in LDAP
#*

use Mozilla::LDAP::Conn;
# <bind step here>
$entry = $c->search($basedn, $scope, $filter);
die "Bad search: ". $c->getErrorString()."\n" if $c->getErrorCode();

### OR ####

use Net::LDAP;
# <bind step here>
$searchobj = $c->search(base => $basedn, scope => $scope,filter => $filter); 
die "Bad search, errorcode #".$searchobj->code() if $searchobj->code();
-------
#*
#* two examples that take an LDAP server and send a query to them
#* example usage: 
#*      ldapsrch ldap.bigfoot.com '(sn=Pooh)'
#*

use Mozilla::LDAP::Conn;

$server = $ARGV[0];
$port   = getservbyname("ldap","tcp") || "389";
$basedn = "c=US";
$scope  = "sub";  

$c = new Mozilla::LDAP::Conn($server, $port, "", ""); # anonymous bind
die "Unable to bind to $server\n" unless $c; 

$entry = $c->search($basedn, $scope, $ARGV[1]);
die "Error in search: ". $c->getErrorString()."\n" if $c->getErrorCode();

# process the return values from search()
while ($entry) {
    $entry->printLDIF();
    $entry = $c->nextEntry();
}
$c->close();

### OR ####

use Net::LDAP;
use Net::LDAP::LDIF;

$server = $ARGV[0];
$port   = getservbyname("ldap","tcp") || "389";
$basedn = "c=US";
$scope  = "sub";

$c = new Net::LDAP($server, port=>$port) or 
    die "Unable to connect to $server: $@\n";
$c->bind() or die "Unable to bind: $@\n"; # anonymous bind

$searchobj = $c->search(base => $basedn, scope => $scope, 
                        filter => $ARGV[1]);
die "Bad search, errorcode #".$searchobj->code() if $searchobj->code();

# process the return values from search()
if ($searchobj){
    $ldif = new Net::LDAP::LDIF("-");
    $ldif->write($searchobj->entries());
    $ldif->done();
}
-------
#*
#*  writing LDIF using Mozilla::LDAP
#*

use Mozilla::LDAP::Conn;
use Mozilla::LDAP::LDIF;

# <perform bind & search>

open(LDIF,">$LDIFfile") or die "Unable to write to $LDIFfile:$!\n";
# create new LDIF object and pass in destination filehandle
$ldif = new Mozilla::LDAP::LDIF(\*LDIF); 

while ($entry) {
    $ldif->writeOneEntry($entry);
    $entry = $c->nextEntry();
}

$c->close();
close(LDIF);
-------
#*
#* writing LDIF using Net::LDAP
#*

use Net::LDAP;
use Net::LDAP::LDIF;

$server = $ARGV[0];
$port   = getservbyname("ldap","tcp") || "389";
$basedn = "c=US";
$scope  = "sub";

$c = new Net::LDAP($server, port=>$port) or 
    die "Unable to connect to $server: $@\n";
$c->bind() or die "Unable to bind: $@\n"; # anonymous bind

$searchobj = $c->search(base => $basedn, scope => $scope, 
                        filter => $ARGV[1]);
die "Bad search, errorcode #".$searchobj->code() if $searchobj->code();

# process the return values from search()
if ($searchobj){
    $ldif = new Net::LDAP::LDIF($filename);
    $ldif->write($searchobj->entries());
    $ldif->done();
}
-------
#*
#* two ways to read LDIF and add the data to an LDAP server
#*

use Mozilla::LDAP::Conn;
use Mozilla::LDAP::LDIF;

$server   = $ARGV[0];
$LDIFfile = $ARGV[1];
$port     = getservbyname("ldap","tcp") || "389";
$rootdn   = "cn=Manager, ou=Systems, dc=ccs, dc=hogwarts, dc=edu";
$pw       = "secret";

# read in an LDIF file specified as the second argument 
# on the command line 
open(LDIF,"$LDIFfile") or die "Unable to open $LDIFfile:$!\n";
$ldif = new Mozilla::LDAP::LDIF(\*LDIF);

# parse all of the entries, store in @entries
@entries = $ldif->readEntries(); 
close(LDIF);

# non-anonymous bind
$c = new Mozilla::LDAP::Conn($server,$port,$rootdn,$pw); 
die "Unable to bind to $server\n" unless $c;

# iterate through our parsed entry list, attempting to add one at a time
for (@entries){
    $c->add($_); # add this entry to the directory
    warn "Error in add for ". $_->getDN().": ".$c->getErrorString()."\n"
      if $c->getErrorCode();
}
$c->close();

### OR ####

use Net::LDAP;
use Net::LDAP::LDIF;

$server   = $ARGV[0];
$LDIFfile = $ARGV[1];
$port     = getservbyname("ldap","tcp") or "389";
$rootdn   = "cn=Manager, ou=Systems, dc=ccs, dc=hogwarts, dc=edu";
$pw       = "secret";

# read in an LDIF file specified as the second argument on the command line
# last parameter is "r" for open for read, "w" for write
# Note: these lines could be combined into:
#    @entries = new Net::LDAP::LDIF($LDIFfile,"r")->read;
$ldif = new Net::LDAP::LDIF($LDIFfile,"r"); 
@entries = $ldif->read();

$c = new Net::LDAP($server, port => $port) or 
    die "Unable to connect to $server: $@\n";
$c->bind(dn => $rootdn, password => $pw) or die "Error in bind: $@\n";

for (@entries){
    $res = $c->add($_);
    warn "Error in add for ". $_->dn().": error code ".$res->code."\n"
      if $res->code();
}

$c->unbind();
-------
#*
#* adding an entry to a server using standard LDAP operations in Mozilla::LDAP
#*

use Mozilla::LDAP::Conn;

$server   = $ARGV[0];
$port     = getservbyname("ldap","tcp") || "389";
$suffix   = "ou=People, ou=Systems, dc=ccs, dc=hogwarts, dc=edu";
$rootdn   = "cn=Manager, ou=Systems, dc=ccs, dc=hogwarts, dc=edu";
$pw       = "secret";

# non-anonymous bind 
$c = new Mozilla::LDAP::Conn($server, $port, $rootdn, $pw); 
die "Unable to bind to $server\n" unless $c;

$e = new Mozilla::LDAP::Entry;
# DN is uid plus a suffix detailing where to put this 
# in the directory tree
$e->setDN("uid=$ARGV[1],$suffix"); 
$e->addValue('uid', $ARGV[1]);
$e->addValue('cn', $ARGV[2]);
$c->add($e);
die "Error in add: ". $c->getErrorString()."\n" if $c->getErrorCode();
-------
#*
#* example snippet for adding an entry to a server using Net::LDAP
#*

use Net::LDAP;
$res = $c->add(
     dn   => 'uid=jay, ou=systems, ou=people, dc=ccs, dc=hogwarts, dc=edu',
     attr => [ 'cn'   => 'Jay Sekora',
	       'sn    => 'Sekora',
               'mail' => 'jayguy@ccs.hogwarts.edu',
               'title'=> ['Sysadmin','Part-time Lecturer'],
               'uid'  => 'jayguy',
             ]
             );
die "unable to add, errorcode #".$res->code() if $res->code();
-------
#*
#* two ways to delete entries
#*

use Mozilla::LDAP::Conn;
# <bind step here>
# if you have an entry in hand, you can use 
# $c->delete($entry->getDN()) instead
$c->delete($dn) or 
    die "unable to delete entry: ". $c->getErrorString()."\n";

### OR ###

use Net::LDAP;
# <bind step here>
$res = $c->delete($dn);
die "unable to delete, errorcode #".$res->code() if $res->code();
-------
#*
#* three ways to rename entries in LDAP
#*

use Mozilla::LDAP::Conn;
# <bind step here>
$c->modifyRDN($newRDN, $oldDN, $delold) or
    die "unable to rename entry:". $c->getErrorString()."\n";

### OR ###

use Net::LDAP;
# <bind step here>
$res = $c->moddn($oldDN, 
                 newrdn       => $newRDN, 
                 deleteoldrdn => 1);
die "unable to rename, errorcode #".$res->code() if $res->code();

### OR ###

# using enhanced version of moddn()
use Net::LDAP;
# <bind step here>
$result = $c->moddn($oldDN, 
                    newrdn       => $newRDN,
                    deleteoldrdn => 1, 
                    newsuperior  => $parentDN);
die "unable to rename, errorcode #".$res->code() if $res->code();
-------
#*
#* two ways to replace location attributes for all Boston personnel
#*

use Mozilla::LDAP::Conn;

$server = $ARGV[0];
$port   = getservbyname("ldap","tcp") || "389";
$basedn = "dc=ccs,dc=hogwarts,dc=edu";
$scope  = "sub";
$rootdn = "cn=Manager, ou=Systems, dc=ccs, dc=hogwarts, dc=edu";
$pw     = "secret";

# non-anonymous bind 
$c = new Mozilla::LDAP::Conn($server, $port, $rootdn, $pw); 
die "Unable to bind to $server\n" unless $c;

# notice that we ask for the least amount of info 
# possible for a speedy search
$entry = $c->search($basedn, $scope, "(l=Boston)", 1, '');
die "Error in search:". $c->getErrorString()."\n" if $c->getErrorCode();

if ($entry){
    while($entry){
        $entry->removeValue("l","Boston");
        $entry->addValue("l","Indiana");
        $c->update($entry);
        die "Error in update:" . $c->getErrorString() . "\n" 
          if $c->getErrorCode();
        $entry = $c->nextEntry();
    };
}
$c->close();

### OR ###

use Net::LDAP;

$server   = $ARGV[0];
$port     = getservbyname("ldap","tcp") || "389";
$basedn   = "dc=ccs,dc=hogwarts,dc=edu";
$scope    = "sub";
$rootdn   = "cn=Manager, ou=Systems, dc=ccs, dc=hogwarts, dc=edu";
$pw       = "secret";

$c = new Net::LDAP($server,port => $port) or
  die "Unable to init for $server: $@\n";
$c->bind(dn => $rootdn, password => $pw) or die "Error in bind: $@\n";

$searchobj = $c->search(base  => $basedn, filter => "(l=Boston)",
                        scope => $scope,  attrs  => [''], 
                        typesonly => 1);
die "Error in search: ".$searchobj->error()."\n" if ($searchobj->code());

if ($searchobj){
    @entries = $searchobj->entries;
    for (@entries){
        $res=$c->modify($_->dn(), # dn() yields the DN of that entry
                        delete => {"l" => "Boston"},
                        add    => {"l" => "Indiana"});
        die "unable to modify, errorcode #".$res->code() if $res->code();
    }
}

$c->unbind();
-------
#*
#* generate an LDIF file from our machine database
#*

$datafile = "database";
$recordsep = "-=-\n";
$suffix   = "ou=data, ou=systems, dc=ccs, dc=hogwarts, dc=edu";
$objectclass = <<EOC;
objectclass: top
objectclass: machine
EOC

open(DATA,$datafile) or die "unable to open $datafile:$!\n";

# Perl modules break with this, even if it is in the spec 
# print "version: 1\n"; # 

while (<DATA>) {
    # print the header for each entry
    if (/name:\s*(.*)/){ 
        print "dn: cn=$1, $suffix\n";
        print $objectclass;
        print "cn: $1\n";
        next;
    }
    # handle the multi-valued aliases attribute
    if (s/^aliases:\s*//){
        @aliases = split;
        foreach $name (@aliases){
            print "aliases: $name\n";
        }
        next;
    }
    # handle the end of record separator
    if ($_ eq $recordsep){
        print "\n";
        next;
    }
    # otherwise, just print the attribute as we found it
    print;
}