/[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 103 - (show annotations)
Thu May 1 14:30:06 2008 UTC (12 years, 5 months ago) by dpavlin
File MIME type: text/plain
File size: 3916 byte(s)
added command-line options and ability to pull schema from LDAP server

Example usage is now:

./bin/ldap2model.pl --model hrEduOrg

to pull hrEduOrg objectClass from LDAP server or

./bin/ldap2model.pl --model hrEduOrg --path data/all.ldif

to use ldif instead (server is prefered in on-line situations)
1 #!/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 #
9 # ./bin/ldap2model.pl --model hrEduOrg --path data/all.ldif
10
11 use lib 'lib';
12
13 use Jifty;
14 use A3C::LDAP;
15 use Net::LDAP::Schema;
16 use File::Slurp;
17 use Data::Dump qw/dump/;
18 use Getopt::Long;
19
20 my ( $path, $objectClass );
21
22 GetOptions(
23 'model|objectClass=s', => \$objectClass,
24 'path=s', => \$path,
25 );
26
27 die "usage: $0 --model netOrgPerson [--path path/to/schema.ldif]\n" unless $objectClass;
28
29 my $schema;
30 if ( $path ) {
31 $schema = Net::LDAP::Schema->new;
32 $schema->parse ( $path ) or die $schema->error;
33 warn "# loaded schema from $path\n";
34 } else {
35 my $l = A3C::LDAP->new;
36 $schema = $l->ldap->schema;
37 }
38
39 die "$objectClass objectClass not found in $path\n" unless $schema->objectclass( $objectClass );
40
41 my $model = qq/package A3C::Model::$objectClass;
42 use strict;
43 use warnings;
44
45 use Jifty::DBI::Schema;
46
47 use A3C::Record schema {
48
49 /;
50
51 my $methods;
52 my $create;
53 my $columns;
54
55 sub entry {
56 my ( $e, $add ) = @_;
57 my $name = $_->{name} || die "no name?";
58 $methods .= qq/sub $_ { \$_[0]->$name }\n/ foreach @{$_->{aliases}};
59 my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$_->{desc}')/;
60 $out .= qq/,\n\t\t# single-value/ if $_->{'single-value'};
61 $out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};
62 $out .= qq/,\n\t\t$add/ if $add;
63 $out .= qq/;\n\n/;
64 $columns->{$name}++;
65 return $out;
66 }
67
68 $model .= qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/ if $schema->superclass($objectClass);
69
70 $model .= qq/\t# $objectClass must:\n\n/;
71
72
73 map {
74 warn "# $objectClass must: ",dump( $_ );
75 $model .= entry( $_, 'is mandatory' );
76 $create->{$_->{name}} = $_->{name};
77 } $schema->must( $objectClass );
78
79 $model .= qq/\t# $objectClass may:\n\n/;
80
81 map {
82 warn "# $objectClass may: ",dump( $_ );
83 $model .= entry( $_ );
84 } $schema->may( $objectClass );
85
86 $methods .= qq/sub name { \$_[0]->id }\n/ unless $columns->{name};
87
88 $model .= qq/
89
90 };
91
92 $methods
93
94 use A3C::DefaultACL;
95
96 1;
97 /;
98
99 my $model_path = "lib/A3C/Model/$objectClass.pm";
100 write_file( $model_path, $model );
101 warn "Created $model_path\n";
102
103 my $test = <<'__END_OF_TEST__';
104 #!/usr/bin/env perl
105 use warnings;
106 use strict;
107
108 =head1 DESCRIPTION
109
110 A basic test harness for the _objectClass_ model.
111
112 =cut
113
114 use Jifty::Test tests => 11;
115
116 # Make sure we can load the model
117 use_ok('A3C::Model::_objectClass_');
118
119 # Grab a system user
120 my $system_user = A3C::CurrentUser->superuser;
121 ok($system_user, "Found a system user");
122
123 # Try testing a create
124 my $o = A3C::Model::_objectClass_->new(current_user => $system_user);
125 my ($id) = $o->create(
126 _create_1_);
127 ok($id, "_objectClass_ create returned success");
128 ok($o->id, "New _objectClass_ has valid id set");
129 is($o->id, $id, "Create returned the right id");
130
131 # And another
132 $o->create(
133 _create_2_);
134 ok($o->id, "_objectClass_ create returned another value");
135 isnt($o->id, $id, "And it is different from the previous one");
136
137 # Searches in general
138 my $collection = A3C::Model::_objectClass_Collection->new(current_user => $system_user);
139 $collection->unlimit;
140 is($collection->count, 2, "Finds two records");
141
142 # Searches in specific
143 $collection->limit(column => 'id', value => $o->id);
144 is($collection->count, 1, "Finds one record with specific id");
145
146 # Delete one of them
147 $o->delete;
148 $collection->redo_search;
149 is($collection->count, 0, "Deleted row is gone");
150
151 # And the other one is still there
152 $collection->unlimit;
153 is($collection->count, 1, "Still one left");
154 __END_OF_TEST__
155
156 $test =~ s/_objectClass_/$objectClass/gs;
157
158 foreach my $round ( 1 .. 2 ) {
159 my $data;
160 $data .= qq/\t\t'$_' => '$_ $round',\n/ foreach keys %$create;
161 warn "data = $data\n";
162 $test =~ s/_create_${round}_/$data/gs;
163 }
164
165 my $test_path = "t/00-model-$objectClass.t";
166 write_file( $test_path, $test );
167 warn "Created $test_path\n";
168 chmod 0755, $test_path;

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26