1 |
dpavlin |
98 |
#!/usr/bin/perl |
2 |
|
|
use warnings; |
3 |
|
|
use strict; |
4 |
|
|
|
5 |
|
|
# schema2model.pl - convert LDAP schema file into jifty model |
6 |
|
|
# |
7 |
|
|
# 04/30/08 20:55:21 CEST Dobrica Pavlinusic <dpavlin@rot13.org> |
8 |
dpavlin |
99 |
# |
9 |
|
|
# ./bin/ldap2model.pl data/all.ldif hrEduOrg |
10 |
dpavlin |
98 |
|
11 |
|
|
use Net::LDAP::Schema; |
12 |
dpavlin |
99 |
use File::Slurp; |
13 |
dpavlin |
98 |
use Data::Dump qw/dump/; |
14 |
|
|
|
15 |
|
|
my ( $path, $objectClass ) = @ARGV; |
16 |
|
|
|
17 |
|
|
die "usage: $0 path/to/schema.ldif inetOrgPerson\n" unless $path && $objectClass; |
18 |
|
|
|
19 |
|
|
my $schema = Net::LDAP::Schema->new; |
20 |
|
|
$schema->parse ( $path ) or die $schema->error; |
21 |
|
|
|
22 |
dpavlin |
99 |
die "$objectClass objectClass not found in $path\n" unless $schema->objectclass( $objectClass ); |
23 |
|
|
|
24 |
|
|
my $model = qq/package A3C::Model::$objectClass; |
25 |
|
|
use strict; |
26 |
|
|
use warnings; |
27 |
|
|
|
28 |
|
|
use Jifty::DBI::Schema; |
29 |
|
|
|
30 |
|
|
use A3C::Record schema { |
31 |
|
|
|
32 |
|
|
/; |
33 |
|
|
|
34 |
|
|
my $methods; |
35 |
|
|
|
36 |
dpavlin |
98 |
sub entry { |
37 |
|
|
my ( $e, $add ) = @_; |
38 |
dpavlin |
99 |
my $name = $_->{name} || die "no name?"; |
39 |
|
|
$methods .= qq/sub $_ { \$_[0]->$name }\n/ foreach @{$_->{aliases}}; |
40 |
|
|
my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$_->{desc}')/; |
41 |
dpavlin |
98 |
$out .= qq/,\n\t\t# single-value/ if $_->{'single-value'}; |
42 |
|
|
$out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'}; |
43 |
|
|
$out .= qq/,\n\t\t$add/ if $add; |
44 |
|
|
$out .= qq/;\n\n/; |
45 |
|
|
return $out; |
46 |
|
|
} |
47 |
|
|
|
48 |
dpavlin |
99 |
$model .= qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/ if $schema->superclass($objectClass); |
49 |
dpavlin |
98 |
|
50 |
|
|
$model .= qq/\t# $objectClass must:\n\n/; |
51 |
|
|
|
52 |
|
|
map { |
53 |
|
|
warn "# $objectClass must: ",dump( $_ ); |
54 |
|
|
$model .= entry( $_, 'is mandatory' ); |
55 |
|
|
} $schema->must( $objectClass ); |
56 |
|
|
|
57 |
|
|
$model .= qq/\t# $objectClass may:\n\n/; |
58 |
|
|
|
59 |
|
|
map { |
60 |
|
|
warn "# $objectClass may: ",dump( $_ ); |
61 |
|
|
$model .= entry( $_ ); |
62 |
|
|
} $schema->may( $objectClass ); |
63 |
|
|
|
64 |
dpavlin |
99 |
$model .= qq/ |
65 |
|
|
|
66 |
|
|
}; |
67 |
|
|
|
68 |
|
|
$methods |
69 |
|
|
|
70 |
|
|
use A3C::DefaultACL; |
71 |
|
|
|
72 |
|
|
1; |
73 |
|
|
/; |
74 |
|
|
|
75 |
|
|
my $model_path = "lib/A3C/Model/$objectClass.pm"; |
76 |
|
|
write_file( $model_path, $model ); |
77 |
|
|
warn "Created $model_path\n"; |