[Bps-public-commit] RT-Extension-LDAPImport branch, object-cf-values, created. 0.32_03-9-gbb7b893

Thomas Sibley trs at bestpractical.com
Tue Apr 24 17:25:04 EDT 2012


The branch, object-cf-values has been created
        at  bb7b893ffe39bc4627a3d54072eaf495d70e255a (commit)

- Log -----------------------------------------------------------------
commit 8034bf4264cc1459444bcc0ec065a37c4c116ca3
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Wed Apr 18 22:05:30 2012 -0400

    Minor cleanups of doc formatting and the case of $LDAPUser

diff --git a/README b/README
index e51860b..c5e1828 100644
--- a/README
+++ b/README
@@ -2,10 +2,10 @@ NAME
     RT::Extension::LDAPImport - Import Users from an LDAP store
 
 SYNOPSIS
-        # In RT_SiteConfig.pm
+    In "RT_SiteConfig.pm":
 
         Set($LDAPHost,'my.ldap.host')
-        Set($LDAPUSER,'me');
+        Set($LDAPUser,'me');
         Set($LDAPPassword,'mypass');
         Set($LDAPFilter, '(&(cn = users))');
         Set($LDAPMapping, {Name         => 'uid', # required
@@ -13,22 +13,24 @@ SYNOPSIS
                            RealName     => 'cn',
                            WorkPhone    => 'telephoneNumber',
                            Organization => 'departmentName'});
-
+    
         # Add to any existing plugins
         Set(@Plugins, qw(RT::Extension::LDAPImport));
-
+    
         # If you want to sync Groups RT <-> LDAP
-
+    
         Set($LDAPGroupBase, 'ou=Groups,o=Our Place');
         Set($LDAPGroupFilter, '(&(cn = Groups))');
         Set($LDAPGroupMapping, {Name               => 'cn',
                                 Member_Attr        => 'member',
                                 Member_Attr_Value  => 'dn' });
 
+    Running the import:
+
         # Run a test import
         /opt/rt4/local/plugins/RT-Extension-LDAPImport/bin/rtldapimport \
         --debug > ldapimport.debug 2>&1
-
+    
         # Run for real, possibly put in cron
         /opt/rt4/local/plugins/RT-Extension-LDAPImport/bin/rtldapimport \
         --import
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index 8636f31..5929677 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -20,10 +20,10 @@ RT::Extension::LDAPImport - Import Users from an LDAP store
 
 =head1 SYNOPSIS
 
-    # In RT_SiteConfig.pm
+In C<RT_SiteConfig.pm>:
 
     Set($LDAPHost,'my.ldap.host')
-    Set($LDAPUSER,'me');
+    Set($LDAPUser,'me');
     Set($LDAPPassword,'mypass');
     Set($LDAPFilter, '(&(cn = users))');
     Set($LDAPMapping, {Name         => 'uid', # required
@@ -31,22 +31,24 @@ RT::Extension::LDAPImport - Import Users from an LDAP store
                        RealName     => 'cn',
                        WorkPhone    => 'telephoneNumber',
                        Organization => 'departmentName'});
-
+    
     # Add to any existing plugins
     Set(@Plugins, qw(RT::Extension::LDAPImport));
-
+    
     # If you want to sync Groups RT <-> LDAP
-
+    
     Set($LDAPGroupBase, 'ou=Groups,o=Our Place');
     Set($LDAPGroupFilter, '(&(cn = Groups))');
     Set($LDAPGroupMapping, {Name               => 'cn',
                             Member_Attr        => 'member',
                             Member_Attr_Value  => 'dn' });
 
+Running the import:
+
     # Run a test import
     /opt/rt4/local/plugins/RT-Extension-LDAPImport/bin/rtldapimport \
     --debug > ldapimport.debug 2>&1
-
+    
     # Run for real, possibly put in cron
     /opt/rt4/local/plugins/RT-Extension-LDAPImport/bin/rtldapimport \
     --import

commit 05d216b4a690f8b08b573b012732166e820e2e8c
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Wed Apr 18 22:06:26 2012 -0400

    Update M::I

