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

Diff of /bin/ldap2model.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 98 by dpavlin, Wed Apr 30 21:27:54 2008 UTC revision 108 by dpavlin, Fri May 2 14:38:45 2008 UTC
# Line 2  Line 2 
2  use warnings;  use warnings;
3  use strict;  use strict;
4    
5  # schema2model.pl - convert LDAP schema file into jifty model  =head1 NAME
 #  
 # 04/30/08 20:55:21 CEST Dobrica Pavlinusic <dpavlin@rot13.org>  
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;  use Net::LDAP::Schema;
32    use File::Slurp;
33  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
34    use Getopt::Long;
35    
36  my ( $path, $objectClass ) = @ARGV;  my ( $path, $objectClass, $debug );
37    
38  die "usage: $0 path/to/schema.ldif inetOrgPerson\n" unless $path && $objectClass;  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  my $schema = Net::LDAP::Schema->new;  use Jifty::DBI::Schema;
63  $schema->parse ( $path ) or die $schema->error;  
64    use A3C::Record schema {
65    
66    /;
67    
68    my $methods;
69    my $create;
70    my $columns;
71    
72  sub entry {  sub entry {
73          my ( $e, $add ) = @_;          my ( $e, $add ) = @_;
74          my $out = qq/\tcolumn $_->{name} =>\n\t\tlabel is _('$_->{desc}')/;          my $name = $_->{name} || die "no name?";
75          $out .= qq/,\n\t\t# single-value/ if $_->{'single-value'};          $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'};          $out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};
80          $out .= qq/,\n\t\t$add/ if $add;          $out .= qq/,\n\t\t$add/ if $add;
81          $out .= qq/;\n\n/;          $out .= qq/;\n\n/;
82            $columns->{$name}++;
83          return $out;          return $out;
84  }  }
85    
86  my $model = qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/;  $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/;  $model .= qq/\t# $objectClass must:\n\n/;
89    
90    
91  map {  map {
92          warn "# $objectClass must: ",dump( $_ );          warn "# $objectClass must: ",dump( $_ ) if $debug;
93          $model .= entry( $_, 'is mandatory' );          $model .= entry( $_, 'is mandatory' );
94            $create->{$_->{name}} = $_->{'single-value'} ? $_->{name} : [ $_->{name}, $_->{desc} ];
95  } $schema->must( $objectClass );  } $schema->must( $objectClass );
96    
97  $model .= qq/\t# $objectClass may:\n\n/;  $model .= qq/\t# $objectClass may:\n\n/;
98    
99  map {  map {
100          warn "# $objectClass may: ",dump( $_ );          warn "# $objectClass may: ",dump( $_ ) if $debug;
101          $model .= entry( $_ );          $model .= entry( $_ );
102  } $schema->may( $objectClass );  } $schema->may( $objectClass );
103    
104  print $model;  $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    }

Legend:
Removed from v.98  
changed lines
  Added in v.108

  ViewVC Help
Powered by ViewVC 1.1.26