/[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 108 - (show annotations)
Fri May 2 14:38:45 2008 UTC (12 years, 5 months ago) by dpavlin
File MIME type: text/plain
File size: 4549 byte(s)
- don't insert single-value comment (corrupts model)
- comment out filter for arrays (doesn't work yet)
- create array of values for test data (which get squashed into scalar by Jifty currently)
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 =cut
26
27 use lib 'lib';
28
29 use Jifty;
30 use A3C::LDAP;
31 use Net::LDAP::Schema;
32 use File::Slurp;
33 use Data::Dump qw/dump/;
34 use Getopt::Long;
35
36 my ( $path, $objectClass, $debug );
37
38 GetOptions(
39 'model|objectClass=s', => \$objectClass,
40 'path=s', => \$path,
41 'debug+', => \$debug,
42 );
43
44 die "usage: $0 --model netOrgPerson [--path path/to/schema.ldif]\n" unless $objectClass;
45
46 my $schema;
47 if ( $path ) {
48 $schema = Net::LDAP::Schema->new;
49 $schema->parse ( $path ) or die $schema->error;
50 warn "# loaded schema from $path\n";
51 } else {
52 my $l = A3C::LDAP->new;
53 $schema = $l->ldap->schema;
54 }
55
56 die "$objectClass objectClass not found in $path\n" unless $schema->objectclass( $objectClass );
57
58 my $model = qq/package A3C::Model::$objectClass;
59 use strict;
60 use warnings;
61
62 use Jifty::DBI::Schema;
63
64 use A3C::Record schema {
65
66 /;
67
68 my $methods;
69 my $create;
70 my $columns;
71
72 sub entry {
73 my ( $e, $add ) = @_;
74 my $name = $_->{name} || die "no name?";
75 $methods .= qq/sub $_ { \$_[0]->$name }\n/ foreach @{$_->{aliases}};
76 my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$_->{desc}')/;
77 # $out .= qq/,\n\t\t# single-value/ if $_->{'single-value'};
78 # $out .= qq/,\n\t\tfilters are qw(A3C::Filter::Array)/ unless $_->{'single-value'};
79 $out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};
80 $out .= qq/,\n\t\t$add/ if $add;
81 $out .= qq/;\n\n/;
82 $columns->{$name}++;
83 return $out;
84 }
85
86 $model .= qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/ if $schema->superclass($objectClass);
87
88 $model .= qq/\t# $objectClass must:\n\n/;
89
90
91 map {
92 warn "# $objectClass must: ",dump( $_ ) if $debug;
93 $model .= entry( $_, 'is mandatory' );
94 $create->{$_->{name}} = $_->{'single-value'} ? $_->{name} : [ $_->{name}, $_->{desc} ];
95 } $schema->must( $objectClass );
96
97 $model .= qq/\t# $objectClass may:\n\n/;
98
99 map {
100 warn "# $objectClass may: ",dump( $_ ) if $debug;
101 $model .= entry( $_ );
102 } $schema->may( $objectClass );
103
104 $methods .= qq/sub name { \$_[0]->id }\n/ unless $columns->{name};
105
106 $model .= qq/
107
108 };
109
110 $methods
111
112 use A3C::DefaultACL;
113
114 1;
115 /;
116
117 if ( $debug ) {
118 print "##### ----- created model test\n$model\n";
119 } else {
120 my $model_path = "lib/A3C/Model/$objectClass.pm";
121 write_file( $model_path, $model );
122 print "Created $model_path\n";
123 }
124
125 my $test = <<'__END_OF_TEST__';
126 #!/usr/bin/env perl
127 use warnings;
128 use strict;
129
130 =head1 DESCRIPTION
131
132 A basic test harness for the _objectClass_ model.
133
134 =cut
135
136 use Jifty::Test tests => 11;
137
138 # Make sure we can load the model
139 use_ok('A3C::Model::_objectClass_');
140
141 # Grab a system user
142 my $system_user = A3C::CurrentUser->superuser;
143 ok($system_user, "Found a system user");
144
145 # Try testing a create
146 my $o = A3C::Model::_objectClass_->new(current_user => $system_user);
147 my ($id) = $o->create(
148 _create_1_);
149 ok($id, "_objectClass_ create returned success");
150 ok($o->id, "New _objectClass_ has valid id set");
151 is($o->id, $id, "Create returned the right id");
152
153 # And another
154 $o->create(
155 _create_2_);
156 ok($o->id, "_objectClass_ create returned another value");
157 isnt($o->id, $id, "And it is different from the previous one");
158
159 # Searches in general
160 my $collection = A3C::Model::_objectClass_Collection->new(current_user => $system_user);
161 $collection->unlimit;
162 is($collection->count, 2, "Finds two records");
163
164 # Searches in specific
165 $collection->limit(column => 'id', value => $o->id);
166 is($collection->count, 1, "Finds one record with specific id");
167
168 # Delete one of them
169 $o->delete;
170 $collection->redo_search;
171 is($collection->count, 0, "Deleted row is gone");
172
173 # And the other one is still there
174 $collection->unlimit;
175 is($collection->count, 1, "Still one left");
176 __END_OF_TEST__
177
178 $test =~ s/_objectClass_/$objectClass/gs;
179
180 foreach my $round ( 1 .. 2 ) {
181 my $data;
182 $data .= qq/\t\t'$_' => / . dump( $create->{$_} ) . qq/,\n/ foreach keys %$create;
183 warn "$round data = $data\n" if $debug;
184 $test =~ s/_create_${round}_/$data/gs;
185 }
186
187 if ( $debug ) {
188 print "##### ----- template test\n$test\n";
189 } else {
190 my $test_path = "t/00-model-$objectClass.t";
191 write_file( $test_path, $test );
192 print "Created $test_path\n";
193 chmod 0755, $test_path;
194 }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26