diff --git a/META.yml b/META.yml
index 682fee0..05a8e09 100644
--- a/META.yml
+++ b/META.yml
@@ -9,7 +9,7 @@ configure_requires:
   ExtUtils::MakeMaker: 6.36
 distribution_type: module
 dynamic_config: 1
-generated_by: 'Module::Install version 1.04'
+generated_by: 'Module::Install version 1.06'
 license: perl
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
index 3aabb10..aa7aa92 100644
--- a/inc/Module/AutoInstall.pm
+++ b/inc/Module/AutoInstall.pm
@@ -3,11 +3,12 @@ package Module::AutoInstall;
 
 use strict;
 use Cwd                 ();
+use File::Spec          ();
 use ExtUtils::MakeMaker ();
 
 use vars qw{$VERSION};
 BEGIN {
-	$VERSION = '1.04';
+	$VERSION = '1.06';
 }
 
 # special map on pre-defined feature sets
@@ -187,7 +188,7 @@ sub import {
             }
 
             # XXX: check for conflicts and uninstalls(!) them.
-            my $cur = _load($mod);
+            my $cur = _version_of($mod);
             if (_version_cmp ($cur, $arg) >= 0)
             {
                 print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
@@ -348,7 +349,7 @@ sub install {
     while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
 
         # grep out those already installed
-        if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+        if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
             push @installed, $pkg;
         }
         else {
@@ -357,8 +358,8 @@ sub install {
     }
 
     if ($UpgradeDeps) {
-	push @modules, @installed;
-	@installed = ();
+        push @modules, @installed;
+        @installed = ();
     }
 
     return @installed unless @modules;  # nothing to do
@@ -392,7 +393,7 @@ sub install {
 
     # see if we have successfully installed them
     while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
-        if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+        if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
             push @installed, $pkg;
         }
         elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
@@ -621,7 +622,7 @@ sub _update_to {
     my $ver   = shift;
 
     return
-      if _version_cmp( _load($class), $ver ) >= 0;  # no need to upgrade
+      if _version_cmp( _version_of($class), $ver ) >= 0;  # no need to upgrade
 
     if (
         _prompt( "==> A newer version of $class ($ver) is required. Install?",
@@ -706,16 +707,30 @@ sub _can_write {
 
 # load a module and return the version it reports
 sub _load {
-    my $mod  = pop;    # class/instance doesn't matter
+    my $mod  = pop; # method/function doesn't matter
     my $file = $mod;
-
     $file =~ s|::|/|g;
     $file .= '.pm';
-
     local $@;
     return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
 }
 
+# report version without loading a module
+sub _version_of {
+    my $mod = pop; # method/function doesn't matter
+    my $file = $mod;
+    $file =~ s|::|/|g;
+    $file .= '.pm';
+    foreach my $dir ( @INC ) {
+        next if ref $dir;
+        my $path = File::Spec->catfile($dir, $file);
+        next unless -e $path;
+        require ExtUtils::MM_Unix;
+        return ExtUtils::MM_Unix->parse_version($path);
+    }
+    return undef;
+}
+
 # Load CPAN.pm and it's configuration
 sub _load_cpan {
     return if $CPAN::VERSION and $CPAN::Config and not @_;
@@ -912,4 +927,4 @@ END_MAKE
 
 __END__
 
-#line 1178
+#line 1193
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index c685ca4..4ecf46b 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -31,7 +31,7 @@ BEGIN {
 	# This is not enforced yet, but will be some time in the next few
 	# releases once we can make sure it won't clash with custom
 	# Module::Install extensions.
-	$VERSION = '1.04';
+	$VERSION = '1.06';
 
 	# Storage for the pseudo-singleton
 	$MAIN    = undef;
@@ -467,4 +467,4 @@ sub _CLASS ($) {
 
 1;
 
-# Copyright 2008 - 2011 Adam Kennedy.
+# Copyright 2008 - 2012 Adam Kennedy.
diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
index f7f4283..6efe4fe 100644
--- a/inc/Module/Install/AutoInstall.pm
+++ b/inc/Module/Install/AutoInstall.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.04';
+	$VERSION = '1.06';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index b520616..802844a 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
 use strict 'vars';
 use vars qw{$VERSION};
 BEGIN {
-	$VERSION = '1.04';
+	$VERSION = '1.06';
 }
 
 # Suspend handler for "redefined" warnings
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index a162ad4..22167b8 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -3,13 +3,12 @@ package Module::Install::Can;
 
 use strict;
 use Config                ();
-use File::Spec            ();
 use ExtUtils::MakeMaker   ();
 use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.04';
+	$VERSION = '1.06';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -29,7 +28,7 @@ sub can_use {
 	eval { require $mod; $pkg->VERSION($ver || 0); 1 };
 }
 
-# check if we can run some command
+# Check if we can run some command
 sub can_run {
 	my ($self, $cmd) = @_;
 
@@ -38,14 +37,88 @@ sub can_run {
 
 	for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
 		next if $dir eq '';
-		my $abs = File::Spec->catfile($dir, $_[1]);
+		require File::Spec;
+		my $abs = File::Spec->catfile($dir, $cmd);
 		return $abs if (-x $abs or $abs = MM->maybe_command($abs));
 	}
 
 	return;
 }
 
-# can we locate a (the) C compiler
+# Can our C compiler environment build XS files
+sub can_xs {
+	my $self = shift;
+
+	# Ensure we have the CBuilder module
+	$self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
+
+	# Do we have the configure_requires checker?
+	local $@;
+	eval "require ExtUtils::CBuilder;";
+	if ( $@ ) {
+		# They don't obey configure_requires, so it is
+		# someone old and delicate. Try to avoid hurting
+		# them by falling back to an older simpler test.
+		return $self->can_cc();
+	}
+
+	# Do we have a working C compiler
+	my $builder = ExtUtils::CBuilder->new(
+		quiet => 1,
+	);
+	unless ( $builder->have_compiler ) {
+		# No working C compiler
+		return 0;
+	}
+
+	# Write a C file representative of what XS becomes
+	require File::Temp;
+	my ( $FH, $tmpfile ) = File::Temp::tempfile(
+		"compilexs-XXXXX",
+		SUFFIX => '.c',
+	);
+	binmode $FH;
+	print $FH <<'END_C';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int main(int argc, char **argv) {
+    return 0;
+}
+
+int boot_sanexs() {
+    return 1;
+}
+
+END_C
+	close $FH;
+
+	# Can the C compiler access the same headers XS does
+	my @libs   = ();
+	my $object = undef;
+	eval {
+		local $^W = 0;
+		$object = $builder->compile(
+			source => $tmpfile,
+		);
+		@libs = $builder->link(
+			objects     => $object,
+			module_name => 'sanexs',
+		);
+	};
+	my $result = $@ ? 0 : 1;
+
+	# Clean up all the build files
+	foreach ( $tmpfile, $object, @libs ) {
+		next unless defined $_;
+		1 while unlink;
+	}
+
+	return $result;
+}
+
+# Can we locate a (the) C compiler
 sub can_cc {
 	my $self   = shift;
 	my @chunks = split(/ /, $Config::Config{cc}) or return;
@@ -78,4 +151,4 @@ if ( $^O eq 'cygwin' ) {
 
 __END__
 
-#line 156
+#line 236
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index a412576..bee0c4f 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.04';
+	$VERSION = '1.06';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
index dd001eb..8310e4c 100644
--- a/inc/Module/Install/Include.pm
+++ b/inc/Module/Install/Include.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.04';
+	$VERSION = '1.06';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 035cef2..7052f36 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -8,7 +8,7 @@ use Fcntl qw/:flock :seek/;
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.04';
+	$VERSION = '1.06';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -215,13 +215,17 @@ sub write {
 	require ExtUtils::MakeMaker;
 
 	if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
-		# MakeMaker can complain about module versions that include
-		# an underscore, even though its own version may contain one!
-		# Hence the funny regexp to get rid of it.  See RT #35800
-		# for details.
-		my ($v) = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
-		$self->build_requires(     'ExtUtils::MakeMaker' => $v );
-		$self->configure_requires( 'ExtUtils::MakeMaker' => $v );
+		# This previous attempted to inherit the version of
+		# ExtUtils::MakeMaker in use by the module author, but this
+		# was found to be untenable as some authors build releases
+		# using future dev versions of EU:MM that nobody else has.
+		# Instead, #toolchain suggests we use 6.59 which is the most
+		# stable version on CPAN at time of writing and is, to quote
+		# ribasushi, "not terminally fucked, > and tested enough".
+		# TODO: We will now need to maintain this over time to push
+		# the version up as new versions are released.
+		$self->build_requires(     'ExtUtils::MakeMaker' => 6.59 );
+		$self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
 	} else {
 		# Allow legacy-compatibility with 5.005 by depending on the
 		# most recent EU:MM that supported 5.005.
@@ -411,4 +415,4 @@ sub postamble {
 
 __END__
 
-#line 540
+#line 544
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index 31c953e..58430f3 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.04';
+	$VERSION = '1.06';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index 99d9631..eeaa3fe 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.04';
+	$VERSION = '1.06';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 86bb25e..85d8018 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.04';
+	$VERSION = '1.06';
 	@ISA     = qw{Module::Install::Base};
 	$ISCORE  = 1;
 }

commit bb7b893ffe39bc4627a3d54072eaf495d70e255a
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Tue Apr 24 17:18:03 2012 -0400

    Sync single value user CFs from LDAP
    
    This lets you import a lot more of your LDAP information into RT, which
    can be especially helpful with custom user/requestor displays on
    tickets.
    
    Note that the prefix is UserCF. not CF. as that's already used for
    populating Custom Field Values (not _Object_ Custom Field Values).

diff --git a/README b/README
index c5e1828..0a9aa7d 100644
--- a/README
+++ b/README
@@ -74,6 +74,22 @@ CONFIGURATION
         The LDAP attribute can also be a subroutine reference that returns
         either an arrayref or a list of attributes.
 
+        The keys in the mapping (i.e. the RT fields, the left hand side) may
+        be a user custom field name prefixed with "UserCF.", for example "
+        'UserCF.Employee Number' =" 'employeeId' >. Note that this only adds
+        values at the moment, which on single value CFs will remove any old
+        value first. Multiple value CFs may behave not quite how you expect.
+        If the attribute no longer exists on a user in LDAP, it will be
+        cleared on the RT side as well.
+
+        You may also prefix any RT custom field name with "CF." inside your
+        mapping to add available values to a Select custom field. This
+        effectively takes user attributes in LDAP and adds the values as
+        selectable options in a CF. It does not set a CF value on any RT
+        object (User, Ticket, Queue, etc). You might use this to populate a
+        ticket Location CF with all the locations of your users so that
+        tickets can be associated with the locations in use.
+
     "Set($LDAPCreatePrivileged, 1);"
         By default users are created as Unprivileged, but you can change
         this by setting $LDAPCreatePrivileged to 1.
@@ -298,6 +314,15 @@ METHODS
 
     This could probably use some caching.
 
+   update_object_custom_field_values
+    Adds CF values to an object (currently only users). The Custom Field
+    should already exist, otherwise this will throw an error and not import
+    any data.
+
+    Note that this code only adds values at the moment, which on single
+    value CFs will remove any old value first. Multiple value CFs may behave
+    not quite how you expect.
+
   import_groups import => 1|0
     Takes the results of the search from "run_group_search" and maps
     attributes from LDAP into "RT::Group" attributes using
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index 5929677..e04dddc 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -102,6 +102,20 @@ which will be concatenated together with a space.
 The LDAP attribute can also be a subroutine reference
 that returns either an arrayref or a list of attributes.
 
+The keys in the mapping (i.e. the RT fields, the left hand side) may be a user
+custom field name prefixed with C<UserCF.>, for example C<< 'UserCF.Employee
+Number' => 'employeeId' >>.  Note that this only B<adds> values at the moment,
+which on single value CFs will remove any old value first.  Multiple value CFs
+may behave not quite how you expect.  If the attribute no longer exists on a
+user in LDAP, it will be cleared on the RT side as well.
+
+You may also prefix any RT custom field name with C<CF.> inside your mapping to
+add available values to a Select custom field.  This effectively takes user
+attributes in LDAP and adds the values as selectable options in a CF.  It does
+B<not> set a CF value on any RT object (User, Ticket, Queue, etc).  You might
+use this to populate a ticket Location CF with all the locations of your users
+so that tickets can be associated with the locations in use.
+
 =item C<< Set($LDAPCreatePrivileged, 1); >>
 
 By default users are created as Unprivileged, but you can change this by
@@ -449,6 +463,7 @@ sub _import_user {
 
     $self->add_user_to_group( %args );
     $self->add_custom_field_value( %args );
+    $self->update_object_custom_field_values( %args, object => $args{user} );
 
     return 1;
 }
@@ -542,7 +557,7 @@ exists in the returned object.
 sub _build_user_object {
     my $self = shift;
     my $user = $self->_build_object(
-        skip    => qr/(?i)^CF\./,
+        skip    => qr/(?i)^(?:User)?CF\./,
         mapping => $RT::LDAPMapping,
         @_
     );
@@ -827,6 +842,52 @@ sub add_custom_field_value {
 
 }
 
+=head3 update_object_custom_field_values
+
+Adds CF values to an object (currently only users).  The Custom Field should
+already exist, otherwise this will throw an error and not import any data.
+
+Note that this code only B<adds> values at the moment, which on single value
+CFs will remove any old value first.  Multiple value CFs may behave not quite
+how you expect.
+
+=cut
+
+sub update_object_custom_field_values {
+    my $self = shift;
+    my %args = @_;
+    my $obj  = $args{object};
+
+    foreach my $rtfield ( keys %{$RT::LDAPMapping} ) {
+        # XXX TODO: accept GroupCF when we call this from group_import too
+        next unless $rtfield =~ /^UserCF\.(.+)$/i;
+        my $cf_name = $1;
+        my $ldap_attribute = $RT::LDAPMapping->{$rtfield};
+
+        my @attributes = $self->_parse_ldap_mapping($ldap_attribute);
+        unless (@attributes) {
+            $self->_error("Invalid LDAP mapping for $rtfield ".Dumper($ldap_attribute));
+            next;
+        }
+        my $value = join ' ',
+                    grep { defined and length }
+                     map { scalar $args{ldap_entry}->get_value($_) }
+                         @attributes;
+
+        if (($obj->FirstCustomFieldValue($cf_name) || '') eq ($value || '')) {
+            $self->_debug($obj->Name . ": Value '$value' is already set for '$cf_name'");
+            next;
+        }
+
+        $self->_debug($obj->Name . ": Adding object value '$value' for '$cf_name'");
+        next unless $args{import};
+
+        my ($ok, $msg) = $obj->AddCustomFieldValue( Field => $cf_name, Value => $value );
+        $self->_error($obj->Name . ": Couldn't add value '$value' for '$cf_name': $msg")
+            unless $ok;
+    }
+}
+
 =head2 import_groups import => 1|0
 
 Takes the results of the search from C<run_group_search>
@@ -912,6 +973,7 @@ sub _import_group {
     my ($group_obj, $created) = $self->create_rt_group( %args, group => $group );
     return if $args{import} and not $group_obj;
     $self->add_group_members( %args, name => $group->{Name}, group => $group_obj, ldap_entry => $ldap_entry, new => $created );
+    # XXX TODO: support OCFVs for groups too
     return;
 }
 
diff --git a/t/user-import-cfs.t b/t/user-import-cfs.t
new file mode 100644
index 0000000..754b70e
--- /dev/null
+++ b/t/user-import-cfs.t
@@ -0,0 +1,107 @@
+use strict;
+use warnings;
+use lib 't/lib';
+use RT::Extension::LDAPImport::Test tests => 7 + 13*3 + 3 + 2*2 + 1;
+eval { require Net::LDAP::Server::Test; 1; } or do {
+    plan skip_all => 'Unable to test without Net::Server::LDAP::Test';
+};
+
+use Net::LDAP::Entry;
+use RT::User;
+
+{
+    my $cf = RT::CustomField->new(RT->SystemUser);
+    my ($ok, $msg) = $cf->Create(
+        Name        => 'Employee Number',
+        LookupType  => 'RT::User',
+        Type        => 'FreeformSingle',
+        Disabled    => 0,
+    );
+    ok $cf->Id, $msg;
+
+    my $ocf = RT::ObjectCustomField->new(RT->SystemUser);
+    ($ok, $msg) = $ocf->Create( CustomField => $cf->Id );
+    ok $ocf->Id, $msg;
+}
+
+my $importer = RT::Extension::LDAPImport->new;
+isa_ok($importer,'RT::Extension::LDAPImport');
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ), 
+    "spawned test LDAP server on port $ldap_port");
+
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+my @ldap_entries;
+for ( 1 .. 13 ) {
+    my $username = "testuser$_";
+    my $dn = "uid=$username,ou=foo,dc=bestpractical,dc=com";
+    my $entry = { 
+                    cn   => "Test User $_ ".int rand(200),
+                    mail => "$username\@invalid.tld",
+                    uid  => $username,
+                    employeeId => $_,
+                    objectClass => 'User',
+                };
+    push @ldap_entries, { dn => $dn, %$entry };
+    $ldap->add( $dn, attr => [%$entry] );
+}
+
+RT->Config->Set('LDAPHost',"ldap://localhost:$ldap_port");
+RT->Config->Set('LDAPMapping',
+                   {Name         => 'uid',
+                    EmailAddress => 'mail',
+                    RealName     => 'cn',
+                    'UserCF.Employee Number' => 'employeeId',});
+RT->Config->Set('LDAPBase','ou=foo,dc=bestpractical,dc=com');
+RT->Config->Set('LDAPFilter','(objectClass=User)');
+
+$importer->screendebug(1) if ($ENV{TEST_VERBOSE});
+
+# check that we don't import
+ok($importer->import_users());
+{
+    my $users = RT::Users->new($RT::SystemUser);
+    for my $username (qw/RT_System root Nobody/) {
+        $users->Limit( FIELD => 'Name', OPERATOR => '!=', VALUE => $username, ENTRYAGGREGATOR => 'AND' );
+    }
+    is($users->Count,0);
+}
+
+# check that we do import
+ok($importer->import_users( import => 1 ));
+for my $entry (@ldap_entries) {
+    my $user = RT::User->new($RT::SystemUser);
+    $user->LoadByCols( EmailAddress => $entry->{mail},
+                       Realname => $entry->{cn},
+                       Name => $entry->{uid} );
+    ok($user->Id, "Found $entry->{cn} as ".$user->Id);
+    ok(!$user->Privileged, "User created as Unprivileged");
+    is($user->FirstCustomFieldValue('Employee Number'), $entry->{employeeId}, "cf is good");
+}
+
+# import again, check that it was cleared
+{
+    my $delete = $ldap_entries[0];
+    $ldap->modify( $delete->{dn}, delete => ['employeeId'] );
+    delete $delete->{employeeId};
+
+    my $update = $ldap_entries[1];
+    $ldap->modify( $update->{dn}, replace => ['employeeId' => 42] );
+    $update->{employeeId} = 42;
+
+    ok($importer->import_users( import => 1 ));
+
+    for my $entry (@ldap_entries[0,1]) {
+        my $user = RT::User->new($RT::SystemUser);
+        $user->LoadByCols( EmailAddress => $entry->{mail},
+                           Realname => $entry->{cn},
+                           Name => $entry->{uid} );
+        ok($user->Id, "Found $entry->{cn} as ".$user->Id);
+        is($user->FirstCustomFieldValue('Employee Number'), $entry->{employeeId}, "cf is updated");
+    }
+}
+
+# can't unbind earlier or the server will die
+$ldap->unbind;

-----------------------------------------------------------------------



More information about the Bps-public-commit mailing list