A3C/bin/ldap2model.pl

#!/usr/bin/perl
use warnings;
use strict;

=head1 NAME

ldap2model.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.

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 JiftyModelCreator;
use A3C::LDAP;
use Net::LDAP::Schema;
use File::Slurp;
use Data::Dump qw/dump/;
use Getopt::Long;

my ( $path, $objectClass, $debug );
my @mixin;

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 );

my $model = qq/package A3C::Model::$objectClass;
use strict;
use warnings;

use Jifty::DBI::Schema;

use A3C::Record schema {

/;

my $methods;
my $create;
my $columns;

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;

        $methods .= $aliases unless $aliases;

        return $model;
}

$model .= model_columns( $objectClass );
$model .= model_columns( $_ ) foreach @mixin;

$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/

};

$methods

=head2 ACL

We use L<A3C::DefaultACL> for access control

=cut

use A3C::DefaultACL;

1;
/;

JiftyModelCreator->write( $objectClass, $model, $create );
1	#!/usr/bin/perl
2	use warnings;
3	use strict;
4
5	=head1 NAME
6
7	ldap2model.pl - convert LDAP schema file into Jifty model
8
9	=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	If your schema for model doesn't include some objectClasses
26	and you want to mixin them manually, use something like:
27
28	./bin/ldap2model.pl --model hrEduOrg --mixin dcObject --mixin posixAccount
29
30	=cut
31
32	use lib 'lib';
33
34	use JiftyModelCreator;
35	use A3C::LDAP;
36	use Net::LDAP::Schema;
37	use File::Slurp;
38	use Data::Dump qw/dump/;
39	use Getopt::Long;
40
41	my ( $path, $objectClass, $debug );
42	my @mixin;
43
44	GetOptions(
45	'model\|objectClass=s', => \$objectClass,
46	'mixin=s', => \@mixin,
47	'path=s', => \$path,
48	'debug+', => \$debug,
49	);
50
51	die "usage: $0 --model netOrgPerson [--path path/to/schema.ldif]\n" unless $objectClass;
52
53	my $schema;
54	if ( $path ) {
55	$schema = Net::LDAP::Schema->new;
56	$schema->parse ( $path ) or die $schema->error;
57	warn "# loaded schema from $path\n";
58	} else {
59	my $l = A3C::LDAP->new;
60	$schema = $l->ldap->schema;
61	}
62
63	die "$objectClass objectClass not found in $path\n" unless $schema->objectclass( $objectClass );
64
65	my $model = qq/package A3C::Model::$objectClass;
66	use strict;
67	use warnings;
68
69	use Jifty::DBI::Schema;
70
71	use A3C::Record schema {
72
73	/;
74
75	my $methods;
76	my $create;
77	my $columns;
78
79	sub model_columns {
80	my $objectClass = shift;
81	my $model;
82	warn "Creating columns for model $objectClass\n";
83
84	my $aliases = qq/\n=head1 $objectClass helper methods\n=cut\n\n/;
85
86	sub entry {
87	my ( $e, $add ) = @_;
88	my $name = $_->{name} \|\| die "no name?";
89	if ( $columns->{$name} ) {
90	warn "WARNING: column $name found again, skipping...\n";
91	return '';
92	}
93	$aliases .= qq/sub $_ { \$_[0]->$name }\n/ foreach @{$_->{aliases}};
94	my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$_->{desc}')/;
95	# $out .= qq/,\n\t\t# single-value/ if $_->{'single-value'};
96	# $out .= qq/,\n\t\tfilters are qw(A3C::Filter::Array)/ unless $_->{'single-value'};
97	$out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};
98	$out .= qq/,\n\t\t$add/ if $add;
99	$out .= qq/;\n\n/;
100	$columns->{$name}++;
101	return $out;
102	}
103
104	$model .= qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/ if $schema->superclass($objectClass);
105
106	my $must;
107	map {
108	warn "# $objectClass must: ",dump( $_ ),$/ if $debug;
109	$must .= entry( $_, 'is mandatory' );
110	$create->{$_->{name}} = $_->{'single-value'} ? $_->{name} : [ $_->{name}, $_->{desc} ];
111	} $schema->must( $objectClass );
112	$model .= qq/\t# $objectClass must:\n\n$must\n/ if $must;
113
114	my $may;
115	map {
116	warn "# $objectClass may: ",dump( $_ ),$/ if $debug;
117	$may .= entry( $_ );
118	} $schema->may( $objectClass );
119	$model .= qq/\t# $objectClass may:\n\n$may\n/ if $may;
120
121	$methods .= $aliases unless $aliases;
122
123	return $model;
124	}
125
126	$model .= model_columns( $objectClass );
127	$model .= model_columns( $_ ) foreach @mixin;
128
129	$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};
130
131	$model .= qq/
132
133	};
134
135	$methods
136
137	=head2 ACL
138
139	We use L<A3C::DefaultACL> for access control
140
141	=cut
142
143	use A3C::DefaultACL;
144
145	1;
146	/;
147
148	JiftyModelCreator->write( $objectClass, $model, $create );