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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26