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

Annotation of /bin/ldap2model.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 103 - (hide annotations)
Thu May 1 14:30:06 2008 UTC (15 years, 11 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 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 dpavlin 103 # ./bin/ldap2model.pl --model hrEduOrg --path data/all.ldif
10 dpavlin 98
11 dpavlin 103 use lib 'lib';
12    
13     use Jifty;
14     use A3C::LDAP;
15 dpavlin 98 use Net::LDAP::Schema;
16 dpavlin 99 use File::Slurp;
17 dpavlin 98 use Data::Dump qw/dump/;
18 dpavlin 103 use Getopt::Long;
19 dpavlin 98
20 dpavlin 103 my ( $path, $objectClass );
21 dpavlin 98
22 dpavlin 103 GetOptions(
23     'model|objectClass=s', => \$objectClass,
24     'path=s', => \$path,
25     );
26 dpavlin 98
27 dpavlin 103 die "usage: $0 --model netOrgPerson [--path path/to/schema.ldif]\n" unless $objectClass;
28 dpavlin 98
29 dpavlin 103 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 dpavlin 99 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 dpavlin 102 my $create;
53     my $columns;
54 dpavlin 99
55 dpavlin 98 sub entry {
56     my ( $e, $add ) = @_;
57 dpavlin 99 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 dpavlin 98 $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 dpavlin 102 $columns->{$name}++;
65 dpavlin 98 return $out;
66     }
67    
68 dpavlin 99 $model .= qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/ if $schema->superclass($objectClass);
69 dpavlin 98
70     $model .= qq/\t# $objectClass must:\n\n/;
71    
72 dpavlin 102
73 dpavlin 98 map {
74     warn "# $objectClass must: ",dump( $_ );
75     $model .= entry( $_, 'is mandatory' );
76 dpavlin 102 $create->{$_->{name}} = $_->{name};
77 dpavlin 98 } $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 dpavlin 102 $methods .= qq/sub name { \$_[0]->id }\n/ unless $columns->{name};
87    
88 dpavlin 99 $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 dpavlin 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