--- bin/ldap2model.pl	2008/04/30 21:27:54	98
+++ bin/ldap2model.pl	2008/05/02 14:38:45	108
@@ -2,44 +2,193 @@
 use warnings;
 use strict;
 
-# schema2model.pl - convert LDAP schema file into jifty model
-#
-# 04/30/08 20:55:21 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
+=head1 NAME
 
+schema2model.pl - convert LDAP schema file into jifty model
+
+=head1 DESCRIPTION
+
+Create model from ldif data
+
+  ./bin/ldap2model.pl --model hrEduOrg --path data/all.ldif
+
+or directly from LDAP server
+
+  ./bin/ldap2model.pl --model inetOrgPerson
+  ./bin/ldap2model.pl --model organization
+
+which must match C<LDAP.objectClass> in C<etc/conf.yml>
+
+With C<--debug> switch all output will go to C<STDOUT>
+instead to files.
+
+=cut
+
+use lib 'lib';
+
+use Jifty;
+use A3C::LDAP;
 use Net::LDAP::Schema;
+use File::Slurp;
 use Data::Dump qw/dump/;
+use Getopt::Long;
 
-my ( $path, $objectClass ) = @ARGV;
+my ( $path, $objectClass, $debug );
 
-die "usage: $0 path/to/schema.ldif inetOrgPerson\n" unless $path && $objectClass;
+GetOptions(
+	'model|objectClass=s', => \$objectClass,
+	'path=s', => \$path,
+	'debug+', => \$debug,
+);
+
+die "usage: $0 --model netOrgPerson [--path path/to/schema.ldif]\n" unless $objectClass;
+
+my $schema;
+if ( $path ) {
+	$schema = Net::LDAP::Schema->new;
+	$schema->parse ( $path ) or die $schema->error;
+	warn "# loaded schema from $path\n";
+} else {
+	my $l = A3C::LDAP->new;
+	$schema = $l->ldap->schema;
+}
+
+die "$objectClass objectClass not found in $path\n" unless $schema->objectclass( $objectClass );
+
+my $model = qq/package A3C::Model::$objectClass;
+use strict;
+use warnings;
 
-my $schema = Net::LDAP::Schema->new;
-$schema->parse ( $path ) or die $schema->error;
+use Jifty::DBI::Schema;
+
+use A3C::Record schema {
+
+/;
+
+my $methods;
+my $create;
+my $columns;
 
 sub entry {
 	my ( $e, $add ) = @_;
-	my $out = qq/\tcolumn $_->{name} =>\n\t\tlabel is _('$_->{desc}')/;
-	$out .= qq/,\n\t\t# single-value/ if $_->{'single-value'};
+	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\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;
 }
 
-my $model = qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/;
+$model .= qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/ if $schema->superclass($objectClass);
 
 $model .= qq/\t# $objectClass must:\n\n/;
 
+
 map {
-	warn "# $objectClass must: ",dump( $_ );
+	warn "# $objectClass must: ",dump( $_ ) if $debug;
 	$model .= entry( $_, 'is mandatory' );
+	$create->{$_->{name}} = $_->{'single-value'} ? $_->{name} : [ $_->{name}, $_->{desc} ];
 } $schema->must( $objectClass );
 
 $model .= qq/\t# $objectClass may:\n\n/;
 
 map {
-	warn "# $objectClass may: ",dump( $_ );
+	warn "# $objectClass may: ",dump( $_ ) if $debug;
 	$model .= entry( $_ );
 } $schema->may( $objectClass );
 
-print $model;
+$methods .= qq/sub name { \$_[0]->id }\n/ unless $columns->{name};
+
+$model .= qq/
+
+};
+
+$methods
+
+use A3C::DefaultACL;
+
+1;
+/;
+
+if ( $debug ) {
+	print "##### ----- created model test\n$model\n";
+} else {
+	my $model_path = "lib/A3C/Model/$objectClass.pm";
+	write_file( $model_path, $model );
+	print "Created $model_path\n";
+}
+
+my $test = <<'__END_OF_TEST__';
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the _objectClass_ model.
+
+=cut
+
+use Jifty::Test tests => 11;
+
+# Make sure we can load the model
+use_ok('A3C::Model::_objectClass_');
+
+# Grab a system user
+my $system_user = A3C::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+# Try testing a create
+my $o = A3C::Model::_objectClass_->new(current_user => $system_user);
+my ($id) = $o->create(
+_create_1_);
+ok($id, "_objectClass_ create returned success");
+ok($o->id, "New _objectClass_ has valid id set");
+is($o->id, $id, "Create returned the right id");
+
+# And another
+$o->create(
+_create_2_);
+ok($o->id, "_objectClass_ create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+
+# Searches in general
+my $collection =  A3C::Model::_objectClass_Collection->new(current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+__END_OF_TEST__
+
+$test =~ s/_objectClass_/$objectClass/gs;
+
+foreach my $round ( 1 .. 2 ) {
+	my $data;
+	$data .= qq/\t\t'$_' => / . dump( $create->{$_} ) . qq/,\n/ foreach keys %$create;
+	warn "$round data = $data\n" if $debug;
+	$test =~ s/_create_${round}_/$data/gs;
+}
+
+if ( $debug ) {
+	print "##### ----- template test\n$test\n";
+} else {
+	my $test_path = "t/00-model-$objectClass.t";
+	write_file( $test_path, $test );
+	print "Created $test_path\n";
+	chmod 0755, $test_path;
+}