--- bin/ldap2model.pl 2008/05/01 13:41:44 102 +++ bin/ldap2model.pl 2008/05/15 17:35:45 114 @@ -2,22 +2,63 @@ use warnings; use strict; -# schema2model.pl - convert LDAP schema file into jifty model -# -# 04/30/08 20:55:21 CEST Dobrica Pavlinusic -# -# ./bin/ldap2model.pl data/all.ldif hrEduOrg +=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 in C + +With C<--debug> switch all output will go to C +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'; + +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 ); +my @mixin; -die "usage: $0 path/to/schema.ldif inetOrgPerson\n" unless $path && $objectClass; - -my $schema = Net::LDAP::Schema->new; -$schema->parse ( $path ) or die $schema->error; +GetOptions( + 'model|objectClass=s', => \$objectClass, + 'mixin=s', => \@mixin, + '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 ); @@ -35,38 +76,55 @@ 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/; - - -map { - warn "# $objectClass must: ",dump( $_ ); - $model .= entry( $_, 'is mandatory' ); - $create->{$_->{name}} = $_->{name}; -} $schema->must( $objectClass ); +sub model_columns { + my $objectClass = shift; + my $model; + warn "Creating columns for model $objectClass\n"; + + $methods .= qq/\n=head2 $objectClass\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 ''; + } + $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; + } + + $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; -$model .= qq/\t# $objectClass may:\n\n/; + return $model; +} -map { - warn "# $objectClass may: ",dump( $_ ); - $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/ @@ -74,14 +132,24 @@ $methods +=head ACL + +We use L for access control + +=cut + use A3C::DefaultACL; 1; /; -my $model_path = "lib/A3C/Model/$objectClass.pm"; -write_file( $model_path, $model ); -warn "Created $model_path\n"; +if ( $debug ) { + 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 ); + print "Created $model_path\n"; +} my $test = <<'__END_OF_TEST__'; #!/usr/bin/env perl @@ -140,12 +208,16 @@ foreach my $round ( 1 .. 2 ) { my $data; - $data .= qq/\t\t'$_' => '$_ $round',\n/ foreach keys %$create; - warn "data = $data\n"; + $data .= qq/\t\t'$_' => / . dump( $create->{$_} ) . qq/,\n/ foreach keys %$create; + warn "$round data = $data\n" if $debug; $test =~ s/_create_${round}_/$data/gs; } -my $test_path = "t/00-model-$objectClass.t"; -write_file( $test_path, $test ); -warn "Created $test_path\n"; -chmod 0755, $test_path; +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; +}