2 |
use warnings; |
use warnings; |
3 |
use strict; |
use strict; |
4 |
|
|
5 |
# schema2model.pl - convert LDAP schema file into jifty model |
=head1 NAME |
6 |
# |
|
7 |
# 04/30/08 20:55:21 CEST Dobrica Pavlinusic <dpavlin@rot13.org> |
schema2model.pl - convert LDAP schema file into jifty model |
8 |
# |
|
9 |
# ./bin/ldap2model.pl --model hrEduOrg --path data/all.ldif |
=head1 DESCRIPTION |
10 |
|
|
11 |
|
Create model from ldif data |
12 |
|
|
13 |
|
./bin/ldap2model.pl --model hrEduOrg --path data/all.ldif |
14 |
|
|
15 |
|
or directly from LDAP server |
16 |
|
|
17 |
|
./bin/ldap2model.pl --model inetOrgPerson |
18 |
|
./bin/ldap2model.pl --model organization |
19 |
|
|
20 |
|
which must match C<LDAP.objectClass> in C<etc/conf.yml> |
21 |
|
|
22 |
|
With C<--debug> switch all output will go to C<STDOUT> |
23 |
|
instead to files. |
24 |
|
|
25 |
|
=cut |
26 |
|
|
27 |
use lib 'lib'; |
use lib 'lib'; |
28 |
|
|
33 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
34 |
use Getopt::Long; |
use Getopt::Long; |
35 |
|
|
36 |
my ( $path, $objectClass ); |
my ( $path, $objectClass, $debug ); |
37 |
|
|
38 |
GetOptions( |
GetOptions( |
39 |
'model|objectClass=s', => \$objectClass, |
'model|objectClass=s', => \$objectClass, |
40 |
'path=s', => \$path, |
'path=s', => \$path, |
41 |
|
'debug+', => \$debug, |
42 |
); |
); |
43 |
|
|
44 |
die "usage: $0 --model netOrgPerson [--path path/to/schema.ldif]\n" unless $objectClass; |
die "usage: $0 --model netOrgPerson [--path path/to/schema.ldif]\n" unless $objectClass; |
88 |
|
|
89 |
|
|
90 |
map { |
map { |
91 |
warn "# $objectClass must: ",dump( $_ ); |
warn "# $objectClass must: ",dump( $_ ) if $debug; |
92 |
$model .= entry( $_, 'is mandatory' ); |
$model .= entry( $_, 'is mandatory' ); |
93 |
$create->{$_->{name}} = $_->{name}; |
$create->{$_->{name}} = $_->{name}; |
94 |
} $schema->must( $objectClass ); |
} $schema->must( $objectClass ); |
96 |
$model .= qq/\t# $objectClass may:\n\n/; |
$model .= qq/\t# $objectClass may:\n\n/; |
97 |
|
|
98 |
map { |
map { |
99 |
warn "# $objectClass may: ",dump( $_ ); |
warn "# $objectClass may: ",dump( $_ ) if $debug; |
100 |
$model .= entry( $_ ); |
$model .= entry( $_ ); |
101 |
} $schema->may( $objectClass ); |
} $schema->may( $objectClass ); |
102 |
|
|
113 |
1; |
1; |
114 |
/; |
/; |
115 |
|
|
116 |
my $model_path = "lib/A3C/Model/$objectClass.pm"; |
if ( $debug ) { |
117 |
write_file( $model_path, $model ); |
print "##### ----- created model test\n$model\n"; |
118 |
warn "Created $model_path\n"; |
} else { |
119 |
|
my $model_path = "lib/A3C/Model/$objectClass.pm"; |
120 |
|
write_file( $model_path, $model ); |
121 |
|
print "Created $model_path\n"; |
122 |
|
} |
123 |
|
|
124 |
my $test = <<'__END_OF_TEST__'; |
my $test = <<'__END_OF_TEST__'; |
125 |
#!/usr/bin/env perl |
#!/usr/bin/env perl |
179 |
foreach my $round ( 1 .. 2 ) { |
foreach my $round ( 1 .. 2 ) { |
180 |
my $data; |
my $data; |
181 |
$data .= qq/\t\t'$_' => '$_ $round',\n/ foreach keys %$create; |
$data .= qq/\t\t'$_' => '$_ $round',\n/ foreach keys %$create; |
182 |
warn "data = $data\n"; |
warn "$round data = $data\n" if $debug; |
183 |
$test =~ s/_create_${round}_/$data/gs; |
$test =~ s/_create_${round}_/$data/gs; |
184 |
} |
} |
185 |
|
|
186 |
my $test_path = "t/00-model-$objectClass.t"; |
if ( $debug ) { |
187 |
write_file( $test_path, $test ); |
print "##### ----- template test\n$test\n"; |
188 |
warn "Created $test_path\n"; |
} else { |
189 |
chmod 0755, $test_path; |
my $test_path = "t/00-model-$objectClass.t"; |
190 |
|
write_file( $test_path, $test ); |
191 |
|
print "Created $test_path\n"; |
192 |
|
chmod 0755, $test_path; |
193 |
|
} |