/[A3C]/bin/ldap2model.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /bin/ldap2model.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 114 - (show annotations)
Thu May 15 17:35:45 2008 UTC (15 years, 10 months ago) by dpavlin
File MIME type: text/plain
File size: 5448 byte(s)
since we can't really reliably tell which columns should database
have by just looking into schema, we need to enable users to specify
additional classes to mix them in.

Also generate really nice perl code now, which even works! YAY!
1 #!/usr/bin/perl
2 use warnings;
3 use strict;
4
5 =head1 NAME
6
7 schema2model.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 Jifty;
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 $methods .= qq/\n=head2 $objectClass\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 $methods .= 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 return $model;
122 }
123
124 $model .= model_columns( $objectClass );
125 $model .= model_columns( $_ ) foreach @mixin;
126
127 $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};
128
129 $model .= qq/
130
131 };
132
133 $methods
134
135 =head ACL
136
137 We use L<A3C::DefaultACL> for access control
138
139 =cut
140
141 use A3C::DefaultACL;
142
143 1;
144 /;
145
146 if ( $debug ) {
147 print "##### ----- start of created model $objectClass\n\n$model\n\n#### ---- END of created model $objectClass\n";
148 } else {
149 my $model_path = "lib/A3C/Model/$objectClass.pm";
150 write_file( $model_path, $model );
151 print "Created $model_path\n";
152 }
153
154 my $test = <<'__END_OF_TEST__';
155 #!/usr/bin/env perl
156 use warnings;
157 use strict;
158
159 =head1 DESCRIPTION
160
161 A basic test harness for the _objectClass_ model.
162
163 =cut
164
165 use Jifty::Test tests => 11;
166
167 # Make sure we can load the model
168 use_ok('A3C::Model::_objectClass_');
169
170 # Grab a system user
171 my $system_user = A3C::CurrentUser->superuser;
172 ok($system_user, "Found a system user");
173
174 # Try testing a create
175 my $o = A3C::Model::_objectClass_->new(current_user => $system_user);
176 my ($id) = $o->create(
177 _create_1_);
178 ok($id, "_objectClass_ create returned success");
179 ok($o->id, "New _objectClass_ has valid id set");
180 is($o->id, $id, "Create returned the right id");
181
182 # And another
183 $o->create(
184 _create_2_);
185 ok($o->id, "_objectClass_ create returned another value");
186 isnt($o->id, $id, "And it is different from the previous one");
187
188 # Searches in general
189 my $collection = A3C::Model::_objectClass_Collection->new(current_user => $system_user);
190 $collection->unlimit;
191 is($collection->count, 2, "Finds two records");
192
193 # Searches in specific
194 $collection->limit(column => 'id', value => $o->id);
195 is($collection->count, 1, "Finds one record with specific id");
196
197 # Delete one of them
198 $o->delete;
199 $collection->redo_search;
200 is($collection->count, 0, "Deleted row is gone");
201
202 # And the other one is still there
203 $collection->unlimit;
204 is($collection->count, 1, "Still one left");
205 __END_OF_TEST__
206
207 $test =~ s/_objectClass_/$objectClass/gs;
208
209 foreach my $round ( 1 .. 2 ) {
210 my $data;
211 $data .= qq/\t\t'$_' => / . dump( $create->{$_} ) . qq/,\n/ foreach keys %$create;
212 warn "$round data = $data\n" if $debug;
213 $test =~ s/_create_${round}_/$data/gs;
214 }
215
216 if ( $debug ) {
217 print "##### ----- template test\n$test\n";
218 } else {
219 my $test_path = "t/00-model-$objectClass.t";
220 write_file( $test_path, $test );
221 print "Created $test_path\n";
222 chmod 0755, $test_path;
223 }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26