--- bin/ldap2model.pl	2008/05/01 16:31:00	105
+++ bin/ldap2model.pl	2008/05/15 18:33:58	117
@@ -22,6 +22,11 @@
 With C<--debug> switch all output will go to C<STDOUT>
 instead to files.
 
+If your schema for model doesn't include some objectClasses
+and you want to mixin them manually, use something like:
+
+  ./bin/ldap2model.pl --model hrEduOrg --mixin dcObject --mixin posixAccount
+
 =cut
 
 use lib 'lib';
@@ -34,9 +39,11 @@
 use Getopt::Long;
 
 my ( $path, $objectClass, $debug );
+my @mixin;
 
 GetOptions(
 	'model|objectClass=s', => \$objectClass,
+	'mixin=s', => \@mixin,
 	'path=s', => \$path,
 	'debug+', => \$debug,
 );
@@ -69,38 +76,57 @@
 my $create;
 my $columns;
 
-sub entry {
-	my ( $e, $add ) = @_;
-	my $name = $_->{name} || die "no name?";
-	$methods .= qq/sub $_ { \$_[0]->$name }\n/ foreach @{$_->{aliases}};
-	my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$_->{desc}')/;
-	$out .= qq/,\n\t\t# single-value/ if $_->{'single-value'};
-	$out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};
-	$out .= qq/,\n\t\t$add/ if $add;
-	$out .= qq/;\n\n/;
-	$columns->{$name}++;
-	return $out;
-}
-
-$model .= qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/ if $schema->superclass($objectClass);
-
-$model .= qq/\t# $objectClass must:\n\n/;
-
+sub model_columns {
+	my $objectClass = shift;
+	my $model;
+	warn "Creating columns for model $objectClass\n";
+
+	my $aliases = qq/\n=head1 $objectClass helper methods\n=cut\n\n/;
+
+	sub entry {
+		my ( $e, $add ) = @_;
+		my $name = $_->{name} || die "no name?";
+		if ( $columns->{$name} ) {
+			warn "WARNING: column $name found again, skipping...\n";
+			return '';
+		}
+		$aliases .= qq/sub $_ { \$_[0]->$name }\n/ foreach @{$_->{aliases}};
+		my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$_->{desc}')/;
+#		$out .= qq/,\n\t\t# single-value/ if $_->{'single-value'};
+#		$out .= qq/,\n\t\tfilters are qw(A3C::Filter::Array)/ unless $_->{'single-value'};
+		$out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};
+		$out .= qq/,\n\t\t$add/ if $add;
+		$out .= qq/;\n\n/;
+		$columns->{$name}++;
+		return $out;
+	}
+
+	$model .= qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/ if $schema->superclass($objectClass);
+
+	my $must;
+	map {
+		warn "# $objectClass must: ",dump( $_ ),$/ if $debug;
+		$must .= entry( $_, 'is mandatory' );
+		$create->{$_->{name}} = $_->{'single-value'} ? $_->{name} : [ $_->{name}, $_->{desc} ];
+	} $schema->must( $objectClass );
+	$model .= qq/\t# $objectClass must:\n\n$must\n/ if $must;
+
+	my $may;
+	map {
+		warn "# $objectClass may: ",dump( $_ ),$/ if $debug;
+		$may .= entry( $_ );
+	} $schema->may( $objectClass );
+	$model .= qq/\t# $objectClass may:\n\n$may\n/ if $may;
 
-map {
-	warn "# $objectClass must: ",dump( $_ ) if $debug;
-	$model .= entry( $_, 'is mandatory' );
-	$create->{$_->{name}} = $_->{name};
-} $schema->must( $objectClass );
+	$methods .= $aliases unless $aliases;
 
-$model .= qq/\t# $objectClass may:\n\n/;
+	return $model;
+}
 
-map {
-	warn "# $objectClass may: ",dump( $_ ) if $debug;
-	$model .= entry( $_ );
-} $schema->may( $objectClass );
+$model .= model_columns( $objectClass );
+$model .= model_columns( $_ ) foreach @mixin;
 
-$methods .= qq/sub name { \$_[0]->id }\n/ unless $columns->{name};
+$methods .= qq/\n=head2 name\n\nAuto-generated human readable id for generic access to name\n\n=cut\n\nsub name { \$_[0]->id }\n/ unless $columns->{name};
 
 $model .= qq/
 
@@ -108,13 +134,19 @@
 
 $methods
 
+=head2 ACL
+
+We use L<A3C::DefaultACL> for access control
+
+=cut
+
 use A3C::DefaultACL;
 
 1;
 /;
 
 if ( $debug ) {
-	print "##### ----- created model test\n$model\n";
+	print "##### ----- start of created model $objectClass\n\n$model\n\n#### ---- END of created model $objectClass\n";
 } else {
 	my $model_path = "lib/A3C/Model/$objectClass.pm";
 	write_file( $model_path, $model );
@@ -178,7 +210,7 @@
 
 foreach my $round ( 1 .. 2 ) {
 	my $data;
-	$data .= qq/\t\t'$_' => '$_ $round',\n/ foreach keys %$create;
+	$data .= qq/\t\t'$_' => / . dump( $create->{$_} ) . qq/,\n/ foreach keys %$create;
 	warn "$round data = $data\n" if $debug;
 	$test =~ s/_create_${round}_/$data/gs;
 }