Source

ldap2vcard / ldap2vcard.pl

Full commit
#!/usr/bin/perl
use warnings;
use strict;
use Net::LDAP;
use Text::vCard;
use Text::vCard::Addressbook;
use MIME::Base64;
use Unicode::String qw/utf8 latin1 utf16/;
use Getopt::Long;
use Imager;
use Pod::Usage;

use vars qw/$ldap $adrb $server $outfile $encoding $base/;

GetOptions('server|s=s' => \$server, 'encoding|e=s' => \$encoding,
	   'base|b=s' => \$base) or pod2usage(2);

$outfile = $ARGV[0]; $encoding = "utf16";

pod2usage(2) if (!defined $server || !defined $outfile || !defined $encoding);

$ldap = Net::LDAP->new($server) and $ldap->bind or die $@;
$adrb = Text::vCard::Addressbook->new() or die $@;

my $entries = $ldap->search
    ( 
      base => $base,
      scope => 'sub',
      filter => '(&(organizationalStatus=CURRENT)(objectClass=person)(objectClass=inetOrgPerson)(objectClass=posixAccount)(uid=*))' # Only current employees.
    );

$entries->code && die $entries->error;

my $count = 0;

foreach my $entry ($entries->entries) { 
    my $vcard = $adrb->add_vcard();

    # Name stuff.
    my $node = $vcard->add_node({ node_type => 'N' });
    $node->family($entry->get_value('sn'));
    $node->given($entry->get_value('givenName'));

    # Company
    $node = $vcard->add_node({ node_type => 'ORG' });
    $node->name($entry->get_value('o'));

    # Telephone
    $node = $vcard->add_node({ node_type => 'TEL' });
    $node->add_types('type=WORK');
    $node->value($entry->get_value('telephoneNumber'));
    
    $node = $vcard->add_node({ node_type => 'TEL' });
    $node->add_types('type=HOME');
    $node->value($entry->get_value('homePhone'));    

    $node = $vcard->add_node({ node_type => 'TEL' });
    $node->add_types('type=CELL');
    $node->value($entry->get_value('mobile'));    

    # Others
    $vcard->fullname($entry->get_value('cn'));
    if (defined $entry->get_value('operaShowBirthdate') && 
	$entry->get_value('operaShowBirthdate') eq "CHECKED") {
	$vcard->bday($entry->get_value('operaBirthdate'));
    }
    $vcard->title($entry->get_value('title'));
 
    $node = $vcard->add_node({ node_type => 'EMAIL' });
    my @types = ("type=INTERNET","type=WORK","type=pref");
    $node->add_types(\@types);
    $node->value($entry->get_value('mail'));
   
    # Photo
    $node = $vcard->add_node({ node_type => 'PHOTO;BASE64' });
    $node->value(&formatImage($entry->get_value('jpegPhoto')));

    $node = $vcard->add_node({ node_type => 'VERSION'});
    $node->value("3.0");

    $count++; 
}		    

# Write outputfile

open OUTFILE, ">$outfile" or die("Couldn't open outfile: $!");
my $vcf_file = $adrb->export;
$vcf_file =~ s/\r\n/\n/; # CRLF -> LF
print OUTFILE &encode($vcf_file."\n");
close OUTFILE;

print "Wrote $count cards to $outfile.\n";

$ldap->unbind;

sub formatImage {
    my($in) = @_;
    return $in if !defined $in;

    # Resize it.

    my $orgimg = Imager->new;
    $orgimg->read(data => $in) or warn($orgimg->errstr);

    if ($orgimg->getheight() > 240) {
	eval {
	    $orgimg = $orgimg->scale(ypixels => 300);
	    $orgimg->write(type => 'jpeg', data => \$in);
	} or warn("Rescaling failed");
    }

    # Base64 it.
    $in = encode_base64($in);
    $in =~ s/\n/\n  /g; # Indent all lines with 2 spaces.
    chop($in) foreach (1..3); # 3 characters in the end cause various clients to not recognize this format. Chop 'em off.
    return "\n  ".$in;
}

sub encode {
    my($string) = @_;
    $string = utf8($string);
    return $string->utf8 if ($encoding eq "utf8");
    return $string->latin1 if ($encoding eq "latin1");
    return $string->utf16;
}

__END__

=head1 NAME

ldap2vcard - exports an entire LDAP directory to a vCard file

=head1 ABOUT
    Exports LDAP-directory to a big vCard-file
    That's it.

=head1 COPYRIGHT
    Copyright (c) 2005-2006 Jesper Noehr <jesper@noehr.org>

=head1 SYNOPSIS

ldap2vcard [options] [file ...]

 Options:
   -server -s    the server to export from
   -base -b      the LDAPs base (e.g. dc=opera,dc=com)
   -encoding -e  the encoding to use (default is utf-16)
                 possible options: utf8, utf16, latin1